dnrops
/
gimp
mirror of https://github.com/GNOME/gimp.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

see plug-ins/perl/Changes

This commit is contained in:
Marc Lehmann 1999-11-17 20:48:28 +00:00
parent 754af91ba1
commit 6e90c8de5f
12 changed files with 94 additions and 77 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
plug-ins/perl/Changes
View File

@ -14,6 +14,8 @@ Revision history for Gimp-Perl extension.
- only install pdl plug-ins when pdl is available.
- gimp_directory is 1.1-only.
- more warnings on people insisting on using broken perls.
- renamed init_gtk to gtk_init, asdded gtk_init_hook function to
work around the horrible initialization problems in Gtk.
1.14 Mon Oct 11 03:23:13 CEST 1999
- set the version of all modules explicitly (for the benefit of CPAN).

25
plug-ins/perl/Gimp.pm
View File

@ -144,7 +144,7 @@ sub import($;@) {
*{"$up\::AUTOLOAD"} = sub {
croak "Cannot call '$AUTOLOAD' at this time" unless initialized();
my ($class,$name) = $AUTOLOAD =~ /^(.*)::(.*?)$/;
*{$AUTOLOAD} = sub { unshift @_, 'Gimp'; goto &$name };
*{$AUTOLOAD} = sub { unshift @_, 'Gimp'; $AUTOLOAD = "Gimp::$name"; goto &AUTOLOAD };
#*{$AUTOLOAD} = sub { Gimp->$name(@_) }; # old version
goto &$AUTOLOAD;
};
@ -154,7 +154,7 @@ sub import($;@) {
warn __"$function: calling $AUTOLOAD without specifying the :auto import tag is deprecated!\n";
croak __"Cannot call '$AUTOLOAD' at this time" unless initialized();
my ($class,$name) = $AUTOLOAD =~ /^(.*)::(.*?)$/;
*{$AUTOLOAD} = sub { unshift @_, 'Gimp'; goto &$name };
*{$AUTOLOAD} = sub { unshift @_, 'Gimp'; $AUTOLOAD = "Gimp::$name"; goto &AUTOLOAD };
#*{$AUTOLOAD} = sub { Gimp->$name(@_) }; # old version
goto &$AUTOLOAD;
};
@ -187,7 +187,9 @@ sub xlfd_size($) {
: ($pt,&Gimp::POINTS);
}
sub init_gtk {
my @init_functions;
sub gtk_init() {
require Gtk;
Gtk->init;
@ -198,6 +200,12 @@ sub init_gtk {
Gtk::Preview->set_color_cube (Gimp->color_cube);
Gtk::Widget->set_default_visual (Gtk::Preview->get_visual);
Gtk::Widget->set_default_colormap (Gtk::Preview->get_cmap);
&{shift @init_functions} while @init_functions;
}
sub gtk_init_hook(&) {
push @init_functions, @_;
}
# internal utility function for Gimp::Fu and others
@ -823,12 +831,21 @@ size (no joke ;). Example:
$drawable->text_fontname (50, 50, "The quick", 5, 1, xlfd_size $font, $font;
=item Gimp::init_gtk()
=item Gimp::gtk_init()
Initialize Gtk in a similar way the Gimp itself did it. This automatically
parses gimp's gtkrc and sets a variety of default settings (visual,
colormap, gamma, shared memory...).
=item Gimp::gtk_init_add { init statements ... };
Add a callback function that should be called when gtk is being
initialized (i.e. when Gimp::gtk_init is called, which should therefore be
done even in Gnome applications).
This is different to Gtk->init_add, which only gets called in Gtk->main,
which is too late for registering types.
=item Gimp::init([connection-argument]), Gimp::end()
These is an alternative interface that replaces the call to Gimp::main

2
plug-ins/perl/Gimp/Fu.pm
View File

@ -697,7 +697,7 @@ sub register($$$$$$$$$;@) {
my $fudata = $Gimp::Data{"$function/_fu_data"};
if ($run_mode == &Gimp::RUN_WITH_LAST_VALS && $fudata) {
@_ = @{$fudata};
@_ = @$fudata;
} else {
if (@_) {
# prevent the standard arguments from showing up in interact

57
plug-ins/perl/Gimp/Lib.xs
View File

@ -1088,11 +1088,20 @@ get_data_size (gchar *id)
static void simple_perl_call (char *function, char *arg1)
{
char *argv[2];
argv[0] = arg1;
argv[1] = 0;
dSP;
perl_call_argv (function, G_DISCARD|G_EVAL, argv);
ENTER;
SAVETMPS;
PUSHMARK (SP);
XPUSHs (sv_2mortal (newSVpv (arg1, 0)));
PUTBACK;
perl_call_pv (function, G_VOID);
SPAGAIN;
FREETMPS;
LEAVE;
}
#define gimp_die_msg(msg) simple_perl_call ("Gimp::die_msg" , (msg))
@ -1137,10 +1146,7 @@ static void pii_run(char *name, int nparams, GParam *param, int *xnreturn_vals,
g_free (proc_author);
g_free (proc_copyright);
g_free (proc_date);
g_free (params);
ENTER;
SAVETMPS;
destroy_paramdefs (params, _nparams);
PUSHMARK(SP);
@ -1166,28 +1172,22 @@ static void pii_run(char *name, int nparams, GParam *param, int *xnreturn_vals,
PUTBACK;
count = perl_call_pv ("Gimp::callback", G_EVAL
| (nreturn_vals == 0 ? G_VOID|G_DISCARD : nreturn_vals == 1 ? G_SCALAR : G_ARRAY));
| (nreturn_vals == 0 ? G_VOID : nreturn_vals == 1 ? G_SCALAR : G_ARRAY));
SPAGAIN;
if (count == 1 && !SvOK (TOPs))
{
(void) POPs;
count = 0;
}
if (SvTRUE (ERRSV))
{
if (strEQ ("IGNORE THIS MESSAGE\n", SvPV_nolen (ERRSV)))
{
nreturn_vals = 0;
return_vals = g_new (GParam, 1);
return_vals->type = PARAM_STATUS;
return_vals->data.d_status = STATUS_SUCCESS;
*xnreturn_vals = nreturn_vals+1;
*xreturn_vals = return_vals;
}
else
err_msg = g_strdup (SvPV_nolen (ERRSV));
if (strEQ ("IGNORE THIS MESSAGE\n", SvPV_nolen (ERRSV)))
{
nreturn_vals = 0;
return_vals = g_new (GParam, 1);
return_vals->type = PARAM_STATUS;
return_vals->data.d_status = STATUS_SUCCESS;
*xnreturn_vals = nreturn_vals+1;
*xreturn_vals = return_vals;
}
else
err_msg = g_strdup (SvPV_nolen (ERRSV));
}
else
{
@ -1222,14 +1222,9 @@ static void pii_run(char *name, int nparams, GParam *param, int *xnreturn_vals,
err_msg = g_strdup_printf (__("plug-in returned %d more values than expected"), count);
}
while (count--)
(void) POPs;
destroy_paramdefs (return_defs, nreturn_vals);
PUTBACK;
FREETMPS;
LEAVE;
}
else
err_msg = g_strdup_printf (__("being called as '%s', but '%s' not registered in the pdb"), name, name);

4
plug-ins/perl/TODO
View File

@ -8,6 +8,10 @@ gimp ~/pix/ka001.jpg -b "(extension-perl-server 0 0 0)"
file:///usr/app/lib/perl5/site_perl/i686-linux/PDL/HtmlDocs/PDL/
make test TEST_VERBOSE=1
put under LGPL:
gimpenv.c, gimpmodule.h, color_selector.h, color_display.h
API generalization
guide ->
gimp_desaturate -> drawable

61
plug-ins/perl/UI/UI.pm
View File

@ -93,24 +93,20 @@ sub new($$$$) {
$menu;
}
Gimp::gtk_init_hook {
register_subtype Gtk::Button 'Gimp::UI::PreviewSelect';
register_subtype Gtk::Button 'Gimp::UI::PatternSelect';
register_subtype Gtk::Button 'Gimp::UI::BrushSelect';
register_subtype Gtk::Button 'Gimp::UI::GradientSelect';
register_subtype Gtk::Button 'Gimp::UI::ColorSelectButton';
};
package Gimp::UI::PreviewSelect;
use Gtk;
use Gimp '__';
use base 'Gtk::Button';
# this is an utter HACK for the braindamanged gtk (NOT Gtk!)
sub register_types {
unless ($once) {
$once=1;
Gtk::Button->register_subtype(Gimp::UI::PreviewSelect);
Gtk::Button->register_subtype(Gimp::UI::PatternSelect);
Gtk::Button->register_subtype(Gimp::UI::BrushSelect);
Gtk::Button->register_subtype(Gimp::UI::GradientSelect);
Gtk::Button->register_subtype(Gimp::UI::ColorSelectButton);
}
}
sub GTK_CLASS_INIT {
my $class = shift;
add_arg_type $class "active","GtkString",3;
@ -243,7 +239,6 @@ sub set_preview {
}
sub new {
Gimp::UI::PreviewSelect::register_types;
new Gtk::Widget @_;
}
@ -287,7 +282,6 @@ sub set_preview {
}
sub new {
Gimp::UI::PreviewSelect::register_types;
new Gtk::Widget @_;
}
@ -312,7 +306,6 @@ sub set_preview {
}
sub new {
Gimp::UI::PreviewSelect::register_types;
unless (defined %gradients) {
undef @gradients{Gimp->gradients_get_list};
}
@ -435,8 +428,7 @@ sub cb_color_button {
sub new {
my $pkg = shift;
Gimp::UI::PreviewSelect::register_types;
return new Gtk::Widget $pkg, @_;
new Gtk::Widget $pkg, @_;
}
1;
@ -488,10 +480,6 @@ sub logo_xpm {
',,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,::::,,,,,,,::::::,,::::,,,::::,,,,,,,,,,,,,,,,,,,,,%$*,,,,$%&,@,,,,@+@,,,,',
',,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,+@%#,,,,,,,,,,,,,@@#,,,,',
',,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,o$&,,,,,,,,,,,,,,,,,,,,,'
#%XPM%
))
}
@ -553,7 +541,6 @@ sub help_window(\$$$) {
$$helpwin->show_all();
}
sub interact($$$$@) {
local $^W=0;
my($function)=shift;
@ -564,16 +551,17 @@ sub interact($$$$@) {
my($button,$box,$bot,$g);
my($helpwin);
my $res=0;
my @res;
Gimp::init_gtk;
Gimp::gtk_init;
my $gimp_10 = Gimp->major_version==1 && Gimp->minor_version==0;
for(;;) {
my $t = new Gtk::Tooltips;
my $w = new Gtk::Dialog;
my $accel = new Gtk::AccelGroup;
my $t = new Gtk::Tooltips;
my $w = new Gtk::Dialog;
my $accel = new Gtk::AccelGroup;
for(;;) {
$accel->attach($w);
set_title $w $Gimp::function;
@ -923,7 +911,7 @@ sub interact($$$$@) {
$v->add($button);
set_tip $t $button,__"Restore values to the previous ones";
signal_connect $w "destroy", sub {main_quit Gtk};
signal_connect $w "destroy", sub { main_quit Gtk };
$button = new Gtk::Button __"OK";
signal_connect $button "clicked", sub {$res = 1; hide $w; main_quit Gtk};
@ -942,15 +930,26 @@ sub interact($$$$@) {
show_all $w;
main Gtk;
#$w->destroy; # buggy in gtk-1.1 (?)
return undef if $res == 0;
if ($res == 0) {
@res = ();
last;
}
@_ = map {&$_} @getvals;
return (1,@_) if $res == 1;
if ($res == 1) {
@res = (1,@_);
last;
}
# Gimp->file_load(&Gimp::RUN_INTERACTIVE,"","");
}
@getvals=
@setvals=
@lastvals=();
@res;
}
1;
=head1 AUTHOR
Marc Lehmann <pcg@goof.com>. The ColorSelectButton code (now

4
plug-ins/perl/UI/UI.xs
View File

@ -19,6 +19,10 @@
#include <libgimp/gimpexport.h>
#endif
/* libgimo requires a rather broken interface. this must be here because..
* well, nobody knows why... ARGH! */
GPlugInInfo PLUG_IN_INFO = { 0, 0, 0, 0 };
static void gimp_pattern_select_widget_callback (gchar *name, gint width,
gint height, gint bpp, gchar *mask, gint closing, gpointer nameref)
{

4
plug-ins/perl/examples/PDB
View File

@ -403,8 +403,6 @@ sub create_main {
my $b;
my $t;
parse Gtk::Rc Gimp->gtkrc;
$t = new Gtk::Tooltips;
my $w = new Gtk::Dialog;
$window = $w;
@ -492,7 +490,7 @@ register "extension_pdb_explorer",
[],
sub {
Gimp::init_gtk;
Gimp::gtk_init;
refresh;
create_main;
main Gtk;

2
plug-ins/perl/examples/bricks
View File

@ -16,7 +16,6 @@ sub do_bricks {
my ($pattern,$pattern2,$bp,$clr,$bw,$brickx,$bricky,$imgw,$imgh,$skew) = @_;
my ($image, $layer, $state, $layerpat);
$state = get_state(); # get fgcolor, etc
$imgw = abs($imgw); $imgw = 256 if (($imgw < 32) || ($imgw > 4096));
$imgh = abs($imgh); $imgh = 256 if (($imgh < 32) || ($imgh > 4096));
#print "Creating texture $imgw"."x$imgh\n";
@ -115,7 +114,6 @@ sub do_bricks {
gimp_image_remove_layer_mask ($image,$layerb,0);
gimp_channel_ops_offset ($layerpat,1,0,-1,-1);
gimp_channel_ops_offset ($layerb,1,0,-1,-1);
set_state($state); # restore color etc
$image;
}

2
plug-ins/perl/examples/gimpmagick
View File

@ -196,7 +196,7 @@ sub update_preview {
sub gimp_magick {
my ($drawable)=@_;
Gimp::init_gtk;
Gimp::gtk_init;
# generate main window
my $im = new Image::Magick;

6
plug-ins/perl/examples/parasite-editor
View File

@ -111,7 +111,7 @@ sub refresh_names {
$data->set_text ("");
$clist->freeze;
$clist->clear;
my @list = &$list_func($current);
my @list = sort &$list_func($current);
for (@list) {
$clist->append($_);
}
@ -285,7 +285,7 @@ register "extension_parasite_editor",
['gimp-1.1'],
sub {
Gimp::init_gtk;
Gimp::gtk_init;
create_main;
main Gtk;
@ -299,7 +299,7 @@ use base Gtk::Dialog;
my $init;
Gtk::Dialog->register_subtype(ParasiteEditor);
init_add Gtk sub { Gtk::Dialog->register_subtype(ParasiteEditor) };
sub GTK_CLASS_INIT { };

2
plug-ins/perl/examples/perlcc
View File

@ -98,7 +98,7 @@ sub extension_perl_control_center {
my($w,$b);
my($l,$s);
Gimp::init_gtk;
Gimp::gtk_init;
$w = new Gtk::Dialog;
$w->set_title ('Perl Control Center');