see plug-ins/perl/Changes

plug-ins/perl/Changes

@@ -13,6 +13,11 @@ Revision history for Gimp-Perl extension.
         - some minor Gimp::UI streamlining & bugfixes.
         - more (undocumented) on_xxx hooks.
         - got rid of the old & crufty callback system (who uses it anyways?).
+        - added Gimp::basewidget "pragma" and made Gimp::UI use it. Also
+          sent a bugreport to the Gtk maintainer who will hopefully make
+          a gtk-perl release soon.
+        - the :auto import tag is no longer the default. neither with nor without
+          warning.
 
 1.17  Wed Nov 24 21:25:19 CET 1999
         - re-fitted i18n translation for most plug-ins.

plug-ins/perl/Gimp.pm

@@ -128,7 +128,8 @@ sub croak {
 }
 
 my @_procs = ('main', 'xlfd_size', '__', 'N_');
-my @_default = (@_procs, ':consts' ,':_auto2');
+#my @_default = (@_procs, ':consts' ,':_auto2');
+my @_default = (@_procs, ':consts');
    
 # we really abuse the import facility..
 sub import($;@) {
@@ -212,6 +213,9 @@ sub gtk_init() {
 
 sub gtk_init_hook(&) {
    push @init_functions, @_;
+   unless ($gtk_init) {
+      &{shift @init_functions} while @init_functions;
+   }
 }
 
 # internal utility function for Gimp::Fu and others

plug-ins/perl/MANIFEST

@@ -56,6 +56,7 @@ Net/Net.pm
 UI/Makefile.PL
 UI/UI.pm
 UI/UI.xs
+UI/basewidget.pm
 examples/PDB
 examples/alpha2color.pl
 examples/tex-to-float

plug-ins/perl/Makefile.PL

@@ -320,6 +320,7 @@ WriteMakefile(
     		    'Gimp/Fu.pm'	=> '$(INST_LIBDIR)/Gimp/Fu.pm',
     		    'Gimp/Lib.pm'	=> '$(INST_LIBDIR)/Gimp/Lib.pm',
     		    'UI/UI.pm'		=> '$(INST_LIBDIR)/Gimp/UI.pm',
+    		    'UI/basewidget.pm'	=> '$(INST_LIBDIR)/Gimp/basewidget.pm',
     		    'Net/Net.pm'	=> '$(INST_LIBDIR)/Gimp/Net.pm',
     		    'Gimp/PDL.pm'	=> '$(INST_LIBDIR)/Gimp/PDL.pm',
     		    'Gimp/Util.pm'	=> '$(INST_LIBDIR)/Gimp/Util.pm',

plug-ins/perl/UI/UI.pm

@@ -93,23 +93,14 @@ 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';
 
 sub GTK_CLASS_INIT {
    my $class = shift;
-   add_arg_type $class "active","GtkString",3;
+   add_arg_type $class "active", "GtkString", 3;
 }
 
 sub GTK_OBJECT_SET_ARG {
@@ -136,7 +127,7 @@ sub GTK_OBJECT_GET_ARG {
 }
 
 sub GTK_OBJECT_INIT {
-   my $self=shift;
+   my $self = shift;
    (my $label = new Gtk::Label "")->show;
    $self->add($label);
    $self->{label}=$label;
@@ -198,7 +189,8 @@ package Gimp::UI::PatternSelect;
 
 use Gtk;
 use Gimp '__';
-use base 'Gimp::UI::PreviewSelect';
+use base Gimp::UI::PreviewSelect;
+use Gimp::basewidget Gtk::Button;
 
 sub get_title { __"Pattern Selection Dialog" }
 sub get_list { Gimp->patterns_list }
@@ -238,15 +230,12 @@ sub set_preview {
    $name;
 }
 
-sub new {
-   Gtk::Object::new @_;
-}
-
 package Gimp::UI::BrushSelect;
 
 use Gtk;
 use Gimp '__';
-use base 'Gimp::UI::PreviewSelect';
+use base Gimp::UI::PreviewSelect;
+use Gimp::basewidget Gtk::Button;
 
 sub get_title { __"Brush Selection Dialog" }
 sub get_list { Gimp->brushes_list }
@@ -281,15 +270,12 @@ sub set_preview {
    $name;
 }
 
-sub new {
-   Gtk::Object::new @_;
-}
-
 package Gimp::UI::GradientSelect;
 
 use Gtk;
-use base 'Gimp::UI::PreviewSelect';
 use Gimp '__';
+use base Gimp::UI::PreviewSelect;
+use Gimp::basewidget Gtk::Button;
 
 sub get_title { __"Gradient Selection Dialog" }
 sub get_list { keys %gradients }
@@ -314,24 +300,16 @@ sub new {
 
 package Gimp::UI::ColorSelectButton;
 
-use strict;
-use vars qw($VERSION @ISA);
-use Gimp '__';
 use Gtk;
-
-@ISA = qw(Gtk::Button);
+use Gimp '__';
+use Gimp::basewidget Gtk::Button;
 
 # Class defaults data
 my @class_def_color = (255,175,0);
 
 sub GTK_CLASS_INIT {
 	my($class) = shift;
-	
-	if (Gtk->major_version < 1 or (Gtk->major_version == 1 and Gtk->minor_version < 1)) {
-		add_arg_type $class "color", "string", 3; #R/W
-	} else {
-		add_arg_type $class "color", "GtkString", 3; #R/W
-	}
+	add_arg_type $class "color", "GtkString", 3; #R/W
 }
 
 sub GTK_OBJECT_INIT {
@@ -426,10 +404,6 @@ sub cb_color_button {
     $color_button->{_cs_window} = $cs_window;
 }
 
-sub new {
-    Gtk::Object::new @_;
-}
-
 1;
 
 package Gimp::UI;

plug-ins/perl/UI/basewidget.pm

@@ -0,0 +1,108 @@
+package Gimp::basewidget; # pragma
+
+use Gimp;
+use Gtk;
+
+$VERSION = 1.18;
+
+=head1 NAME
+
+Gimp::basewidget - pragma to declare the superclass of a gtk widget
+
+=head1 SYNOPSIS
+
+  use Gimp::basewidget 'superclass';
+
+e.g.
+
+  use Gimp::basewidget Gtk::Button;
+
+=head1 DESCRIPTION
+
+This pragma can (but does not need to) be used to declare the current
+package as a childclass of an existing Gtk widget class. The only "import
+tag" must be the name of the existing superclass.
+
+The module automatically registers a subtype, calls a special callback
+at gtk initialization time and provides default implementations for some
+common methods (the list might grow in the future to enhance settor/gettor
+functionality).
+
+The following methods are provided. All of them can be overriden in your
+package.
+
+=over 4
+
+=item new
+
+A simple generic new constructor is provided. It will simply call
+C<Gtk::Object::new> with all the provided arguments.
+
+=item GTK_INIT
+
+This callback is called as early as possible E<after> gtk was initialized,
+but not before. This can be used to register additional subtypes, argument
+types etc. It is similar to GTK_CLASS_INIT.
+
+=item GTK_CLASS_INIT
+
+Unlike the standard Gtk-callback of the same name, this method can be
+omitted in your package (while still being a valid Widget).
+
+=item GTK_OBJECT_INIT
+
+This callback can also be omitted, but this rarely makes sense ;)
+
+=back
+
+=cut
+
+# a generic perl widget helper class, or something that
+# was a pain to implement "right". :(
+
+sub GTK_INIT {
+   # dummy function, maybe even totally superfluous
+}
+
+sub GTK_CLASS_INIT {
+   # dummy function
+}
+
+sub GTK_OBJECT_INIT {
+   # dummy function, should be overriden
+}
+
+sub DESTROY {
+   # dummy function, very necessary
+}
+
+sub new {
+   Gtk::Object::new @_;
+}
+
+sub import {
+   my $self  = shift;
+   my $super = shift;
+   my $class = caller;
+   push @{$class."::ISA"}, $self, $super;
+   Gimp::gtk_init_hook {
+      $class->GTK_INIT;
+      Gtk::Object::register_subtype($super,$class);
+   };
+}
+
+1;
+
+=head1 BUGS
+
+This was a pain to implement, you will not believe this when looking at
+the code, though.
+
+=head1 AUTHOR
+
+Marc Lehmann <pcg@goof.com>.
+
+=head1 SEE ALSO
+
+perl(1), L<Gimp>, L<Gimp::UI>, L<Gtk>.
+