From 6e90c8de5f3f7fb97c5376a048109f5d12f9d19d Mon Sep 17 00:00:00 2001 From: Marc Lehmann Date: Wed, 17 Nov 1999 20:48:28 +0000 Subject: [PATCH] see plug-ins/perl/Changes --- plug-ins/perl/Changes | 2 + plug-ins/perl/Gimp.pm | 25 +++++++++-- plug-ins/perl/Gimp/Fu.pm | 2 +- plug-ins/perl/Gimp/Lib.xs | 57 +++++++++++------------- plug-ins/perl/TODO | 4 ++ plug-ins/perl/UI/UI.pm | 61 +++++++++++++------------- plug-ins/perl/UI/UI.xs | 4 ++ plug-ins/perl/examples/PDB | 4 +- plug-ins/perl/examples/bricks | 2 - plug-ins/perl/examples/gimpmagick | 2 +- plug-ins/perl/examples/parasite-editor | 6 +-- plug-ins/perl/examples/perlcc | 2 +- 12 files changed, 94 insertions(+), 77 deletions(-) diff --git a/plug-ins/perl/Changes b/plug-ins/perl/Changes index 8462273a52..22fcf44035 100644 --- a/plug-ins/perl/Changes +++ b/plug-ins/perl/Changes @@ -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). diff --git a/plug-ins/perl/Gimp.pm b/plug-ins/perl/Gimp.pm index bc5e2711df..6822efcb42 100644 --- a/plug-ins/perl/Gimp.pm +++ b/plug-ins/perl/Gimp.pm @@ -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 diff --git a/plug-ins/perl/Gimp/Fu.pm b/plug-ins/perl/Gimp/Fu.pm index 1f448554e2..ab5a6528de 100644 --- a/plug-ins/perl/Gimp/Fu.pm +++ b/plug-ins/perl/Gimp/Fu.pm @@ -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 diff --git a/plug-ins/perl/Gimp/Lib.xs b/plug-ins/perl/Gimp/Lib.xs index dbb744434d..965c4a48dd 100644 --- a/plug-ins/perl/Gimp/Lib.xs +++ b/plug-ins/perl/Gimp/Lib.xs @@ -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); diff --git a/plug-ins/perl/TODO b/plug-ins/perl/TODO index edfa97c442..c4d7acb5c2 100644 --- a/plug-ins/perl/TODO +++ b/plug-ins/perl/TODO @@ -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 diff --git a/plug-ins/perl/UI/UI.pm b/plug-ins/perl/UI/UI.pm index f5db7dddd1..97df1c5cb8 100644 --- a/plug-ins/perl/UI/UI.pm +++ b/plug-ins/perl/UI/UI.pm @@ -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 . The ColorSelectButton code (now diff --git a/plug-ins/perl/UI/UI.xs b/plug-ins/perl/UI/UI.xs index 575b94d9e2..8176f55fd8 100644 --- a/plug-ins/perl/UI/UI.xs +++ b/plug-ins/perl/UI/UI.xs @@ -19,6 +19,10 @@ #include #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) { diff --git a/plug-ins/perl/examples/PDB b/plug-ins/perl/examples/PDB index fdd200155b..b802271239 100755 --- a/plug-ins/perl/examples/PDB +++ b/plug-ins/perl/examples/PDB @@ -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; diff --git a/plug-ins/perl/examples/bricks b/plug-ins/perl/examples/bricks index 3ab3329d7a..91505e18c0 100755 --- a/plug-ins/perl/examples/bricks +++ b/plug-ins/perl/examples/bricks @@ -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; } diff --git a/plug-ins/perl/examples/gimpmagick b/plug-ins/perl/examples/gimpmagick index 761e6cbb6c..290adc3f5b 100644 --- a/plug-ins/perl/examples/gimpmagick +++ b/plug-ins/perl/examples/gimpmagick @@ -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; diff --git a/plug-ins/perl/examples/parasite-editor b/plug-ins/perl/examples/parasite-editor index 4784b02cff..ea30730caa 100755 --- a/plug-ins/perl/examples/parasite-editor +++ b/plug-ins/perl/examples/parasite-editor @@ -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 { }; diff --git a/plug-ins/perl/examples/perlcc b/plug-ins/perl/examples/perlcc index 53a84fa517..40b2edb5a5 100755 --- a/plug-ins/perl/examples/perlcc +++ b/plug-ins/perl/examples/perlcc @@ -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');