see plug-ins/perl/Changes

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).

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

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

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];
+   dSP;
-   argv[0] = arg1;
-   argv[1] = 0;
 
-   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);
+      destroy_paramdefs (params, _nparams);
-      
-      ENTER;
-      SAVETMPS;
       
       PUSHMARK(SP);
 
@@ -1166,15 +1172,9 @@ 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)))
@@ -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);

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

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;
+    new Gtk::Widget $pkg, @_;
-    return 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;
 
+   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

plug-ins/perl/UI/UI.xs

@@ -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)
 {

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;

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;
 }
 

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;

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 { };
 

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');