see plug-ins/perl/Changes

plug-ins/perl/Changes

@@ -1,6 +1,10 @@
 Revision history for Gimp-Perl extension.
 
+1.082 Tue May 11 19:02:30 CEST 1999
 	- fixed sunos/solaris socketpair "protocol not implemented" problem.
+        - added the Gimp::register_callback function and made Gimp::Fu use it.
+        - made default font use pixels instead of point size, since gimp-1.1
+          scales according to the image resolution(!).
         - disabled paintbrush in testsuite since it has different calling
           parameters in 1.1.
         - added use File::Basename to Fu.pm.
@@ -12,6 +16,7 @@ Revision history for Gimp-Perl extension.
         - commandline switch printing improved a bit.
         - removed IO::Socket::* dependency from Perl-Server. Was tooo slow.
         - fixed uninitialized memory error.
+        - some small improvements in PDB, gimpmagick and perlcc.
 
 1.081 Thu May  6 19:33:37 CEST 1999
 	- added "oneliners".

plug-ins/perl/Gimp.pm

@@ -224,7 +224,8 @@ sub init_gtk {
 # internal utility function for Gimp::Fu and others
 sub wrap_text {
    my $x=$_[0];
-   $x=~s/(\G.{1,$_[1]})(\s+|$)/$1\n/g;
+   $x=~s/^(\G.{1,$_[1]})(\s+|$)/$1\n/gm;
+   $x=~s/[ \t\r\n]+$//g;
    $x;
 }
 
@@ -380,11 +381,15 @@ unless ($no_SIG) {
    };
 }
 
