More stuff

-Yosh

tools/pdbgen/app.pl

@@ -41,6 +41,25 @@ sub quotewrap {
     $str;
 }
 
+sub format_code_frag {
+    my ($code, $indent) = @_;
+
+    chomp $code;
+    $code =~ s/\t/' ' x 8/eg;
+
+    if (!$indent && $code =~ /^\s*{\s*\n.*\n\s*}\s*$/s) {
+	$code =~ s/^\s*{\s*\n//s;
+	$code =~ s/\n\s*}\s*$//s;
+    }
+    else {
+	$code =~ s/^/' ' x ($indent ? 4 : 2)/meg;
+    }
+    $code =~ s/^ {8}/\t/mg;
+    $code .= "\n";
+
+    $code;
+}
+
 sub declare_args {
     my $proc = shift;
     my $out = shift;
@@ -53,7 +72,7 @@ sub declare_args {
 	foreach (@args) {
 	    my $arg = $arg_types{(&arg_parse($_->{type}))[0]};
 
-	    if ($arg->{array} && (not exists $_->{array})) {
+	    if ($arg->{array} && !exists $_->{array}) {
 		warn "Array without number of elements param in $proc->{name}";
 	    }
 
@@ -64,8 +83,8 @@ sub declare_args {
 		}
 		$result .= ";\n";
 
-		if (exists $arg->{id_headers}) {
-		    foreach (@{$arg->{id_headers}}) {
+		if (exists $arg->{headers}) {
+		    foreach (@{$arg->{headers}}) {
 			$out->{headers}->{$_}++;
 		    }
 		}
@@ -76,7 +95,7 @@ sub declare_args {
     $result;
 } 
 
-sub make_args {
+sub make_arg_recs {
     my $proc = shift;
 
     my $result = "";
@@ -86,8 +105,7 @@ sub make_args {
 	my @args = @{$proc->{$_}} if exists $proc->{$_};
 
 	if (scalar @args) {
-	    $result .= "\nstatic ProcArg $proc->{name}_${_}[] =";
-	    $result .= "\n{\n";
+	    $result .= "\nstatic ProcArg $proc->{name}_${_}[] =\n{\n";
 
 	    foreach $arg (@{$proc->{$_}}) {
 		my ($type, $name, @remove) = &arg_parse($arg->{type});
@@ -115,7 +133,7 @@ sub make_args {
 CODE
 	    }
 
-	    $result =~ s/,\n$/\n/;
+	    $result =~ s/,\n$/\n/s;
 	    $result .= "};\n";
 	}
     }
@@ -124,11 +142,10 @@ CODE
 }
 
 sub marshal_inargs {
-    my $proc = shift;
+    my ($proc, $argc) = @_;
 
     my $result = "";
     my %decls;
-    my $argc = 0;
 
     my @inargs = @{$proc->{inargs}} if exists $proc->{inargs};
 
@@ -139,19 +156,28 @@ sub marshal_inargs {
 	my $var = &arg_vname($_);
 	
 	if (exists $arg->{id_func}) {
-	    my $test = exists $_->{on_success} ? '!=' : '==';
-
 	    $result .= <<CODE;
-  if (($var = $arg->{id_func} (args[$argc].value.pdb_$type)) $test NULL)
+  $var = $arg->{id_func} (args[$argc].value.pdb_$type);
 CODE
 
-	    $result .= <<CODE if exists $_->{on_success};
-    $_->{on_success}
-  else
-CODE
-	    $result .= ' ' x 4 . "success = FALSE;\n";
+	    if (!exists $_->{no_success}) {
+		$result .= ' ' x 2 . "if ($var ";
+		$result .= exists $_->{on_success} ? '!=' : '==';
+		$result .= " NULL)\n";
+
+		if (exists $_->{on_success}) {
+		    $result .= &format_code_frag($_->{on_success}, 1);
+		    $result .= ' ' x 2 . "else\n";
+		}
+
+		$result .= ' ' x 4 . "success = FALSE;\n";
+
+		if (exists $_->{on_fail}) {
+		    $result .= &format_code_frag($_->{on_fail}, 1);
+		}
 
-	    $success = 1;
+		$success = 1;
+	    }
 	}
 	else {
 	    my $code = ' ' x 2 . "$var =";
@@ -218,21 +244,35 @@ CODE
 
 		    $code .= "$extra;\n";
 		}
-	    }
 
-	    if ($code =~ /success/) {
-		if ($success) {
-		    $code =~ s/^/' ' x 4/meg;
-		    $code =~ s/^ {8}/\t/mg;
+		if ($code =~ /success/) {
+		    my $tests = 0;
 
-		    $code .= ' '  x 4 . "}\n";
-		    $result .= ' ' x 2 . "if (success)\n" . ' ' x 4 . "{\n";
-		}
-		else {
-		    $success_init = 0;
-		}
+		    if (exists $_->{on_success}) {
+			$code .= ' ' x 2 . "if (success)\n";
+			$code .= &format_code_frag($_->{on_success}, 1);
+			$tests++;
+		    }
 
-		$success = 1;
+		    if (exists $_->{on_fail}) {
+			$code .= ' ' x 2;
+			$code .= $tests ? "else\n" : "if (success)\n"; 
+			$code .= &format_code_frag($_->{on_fail}, 1);
+		    }
+
+		    if ($success) {
+			$code =~ s/^/' ' x 4/meg;
+			$code =~ s/^ {8}/\t/mg;
+
+			$code .= ' '  x 4 . "}\n";
+			$result .= ' ' x 2 . "if (success)\n" . ' ' x 4 . "{\n";
+		    }
+		    else {
+			$success_init = 0;
+		    }
+
+		    $success = 1;
+		}
 	    }
 
 	    $result .= $code;
@@ -324,51 +364,128 @@ CODE
 	$out->{code} .= "\nstatic Argument *\n";
 	$out->{code} .= "${name}_invoker (Argument *args)\n{\n";
 
-	my $invoker = "";
-	$invoker .= ' ' x 2 . "Argument *return_args;\n" if scalar @outargs;
-	$invoker .= &declare_args($proc, $out, qw(inargs outargs));
+	my $code = "";
+
+	if (exists $proc->{invoke}->{pass_through}) {
+	    my $invoke = $proc->{invoke};
 
-	if (exists $proc->{invoke}->{vars}) {
-	    foreach (@{$proc->{invoke}->{vars}}) {
-		$invoker .= ' ' x 2 . $_ . ";\n";
+	    my $argc = 0;
+	    $argc += @{$invoke->{pass_args}} if exists $invoke->{pass_args};
+	    $argc += @{$invoke->{make_args}} if exists $invoke->{make_args};
+
+	    my %pass; my @passgroup;
+	    my $before = 0; my $contig = 0; my $pos = -1;
+	    if (exists $invoke->{pass_args}) {
+		foreach (@{$invoke->{pass_args}}) {
+		    $pass{$_}++;
+		    $_ - 1 == $before ? $contig = 1 : $pos++;
+		    push @{$passgroup[$pos]}, $_;
+		    $before = $_;
+		}
+	    } 
+	    $code .= ' ' x 2 . "int i;\n" if $contig;
+
+	    $code .= ' ' x 2 . "Argument argv[$argc];\n";
+
+	    my $tempproc; $pos = 0;
+	    foreach (@{$proc->{inargs}}) {
+		$_->{argpos} = $pos++;
+		push @{$tempproc->{inargs}}, $_ if !exists $pass{$_->{argpos}};
 	    }
-	}
 
-	$invoker.= &marshal_inargs($proc);
+	    $code .= &declare_args($tempproc, $out, qw(inargs)) . "\n";
 
-	$invoker .= "\n" if $invoker && $invoker !~ /\n\n/s;
+	    my $marshal = "";
+	    foreach (@{$tempproc->{inargs}}) {
+		my $argproc; $argproc->{inargs} = [ $_ ];
+		$marshal .= &marshal_inargs($argproc, $_->{argpos});
+	    }
+
+	    if ($success) {
+		$marshal .= <<CODE;
+  if (!success)
+    return procedural_db_return_args (\&${name}_proc, FALSE);
 
-	my $code = $proc->{invoke}->{code};
+CODE
+	    }
+
+	    $marshal = substr($marshal, 1) if $marshal;
+	    $code .= $marshal;
+
+	    foreach (@passgroup) {
+		$code .= ($#$_ ? <<LOOP : <<CODE) . "\n";
+  for (i = $_->[0]; i < @{[ $_->[$#$_] + 1 ]}; i++)
+    argv[i] = args[i];
+LOOP
+  argv[$_->[0]] = args[$_->[0]];
+CODE
+	    }
+
+	    if (exists $invoke->{make_args}) {
+		$pos = 0;
+		foreach (@{$invoke->{make_args}}) {
+		    while (exists $pass{$pos}) { $pos++ }
+		    
+		    my $arg = $arg_types{(&arg_parse($_->{type}))[0]};
+		    my $type = &arg_ptype($arg);
+
+		    $code .= <<CODE;
+  argv[$pos].arg_type = PDB_$arg->{name};
+CODE
 
-	chomp $code;
-	$code =~ s/\t/' ' x 8/eg;
+		    my $frag = $_->{code};
+		    $frag =~ s/%%arg%%/"argv[$pos].value.pdb_$type"/e;
+		    $code .= &format_code_frag($frag, 0);
 
-	if ($code =~ /^\s*\{\s*\n.*\n\s*\}\s*$/s && !$success) {
-	    $code =~ s/^\s*\{\s*\n//s;
-	    $code =~ s/\n\s*}\s*$//s;
+		    $pos++;
+		}
+		$code .= "\n";
+	    }
+
+	    $code .= <<CODE;
+  return $invoke->{pass_through}_invoker (argv);
+}
+CODE
 	}
 	else {
-	    $code =~ s/^/' ' x 2/meg;
-	    $code =~ s/^/' ' x 2/meg if $success;
-	}
-	$code =~ s/^ {8}/\t/mg;
+	    my $invoker = "";
+	
+	    $invoker .= ' ' x 2 . "Argument *return_args;\n" if scalar @outargs;
+	    $invoker .= &declare_args($proc, $out, qw(inargs outargs));
+
+	    if (exists $proc->{invoke}->{vars}) {
+		foreach (@{$proc->{invoke}->{vars}}) {
+		   $invoker .= ' ' x 2 . $_ . ";\n";
+		}
+	    }
+
+	    $invoker .= &marshal_inargs($proc, 0);
+
+	    $invoker .= "\n" if $invoker && $invoker !~ /\n\n/s;
 
-	$code = ' ' x 2 . "if (success)\n" . $code if $success;
-	$success = ($code =~ /success =/) unless $success;
+	    my $frag = &format_code_frag($proc->{invoke}->{code}, $success);
+
+	    $frag = ' ' x 2 . "if (success)\n" . $frag if $success;
+	    $success = ($frag =~ /success =/) unless $success;
+
+	    $code .= $invoker . $frag;
+	    $code .= "\n" if $frag =~ /\n\n/s || $invoker;
+	    $code .= &marshal_outargs($proc) . "}\n";
+	}
 
 	if ($success) {
 	    $success_init = 0 if $proc->{invoke}->{success} eq 'NONE';
 
-	    $out->{code} .= ' ' x 2 . "gboolean success";
-	    $out->{code} .= " = $proc->{invoke}->{success}" if $success_init;
-	    $out->{code} .= ";\n";
+	    my $header = ' ' x 2 . "gboolean success";
+	    $header .= " = $proc->{invoke}->{success}" if $success_init;
+	    $header .= ";\n";
+
+	    $out->{code} .= $header;
 	}
 
-	$out->{code} .= $invoker . $code . "\n";
-	$out->{code} .= "\n" if $code =~ /\n/s || $invoker;
-	$out->{code} .= &marshal_outargs($proc) . "}\n";
+        $out->{code} .= $code;
 
-	$out->{code} .= &make_args($proc, qw(inargs outargs));
+	$out->{code} .= &make_arg_recs($proc, qw(inargs outargs));
 
 	$out->{code} .= <<CODE;
 

tools/pdbgen/enumgen.pl

@@ -18,12 +18,24 @@
 # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 
 BEGIN {
+    $srcdir = '.';
     $destdir = '.';
 }
 
+use lib $srcdir;
+
 use Text::Wrap qw(wrap $columns);
 $columns = 79;
 
+require 'util.pl';
+
+eval <<'CODE';
+*write_file = \&Gimp::CodeGen::util::write_file;
+*FILE_EXT   = \$Gimp::CodeGen::util::FILE_EXT;
+CODE
+
+$FILE_EXT = $FILE_EXT;
+
 my $header = <<'HEADER';
 :# The GIMP -- an image manipulation program
 :# Copyright (C) 1999 Manish Singh <yosh@gimp.org>
@@ -188,6 +200,8 @@ ENTRY
 
 $code =~ s/,\n$/\n/s;
 
-open OUTFILE, "> $destdir/enums.pl";
+$outfile = "$destdir/enums.pl$FILE_EXT";
+open OUTFILE, "> $outfile";
 print OUTFILE $header, $code, $footer;
 close OUTFILE;
+&write_file($outfile);

tools/pdbgen/enums.pl

@@ -29,6 +29,18 @@ package Gimp::CodeGen::enums;
 		       WEB_PALETTE => '2',
 		       MONO_PALETTE => '3',
 		       CUSTOM_PALETTE => '4' }
+	},
+    ChannelOffsetType =>
+	{ contig => 1,
+	  symbols => [ qw(OFFSET_BACKGROUND OFFSET_TRANSPARENT) ],
+	  mapping => { OFFSET_BACKGROUND => '0',
+		       OFFSET_TRANSPARENT => '1' }
+	},
+    SizeType =>
+	{ contig => 1,
+	  symbols => [ qw(PIXELS POINTS) ],
+	  mapping => { PIXELS => '0',
+		       POINTS => '1' }
 	}
 );
 

tools/pdbgen/groups.pl

@@ -17,4 +17,4 @@
 
 # Modify this list for the groups to parse in the pdb directory
 @groups = qw(gdisplay edit floating_sel undo palette gradient
-	     convert);
+	     convert channel_ops text gimprc parasite);

tools/pdbgen/lib.pl

@@ -138,7 +138,7 @@ CODE
 		$return_marshal = "" unless $once++;
 
 	        if (exists $_->{num}) {
-		    if (not exists $_->{no_lib}) {
+		    if (!exists $_->{no_lib}) {
 			$arglist .= "gint \*$_->{name}, ";
 			push @arraynums, $_;
 		    }

tools/pdbgen/pdb.pl

@@ -35,34 +35,37 @@ package Gimp::CodeGen::pdb;
 
     display   => { name => 'DISPLAY',
 		   type => 'GDisplay *',
+		   headers => [ qw("gdisplay.h") ],
 		   id_func => 'gdisplay_get_ID',
-		   id_ret_func => '$var->ID',
-		   id_headers => [ qw("gdisplay.h") ] },
+		   id_ret_func => '$var->ID' },
     image     => { name => 'IMAGE',
 		   type => 'GimpImage *', 
+		   headers => [ qw("procedural_db.h") ],
 		   id_func => 'pdb_id_to_image',
-		   id_ret_func => 'pdb_image_to_id ($var)',
-		   id_headers => [ qw("procedural_db.h") ] },
+		   id_ret_func => 'pdb_image_to_id ($var)' },
     layer     => { name => 'LAYER',
 		   type => 'GimpLayer *', 
+		   headers => [ qw("drawable.h" "layer.h") ],
 		   id_func => 'layer_get_ID',
-		   id_ret_func => 'drawable_ID (GIMP_DRAWABLE ($var))',
-		   id_headers => [ qw("drawable.h" "layer.h") ] },
+		   id_ret_func => 'drawable_ID (GIMP_DRAWABLE ($var))' },
     channel   => { name => 'CHANNEL',
 		   type => 'Channel *',
+		   headers => [ qw("drawable.h" "channel.h") ],
 		   id_func => 'channel_get_ID',
-		   id_ret_func => 'drawable_ID (GIMP_DRAWABLE ($var))',
-		   id_headers => [ qw("drawable.h" "channel.h") ] },
+		   id_ret_func => 'drawable_ID (GIMP_DRAWABLE ($var))' },
     drawable  => { name => 'DRAWABLE',
 		   type => 'GimpDrawable *',
+		   headers => [ qw("drawable.h") ],
 		   id_func => 'gimp_drawable_get_ID',
-		   id_ret_func => 'drawable_ID (GIMP_DRAWABLE ($var))',
-		   id_headers => [ qw("drawable.h") ] },
+		   id_ret_func => 'drawable_ID (GIMP_DRAWABLE ($var))' },
     selection => { name => 'SELECTION',
 		   type => 'Channel *',
+		   headers => [ qw("drawable.h" "channel.h") ],
 		   id_func => 'channel_get_ID',
-		   id_ret_func => 'drawable_ID (GIMP_DRAWABLE ($var))',
-		   id_headers => [ qw("drawable.h" "channel.h") ] },
+		   id_ret_func => 'drawable_ID (GIMP_DRAWABLE ($var))' },
+
+    parasite => { name => 'PARASITE', type => 'Parasite *',
+		  headers => [ qw("libgimp/parasite.h") ] },
 
     boundary => { name => 'BOUNDARY', type => 'gpointer ' }, # ??? FIXME
     path     => { name => 'PATH'    , type => 'gpointer ' }, # ??? FIXME
@@ -97,11 +100,9 @@ sub arg_parse {
 
 	return @retvals;
     }
-    elsif ($arg =~ /^([+-.\d].*?)? \s*
-		     (<=|<)? \s*
-		     (\w+) \s*
-		     (<=|<)? \s*
-		     ([\d\.-].*?)?
+    elsif ($arg =~ /^(?:([+-.\d].*?) \s* (<=|<))?
+		     \s* (\w+) \s*
+		     (?:(<=|<) \s* ([+-.\d].*?))?
 		   /x) {
 	return ($3, $1, $2 ? $testmap{$2} : $2, $5, $4 ? $testmap{$4} : $4);
     }
@@ -115,7 +116,7 @@ sub arg_ptype {
 	elsif ($arg->{type} =~ /\*/)      { 'pointer' }
 	elsif ($arg->{type} =~ /boolean/) { 'int'     }
 	elsif ($arg->{type} =~ /int/)     { 'int'     }
-	elsif ($arg->{type} =~ /float/)   { 'float'   }
+	elsif ($arg->{type} =~ /double/)  { 'float'   }
 	else                              { 'pointer' }
     };
 }

tools/pdbgen/pdb/channel_ops.pdb

@@ -38,7 +38,7 @@ HELP
 	  desc => 'The drawable to offset' },
 	{ name => 'wrap_around', type => 'boolean',
 	  desc => 'wrap image around or fill vacated regions' },
-	{ name => 'fill_type', type => 'enum GimpOffsetType',
+	{ name => 'fill_type', type => 'enum ChannelOffsetType',
 	  desc => 'fill vacated regions of drawable with background or
 		   transparent: %%desc%%' },
 	{ name => 'offset_x', type => 'int32',
@@ -48,7 +48,7 @@ HELP
     );
 
     %invoke = (
-	headers => [ qw(channel_ops.h) ],
+	headers => [ qw("channel_ops.h") ],
 	vars => ['GimpImage *gimage'],
 	code => <<'CODE'
 {

tools/pdbgen/pdb/display.pdb

@@ -47,7 +47,7 @@ HELP
   if (gimage->layers == NULL)
     success = FALSE;
   else
-    success = ((gdisp = gdisplay_new (gimage, scale)) != NULL);
+    success = (gdisp = gdisplay_new (gimage, scale)) != NULL;
 }
 CODE
     );

tools/pdbgen/pdb/gdisplay.pdb

@@ -47,7 +47,7 @@ HELP
   if (gimage->layers == NULL)
     success = FALSE;
   else
-    success = ((gdisp = gdisplay_new (gimage, scale)) != NULL);
+    success = (gdisp = gdisplay_new (gimage, scale)) != NULL;
 }
 CODE
     );

tools/pdbgen/pdb/gimprc.pdb

+# The GIMP -- an image manipulation program
+# Copyright (C) 1995 Spencer Kimball and Peter Mattis
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+# "Perlized" from C source by Manish Singh <yosh@gimp.org>
+
+# The defs
+
+sub gimprc_query {
+    $blurb = <<'BLURB';
+Queries the gimprc file parser for information on a specified token.
+BLURB
+
+    $help = <<'HELP';
+This procedure is used to locate additional information contained in the gimprc
+file considered extraneous to the operation of the GIMP. Plug-ins that need
+configuration information can expect it will be stored in the user's gimprc
+file and can use this procedure to retrieve it. This query procedure will
+return the value associated with the specified token. This corresponds _only_
+to entries with the format: (<token> <value>). The value must be a string.
+Entries not corresponding to this format will cause warnings to be issued on
+gimprc parsing a nd will not be queryable.
+HELP
+
+    &std_pdb_misc;
+    $date = '1997';
+
+    @inargs = (
+	{ name => 'token', type => 'string',
+	  desc => 'The token to query for' }
+    );
+
+    @outargs = (
+	{ name => 'value', type => 'string',
+	  desc => 'The value associated with the queried token',
+	  alias => 'g_strdup (value)', no_declare => 1 }
+    );
+
+    %invoke = (
+	headers => [ qw("gimprc.h") ],
+	vars => ['gchar *value'],
+	code => 'success = (value = gimprc_find_token (token)) != NULL;'
+    );
+}
+
+@procs = qw(gimprc_query);
+%exports = (app => [@procs]);
+
+$desc = 'Gimprc procedures';
+
+1;

tools/pdbgen/pdb/gradient_select.pdb

@@ -36,7 +36,7 @@ HELP
 
     @inargs = (
 	{ name => 'name', type => 'string',
-	  desc => 'The gradient name ("" means current active gradient)' }
+	  desc => 'The gradient name ("" means current active gradient)' },
 	{ name => 'sample_size', type => '0 < int32 < 10000',
 	  desc => 'The size of the sample to return when the gradient is
 		   changed $desc',

tools/pdbgen/pdb/misc_tools.pdb

@@ -161,7 +161,7 @@ Fill the area specified either by the current selection if there is one, or by
 a seed fill starting at the specified coordinates.
 BLURB
 
-    $help = <<'HELP'
+    $help = <<'HELP';
 This tool requires information on the paint application mode, and the fill
 mode, which can either be in the foreground color, or in the currently active
 pattern. If there is no selection, a seed fill is executed at the specified
@@ -172,12 +172,12 @@ the composite image will be used instead of that for the specified drawable.
 This is equivalent to sampling for colors after merging all visible layers. In
 the case of merged sampling, the x,y coordinates are relative to the image's
 origin; otherwise, they are relative to the drawable's origin.
-HELP;
+HELP
 
     &std_pdb_misc;
 
     my $validity = 'This parameter is only valid when there is no selection in
-		    the specified image.'
+		    the specified image.';
     my $coord = "The \$a coordinate of this bucket fill's application.
 		 $validity";
 
@@ -187,16 +187,16 @@ HELP;
 	  desc => 'The type of fill: %%desc%%' },
 	{ name => paint_mode, type => 'enum PaintMode',
 	  desc => 'The paint application mode: %%desc%%' },
-	{ name => opacity, type => '0 <= float <= 100',
+	{ name => 'opacity', type => '0 <= float <= 100',
 	  desc => 'The opacity of the final bucket fill %%desc%%' },
-	{ name => threshold, type => '0 <= float <= 255',
+	{ name => 'threshold', type => '0 <= float <= 255',
 	  desc => "The threshold determines how extensive the seed fill will
 		   be. It's value is specified in terms of intensity levels
 		   %%desc%%. $validity" },
 	&sample_merged_arg,