+my %callback;
+
 sub call_callback {
    my $req = shift;
    my $cb = shift;
    return () if $caller eq "Gimp";
-   if (UNIVERSAL::can($caller,$cb)) {
+   if ($callback{$cb}) {
+      &{$callback{$cb}};
+   } elsif (UNIVERSAL::can($caller,$cb)) {
       &{"$caller\::$cb"};
    } else {
       die_msg "required callback '$cb' not found\n" if $req;
@@ -412,6 +417,10 @@ sub callback {
    }
 }
 
+sub register_callback($$) {
+   $callback{$_[0]}=$_[1];
+}
+
 sub main {
    $caller=caller;
    #d# #D# # BIG BUG LURKING SOMEWHERE
@@ -865,11 +874,21 @@ have a copy in /usr/lib/X11/rgb.txt). You can view the default database
 with C<perldoc -m Gimp>, at the end of the file (the default database is
 similar, but not identical to the X11 default rgb.txt)
 
-=item Gimp::initialized ()
+=item Gimp::initialized()
 
 this function returns true whenever it is safe to clal gimp functions. This is
 usually only the case after gimp_main or gimp_init have been called.
 
+=item Gimp::register_callback(gimp_function_name,perl_function)
+
+Using this fucntion you can overwrite the standard Gimp behaviour of
+calling a perl subroutine of the same name as the gimp function.
+
+The first argument is the name of a registered gimp function that you want
+to overwrite ('perl_fu_make_something'), and the second argument can be
+either a name of the corresponding perl sub ('Elsewhere::make_something')
+or a code reference (\&my_make).
+
 =back
 
 =head1 SPECIAL METHODS

plug-ins/perl/Gimp/Compat.pm

@@ -1,6 +1,6 @@
 =head1 NAME
 
- Gimp::Compat - compatibility functions for older verasions of Gimp.
+ Gimp::Compat - compatibility functions for older versions of Gimp.
 
 =head1 SYNOPSIS
 
@@ -8,7 +8,7 @@
 
 =head1 DESCRIPTION
 
-Older versions of Gimp (vesion 1.0 at the time of this writing) lack some
+Older versions of Gimp (version 1.0 at the time of this writing) lack some
 very important or useful functions.
 
 This module is providing the most needed replacement functions. If you

plug-ins/perl/Gimp/Fu.pm

@@ -273,7 +273,7 @@ sub interact($$$$@) {
               &new_PF_STRING;
            } else {
               my $fs=new Gtk::FontSelectionDialog "Font Selection Dialog ($desc)";
-              my $def = "-*-helvetica-medium-r-normal-*-*-240-*-*-p-*-iso8859-1";
+              my $def = "-*-helvetica-medium-r-normal-*-24-*-*-*-p-*-iso8859-1";
               my $val;
               
               my $l=new Gtk::Label "!error!";
@@ -530,10 +530,11 @@ sub fu_feature_present($$) {
 sub this_script {
    return $scripts[0] unless $#scripts;
    # well, not-so-easy-day today
-   my $exe = basename($0);
+   require File::Basename;
+   my $exe = File::Basename::basename($0);
    my @names;
    for my $this (@scripts) {
-      my $fun = (split /\//,$this->[0])[-1];
+      my $fun = (split /\//,$this->[1])[-1];
       return $this if lc($exe) eq lc($fun);
       push(@names,$fun);
    }
@@ -589,8 +590,8 @@ sub net {
    my($interact)=1;
    my $params = $this->[8];
    
-   for(@{$this->[10]}) {
-      return unless fu_feature_present($_,$this->[0]);
+   for(@{$this->[11]}) {
+      return unless fu_feature_present($_,$this->[1]);
    }
 
    # %map is a hash that associates (mangled) parameter names to parameter index
@@ -641,7 +642,7 @@ sub query {
    my($type);
    script:
    for(@scripts) {
-      my($function,$blurb,$help,$author,$copyright,$date,
+      my($perl_sub,$function,$blurb,$help,$author,$copyright,$date,
          $menupath,$imagetypes,$params,$results,$features,$code)=@$_;
 
       for(@$features) {
@@ -910,7 +911,7 @@ sub register($$$$$$$$$;@) {
                 function => $function, fatal => 0
       if $function =~ y/-//;
 
-   *$function = sub {
+   my $perl_sub = sub {
       $run_mode=shift;	# global!
       my(@pre,@defaults,@lastvals,$input_image);
 
@@ -998,7 +999,9 @@ sub register($$$$$$$$$;@) {
       Gimp::set_trace ($old_trace);
       wantarray ? @imgs : $imgs[0];
    };
-   push(@scripts,[$function,$blurb,$help,$author,$copyright,$date,
+
+   Gimp::register_callback($function,$perl_sub);
+   push(@scripts,[$perl_sub,$function,$blurb,$help,$author,$copyright,$date,
                   $menupath,$imagetypes,$params,$results,$features,$code]);
 }
 

plug-ins/perl/examples/PDB

@@ -101,8 +101,11 @@ my %type2str = (
 );
 
 sub leftlabel {
-   my $label = new Gtk::Label shift;
-   $label->set_alignment (0, 0.5);
+   my $label = shift;
+   $label =~ s/^(.{30,60})[ \t]*([\{[:\(])/$1\n$2/mg;
+   my $label = new Gtk::Label Gimp::wrap_text($label,60);
+   $label->set_alignment (0, 0);
+   $label->set_justify(-left);
    $label;
 }
 
@@ -434,7 +437,7 @@ register "extension_pdb_explorer",
          "This is a more interactive version of the DB Browser",
          "Marc Lehmann",
          "Marc Lehmann",
-         "0.1.1",
+         "0.2",
          "<Toolbox>/Xtns/PDB Explorer",
          "",
          [],

plug-ins/perl/examples/gimpmagick

@@ -195,8 +195,7 @@ sub update_preview {
 sub gimp_magick {
    my ($drawable)=@_;
 
-   init Gtk;
-   parse Gtk::Rc Gimp->gtkrc;
+   Gimp::init_gtk;
 
    # generate main window
    my $im = new Image::Magick;
@@ -281,7 +280,6 @@ register "gimp_magick",
          sub {
    my($image,$drawable)=@_;
 
-   Gimp::init_gtk;
    gimp_magick ($drawable);
 
    $image;

plug-ins/perl/examples/perlcc

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

plug-ins/perl/examples/terral_text

@@ -39,17 +39,16 @@ register
         "Otherwise, it overwrites the current layer and uses a solid noise",
 	"Seth Burgess",
 	"Seth Burgess <sjburges\@gimp.org>",
-	"1999-03-15",
+	"1999-05-11",
 	"<Image>/Filters/Render/Terral Text",
 	"RGB*,GRAY*",
 	[
 	  [ PF_RADIO, "solid_noise", "The Texture Type", 0, ["solid noise" => 1, "current picture" => 0]],
-	  [ PF_FONT, "helvetica", "Font Name", "-*-helvetica-medium-r-normal-*-*-240-*-*-p-*-iso8859-1" ],
+	  [ PF_FONT, "font", "Font Name"],
 	  [ PF_STRING, "text", "Enter your Text to be Terral-ified", "TerralText"],
 	  [ PF_SLIDER, "blur_amount", "Blur Amount", 10, [0,26,1]],
 	],
 sub {
-   Gimp::set_trace(TRACE_NAME);
 	($img, $pattern, $solidnoise, $font, $text, $blur) = @_;
 	$oldbg = gimp_palette_get_background();
 	$oldfg = gimp_palette_get_foreground();