Adding upstream version 2.10.34.upstream/2.10.34upstream

Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>

1 files changed, 931 insertions, 0 deletions

diff --git a/pdb/app.pl b/pdb/app.pl
new file mode 100644
index 0000000..83d00e3
--- /dev/null
+++ b/pdb/app.pl
@@ -0,0 +1,931 @@
+# GIMP - The GNU Image Manipulation Program
+# Copyright (C) 1998-2003 Manish Singh <yosh@gimp.org>
+
+# 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 3 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, see <https://www.gnu.org/licenses/>.
+
+package Gimp::CodeGen::app;
+
+$destdir  = "$main::destdir/app/pdb";
+$builddir = "$main::builddir/app/pdb";
+
+*arg_types = \%Gimp::CodeGen::pdb::arg_types;
+*arg_parse = \&Gimp::CodeGen::pdb::arg_parse;
+
+*enums = \%Gimp::CodeGen::enums::enums;
+
+*write_file = \&Gimp::CodeGen::util::write_file;
+*FILE_EXT   = \$Gimp::CodeGen::util::FILE_EXT;
+
+use Text::Wrap qw(wrap);
+
+sub quotewrap {
+    my ($str, $indent, $subsequent_indent) = @_;
+    my $leading = ' ' x $indent . '"';
+    my $subsequent_leading = ' ' x $subsequent_indent . '"';
+    $Text::Wrap::columns = 1000;
+    $Text::Wrap::unexpand = 0;
+    $str = wrap($leading, $subsequent_leading, $str);
+    $str =~ s/^\s*//s;
+    $str =~ s/(.)\n(.)/$1\\n"\n$2/g;
+    $str =~ s/(.)$/$1"/s;
+    $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 .= "\n";
+
+    $code =~ s/^\s+$//mg;
+
+    $code;
+}
+
+sub declare_args {
+    my $proc = shift;
+    my $out = shift;
+    my $outargs = shift;
+
+    local $result = "";
+
+    foreach (@_) {
+	my @args = @{$proc->{$_}} if (defined $proc->{$_});
+
+	foreach (@args) {
+	    my ($type, $name) = &arg_parse($_->{type});
+	    my $arg = $arg_types{$type};
+
+	    if ($arg->{array} && !exists $_->{array}) {
+		warn "Array without number of elements param in $proc->{name}";
+	    }
+
+	    unless (exists $_->{no_declare} || exists $_->{dead}) {
+		if ($outargs) {
+		    $result .= "  $arg->{type}$_->{name} = $arg->{init_value}";
+		}
+		else {
+		    $result .= "  $arg->{const_type}$_->{name}";
+		}
+		$result .= ";\n";
+
+		if (exists $arg->{headers}) {
+		    foreach (@{$arg->{headers}}) {
+			$out->{headers}->{$_}++;
+		    }
+		}
+	    }
+	}
+    }
+
+    $result;
+}
+
+sub marshal_inargs {
+    my ($proc, $argc) = @_;
+
+    my $result = "";
+    my %decls;
+
+    my @inargs = @{$proc->{inargs}} if (defined $proc->{inargs});
+
+    foreach (@inargs) {
+	my($pdbtype, @typeinfo) = &arg_parse($_->{type});
+	my $arg = $arg_types{$pdbtype};
+	my $var = $_->{name};
+	my $value;
+
+	$value = "gimp_value_array_index (args, $argc)";
+	if (!exists $_->{dead}) {
+	    $result .= eval qq/"  $arg->{get_value_func};\n"/;
+	}
+
+	$argc++;
+
+	if (!exists $_->{no_validate}) {
+	    $success = 1;
+	}
+    }
+
+    $result = "\n" . $result . "\n" if $result;
+    $result;
+}
+
+sub marshal_outargs {
+    my $proc = shift;
+    my $result;
+    my $argc = 0;
+    my @outargs = @{$proc->{outargs}} if (defined $proc->{outargs});
+
+    if ($success) {
+	$result = <<CODE;
+  return_vals = gimp_procedure_get_return_values (procedure, success,
+                                                  error ? *error : NULL);
+CODE
+    } else {
+	$result = <<CODE;
+  return_vals = gimp_procedure_get_return_values (procedure, TRUE, NULL);
+CODE
+    }
+
+    if (scalar @outargs) {
+	my $outargs = "";
+
+	foreach (@{$proc->{outargs}}) {
+	    my ($pdbtype) = &arg_parse($_->{type});
+	    my $arg = $arg_types{$pdbtype};
+	    my $var = $_->{name};
+	    my $var_len;
+	    my $value;
+
+	    $argc++;
+
+	    $value = "gimp_value_array_index (return_vals, $argc)";
+
+	    if (exists $_->{array}) {
+		my $arrayarg = $_->{array};
+
+		if (exists $arrayarg->{name}) {
+		    $var_len = $arrayarg->{name};
+		}
+		else {
+		    $var_len = 'num_' . $_->{name};
+		}
+	    }
+
+	    $outargs .= eval qq/"  $arg->{set_value_func};\n"/;
+	}
+
+	$outargs =~ s/^/' ' x 2/meg if $success;
+	$outargs =~ s/^/' ' x 2/meg if $success && $argc > 1;
+
+	$result .= "\n" if $success || $argc > 1;
+	$result .= ' ' x 2 . "if (success)\n" if $success;
+	$result .= ' ' x 4 . "{\n" if $success && $argc > 1;
+	$result .= $outargs;
+	$result .= ' ' x 4 . "}\n" if $success && $argc > 1;
+        $result .= "\n" . ' ' x 2 . "return return_vals;\n";
+    }
+    else {
+	if ($success) {
+	    $result =~ s/return_vals =/return/;
+	    $result =~ s/       error/error/;
+	}
+	else {
+	    $result =~ s/  return_vals =/\n  return/;
+	    $result =~ s/       error/error/;
+	}
+    }
+
+    $result;
+}
+
+sub generate_pspec {
+    my $arg = shift;
+    my ($pdbtype, @typeinfo) = &arg_parse($arg->{type});
+    my $name = $arg->{canonical_name};
+    my $nick = $arg->{canonical_name};
+    my $blurb = exists $arg->{desc} ? $arg->{desc} : "";
+    my $min;
+    my $max;
+    my $default;
+    my $flags = 'GIMP_PARAM_READWRITE';
+    my $pspec = "";
+    my $postproc = "";
+
+    $nick =~ s/-/ /g;
+
+    if (exists $arg->{no_validate}) {
+	$flags .= ' | GIMP_PARAM_NO_VALIDATE';
+    }
+
+    if ($pdbtype eq 'image') {
+	$none_ok = exists $arg->{none_ok} ? 'TRUE' : 'FALSE';
+	$pspec = <<CODE;
+gimp_param_spec_image_id ("$name",
+                          "$nick",
+                          "$blurb",
+                          pdb->gimp, $none_ok,
+                          $flags)
+CODE
+    }
+    elsif ($pdbtype eq 'item') {
+	$none_ok = exists $arg->{none_ok} ? 'TRUE' : 'FALSE';
+	$pspec = <<CODE;
+gimp_param_spec_item_id ("$name",
+                         "$nick",
+                         "$blurb",
+                         pdb->gimp, $none_ok,
+                         $flags)
+CODE
+    }
+    elsif ($pdbtype eq 'drawable') {
+	$none_ok = exists $arg->{none_ok} ? 'TRUE' : 'FALSE';
+	$pspec = <<CODE;
+gimp_param_spec_drawable_id ("$name",
+                             "$nick",
+                             "$blurb",
+                             pdb->gimp, $none_ok,
+                             $flags)
+CODE
+    }
+    elsif ($pdbtype eq 'layer') {
+	$none_ok = exists $arg->{none_ok} ? 'TRUE' : 'FALSE';
+	$pspec = <<CODE;
+gimp_param_spec_layer_id ("$name",
+                          "$nick",
+                          "$blurb",
+                          pdb->gimp, $none_ok,
+                          $flags)
+CODE
+    }
+    elsif ($pdbtype eq 'channel') {
+	$none_ok = exists $arg->{none_ok} ? 'TRUE' : 'FALSE';
+	$pspec = <<CODE;
+gimp_param_spec_channel_id ("$name",
+                            "$nick",
+                            "$blurb",
+                            pdb->gimp, $none_ok,
+                            $flags)
+CODE
+    }
+    elsif ($pdbtype eq 'layer_mask') {
+	$none_ok = exists $arg->{none_ok} ? 'TRUE' : 'FALSE';
+	$pspec = <<CODE;
+gimp_param_spec_layer_mask_id ("$name",
+                               "$nick",
+                               "$blurb",
+                               pdb->gimp, $none_ok,
+                               $flags)
+CODE
+    }
+    elsif ($pdbtype eq 'selection') {
+	$none_ok = exists $arg->{none_ok} ? 'TRUE' : 'FALSE';
+	$pspec = <<CODE;
+gimp_param_spec_selection_id ("$name",
+                              "$nick",
+                              "$blurb",
+                              pdb->gimp, $none_ok,
+                              $flags)
+CODE
+    }
+    elsif ($pdbtype eq 'vectors') {
+	$none_ok = exists $arg->{none_ok} ? 'TRUE' : 'FALSE';
+	$pspec = <<CODE;
+gimp_param_spec_vectors_id ("$name",
+                            "$nick",
+                            "$blurb",
+                            pdb->gimp, $none_ok,
+                            $flags)
+CODE
+    }
+    elsif ($pdbtype eq 'display') {
+	$none_ok = exists $arg->{none_ok} ? 'TRUE' : 'FALSE';
+	$pspec = <<CODE;
+gimp_param_spec_display_id ("$name",
+                            "$nick",
+                            "$blurb",
+                            pdb->gimp, $none_ok,
+                            $flags)
+CODE
+    }
+    elsif ($pdbtype eq 'tattoo') {
+	$pspec = <<CODE;
+g_param_spec_uint ("$name",
+                   "$nick",
+                   "$blurb",
+                   1, G_MAXUINT32, 1,
+                   $flags)
+CODE
+    }
+    elsif ($pdbtype eq 'guide') {
+	$pspec = <<CODE;
+g_param_spec_uint ("$name",
+                   "$nick",
+                   "$blurb",
+                   1, G_MAXUINT32, 1,
+                   $flags)
+CODE
+    }
+    elsif ($pdbtype eq 'sample_point') {
+	$pspec = <<CODE;
+g_param_spec_uint ("$name",
+                   "$nick",
+                   "$blurb",
+                   1, G_MAXUINT32, 1,
+                   $flags)
+CODE
+    }
+    elsif ($pdbtype eq 'float') {
+	$min = defined $typeinfo[0] ? $typeinfo[0] : -G_MAXDOUBLE;
+	$max = defined $typeinfo[2] ? $typeinfo[2] : G_MAXDOUBLE;
+	$default = exists $arg->{default} ? $arg->{default} : defined $typeinfo[0] ? $typeinfo[0] : 0.0;
+	$pspec = <<CODE;
+g_param_spec_double ("$name",
+                     "$nick",
+                     "$blurb",
+                     $min, $max, $default,
+                     $flags)
+CODE
+    }
+    elsif ($pdbtype eq 'int32') {
+	if (defined $typeinfo[0]) {
+	    $min = ($typeinfo[1] eq '<') ? ($typeinfo[0] + 1) : $typeinfo[0];
+	}
+	else {
+	    $min = G_MININT32;
+	}
+	if (defined $typeinfo[2]) {
+	    $max = ($typeinfo[3] eq '<') ? ($typeinfo[2] - 1) : $typeinfo[2];
+	}
+	else {
+	    $max = G_MAXINT32;
+	}
+	$default = exists $arg->{default} ? $arg->{default} : defined $typeinfo[0] ? $typeinfo[0] : 0;
+	$pspec = <<CODE;
+gimp_param_spec_int32 ("$name",
+                       "$nick",
+                       "$blurb",
+                       $min, $max, $default,
+                       $flags)
+CODE
+    }
+    elsif ($pdbtype eq 'int16') {
+	if (defined $typeinfo[0]) {
+	    $min = ($typeinfo[1] eq '<') ? ($typeinfo[0] + 1) : $typeinfo[0];
+	}
+	else {
+	    $min = G_MININT16;
+	}
+	if (defined $typeinfo[2]) {
+	    $max = ($typeinfo[3] eq '<') ? ($typeinfo[2] - 1) : $typeinfo[2];
+	}
+	else {
+	    $max = G_MAXINT16;
+	}
+	$default = exists $arg->{default} ? $arg->{default} : defined $typeinfo[0] ? $typeinfo[0] : 0;
+	$pspec = <<CODE;
+gimp_param_spec_int16 ("$name",
+                       "$nick",
+                       "$blurb",
+                       $min, $max, $default,
+                       $flags)
+CODE
+    }
+    elsif ($pdbtype eq 'int8') {
+	if (defined $typeinfo[0]) {
+	    $min = ($typeinfo[1] eq '<') ? ($typeinfo[0] + 1) : $typeinfo[0];
+	}
+	else {
+	    $min = 0;
+	}
+	if (defined $typeinfo[2]) {
+	    $max = ($typeinfo[3] eq '<') ? ($typeinfo[2] - 1) : $typeinfo[2];
+	}
+	else {
+	    $max = G_MAXUINT8;
+	}
+	$default = exists $arg->{default} ? $arg->{default} : defined $typeinfo[0] ? $typeinfo[0] : 0;
+	$pspec = <<CODE;
+gimp_param_spec_int8 ("$name",
+                      "$nick",
+                      "$blurb",
+                      $min, $max, $default,
+                      $flags)
+CODE
+    }
+    elsif ($pdbtype eq 'boolean') {
+	$default = exists $arg->{default} ? $arg->{default} : FALSE;
+	$pspec = <<CODE;
+g_param_spec_boolean ("$name",
+                      "$nick",
+                      "$blurb",
+                      $default,
+                      $flags)
+CODE
+    }
+    elsif ($pdbtype eq 'string') {
+	$allow_non_utf8 = exists $arg->{allow_non_utf8} ? 'TRUE' : 'FALSE';
+	$null_ok = exists $arg->{null_ok} ? 'TRUE' : 'FALSE';
+	$non_empty = exists $arg->{non_empty} ? 'TRUE' : 'FALSE';
+	$default = exists $arg->{default} ? $arg->{default} : NULL;
+	$pspec = <<CODE;
+gimp_param_spec_string ("$name",
+                        "$nick",
+                        "$blurb",
+                        $allow_non_utf8, $null_ok, $non_empty,
+                        $default,
+                        $flags)
+CODE
+    }
+    elsif ($pdbtype eq 'enum') {
+	$enum_type = $typeinfo[0];
+	$enum_type =~ s/([a-z])([A-Z])/$1_$2/g;
+	$enum_type =~ s/([A-Z]+)([A-Z])/$1_$2/g;
+	$enum_type =~ tr/[a-z]/[A-Z]/;
+	$enum_type =~ s/^GIMP/GIMP_TYPE/;
+	$enum_type =~ s/^GEGL/GEGL_TYPE/;
+	$default = exists $arg->{default} ? $arg->{default} : $enums{$typeinfo[0]}->{symbols}[0];
+
+	my ($foo, $bar, @remove) = &arg_parse($arg->{type});
+
+	foreach (@remove) {
+	    $postproc .= 'gimp_param_spec_enum_exclude_value (GIMP_PARAM_SPEC_ENUM ($pspec),';
+	    $postproc .= "\n                                    $_);\n";
+	}
+
+	if ($postproc eq '') {
+	    $pspec = <<CODE;
+g_param_spec_enum ("$name",
+                   "$nick",
+                   "$blurb",
+                   $enum_type,
+                   $default,
+                   $flags)
+CODE
+	}
+	else {
+	    $pspec = <<CODE;
+gimp_param_spec_enum ("$name",
+                      "$nick",
+                      "$blurb",
+                      $enum_type,
+                      $default,
+                      $flags)
+CODE
+        }
+    }
+    elsif ($pdbtype eq 'unit') {
+	$typeinfo[0] = 'GIMP_UNIT_PIXEL' unless defined $typeinfo[0];
+	$allow_pixels = $typeinfo[0] eq 'GIMP_UNIT_PIXEL' ? TRUE : FALSE;
+	$allow_percent = exists $arg->{allow_percent} ? TRUE : FALSE;
+	$default = exists $arg->{default} ? $arg->{default} : $typeinfo[0];
+	$pspec = <<CODE;
+gimp_param_spec_unit ("$name",
+                      "$nick",
+                      "$blurb",
+                      $allow_pixels,
+                      $allow_percent,
+                      $default,
+                      $flags)
+CODE
+    }
+    elsif ($pdbtype eq 'color') {
+	$has_alpha = exists $arg->{has_alpha} ? TRUE : FALSE;
+	$default = exists $arg->{default} ? $arg->{default} : NULL;
+	$pspec = <<CODE;
+gimp_param_spec_rgb ("$name",
+                     "$nick",
+                     "$blurb",
+                     $has_alpha,
+                     $default,
+                     $flags)
+CODE
+    }
+    elsif ($pdbtype eq 'parasite') {
+	$pspec = <<CODE;
+gimp_param_spec_parasite ("$name",
+                          "$nick",
+                          "$blurb",
+                          $flags)
+CODE
+    }
+    elsif ($pdbtype eq 'int32array') {
+	$pspec = <<CODE;
+gimp_param_spec_int32_array ("$name",
+                             "$nick",
+                             "$blurb",
+                             $flags)
+CODE
+    }
+    elsif ($pdbtype eq 'int16array') {
+	$pspec = <<CODE;
+gimp_param_spec_int16_array ("$name",
+                             "$nick",
+                             "$blurb",
+                             $flags)
+CODE
+    }
+    elsif ($pdbtype eq 'int8array') {
+	$pspec = <<CODE;
+gimp_param_spec_int8_array ("$name",
+                            "$nick",
+                            "$blurb",
+                            $flags)
+CODE
+    }
+    elsif ($pdbtype eq 'floatarray') {
+	$pspec = <<CODE;
+gimp_param_spec_float_array ("$name",
+                             "$nick",
+                             "$blurb",
+                             $flags)
+CODE
+    }
+    elsif ($pdbtype eq 'stringarray') {
+	$pspec = <<CODE;
+gimp_param_spec_string_array ("$name",
+                              "$nick",
+                              "$blurb",
+                              $flags)
+CODE
+    }
+    elsif ($pdbtype eq 'colorarray') {
+	$pspec = <<CODE;
+gimp_param_spec_color_array ("$name",
+                             "$nick",
+                             "$blurb",
+                             $flags)
+CODE
+    }
+    else {
+	warn "Unsupported PDB type: $arg->{name} ($arg->{type})";
+	exit -1;
+    }
+
+    $pspec =~ s/\s$//;
+
+    return ($pspec, $postproc);
+}
+
+sub canonicalize {
+    $_ = shift; s/_/-/g; return $_;
+}
+
+sub generate {
+    my @procs = @{(shift)};
+    my %out;
+    my $total = 0.0;
+    my $argc;
+
+    foreach $name (@procs) {
+	my $proc = $main::pdb{$name};
+	my $out = \%{$out{$proc->{group}}};
+
+	my @inargs = @{$proc->{inargs}} if (defined $proc->{inargs});
+	my @outargs = @{$proc->{outargs}} if (defined $proc->{outargs});
+
+	my $blurb = $proc->{blurb};
+	my $help = $proc->{help};
+
+	my $procedure_name;
+
+	local $success = 0;
+
+	if ($proc->{deprecated}) {
+            if ($proc->{deprecated} eq 'NONE') {
+		if (!$blurb) {
+		    $blurb = "Deprecated: There is no replacement for this procedure.";
+		}
+		if ($help) {
+		    $help .= "\n\n";
+		}
+		$help .= "Deprecated: There is no replacement for this procedure.";
+	    }
+	    else {
+		if (!$blurb) {
+		    $blurb = "Deprecated: Use '$proc->{deprecated}' instead.";
+		}
+		if ($help) {
+		    $help .= "\n\n";
+		}
+		$help .= "Deprecated: Use '$proc->{deprecated}' instead.";
+	    }
+	}
+
+	$help =~ s/gimp(\w+)\(\s*\)/"'gimp".canonicalize($1)."'"/ge;
+
+	if ($proc->{group} eq "plug_in_compat") {
+	    $procedure_name = "$proc->{canonical_name}";
+	} else {
+	    $procedure_name = "gimp-$proc->{canonical_name}";
+	}
+
+	$out->{pcount}++; $total++;
+
+	$out->{register} .= <<CODE;
+
+  /*
+   * gimp-$proc->{canonical_name}
+   */
+  procedure = gimp_procedure_new (${name}_invoker);
+  gimp_object_set_static_name (GIMP_OBJECT (procedure),
+                               "$procedure_name");
+  gimp_procedure_set_static_strings (procedure,
+                                     "$procedure_name",
+                                     @{[ &quotewrap($blurb, 2, 37) ]},
+                                     @{[ &quotewrap($help,  2, 37) ]},
+                                     "$proc->{author}",
+                                     "$proc->{copyright}",
+                                     "$proc->{date}",
+                                     @{[$proc->{deprecated} ? "\"$proc->{deprecated}\"" : 'NULL']});
+CODE
+
+        $argc = 0;
+
+        foreach $arg (@inargs) {
+	    my ($pspec, $postproc) = &generate_pspec($arg);
+
+	    $pspec =~ s/^/' ' x length("  gimp_procedure_add_argument (")/meg;
+
+	    $out->{register} .= <<CODE;
+  gimp_procedure_add_argument (procedure,
+${pspec});
+CODE
+
+            if ($postproc ne '') {
+		$pspec = "procedure->args[$argc]";
+		$postproc =~ s/^/'  '/meg;
+		$out->{register} .= eval qq/"$postproc"/;
+	    }
+
+	    $argc++;
+	}
+
+	$argc = 0;
+
+	foreach $arg (@outargs) {
+	    my ($pspec, $postproc) = &generate_pspec($arg);
+	    my $argc = 0;
+
+	    $pspec =~ s/^/' ' x length("  gimp_procedure_add_return_value (")/meg;
+
+	    $out->{register} .= <<CODE;
+  gimp_procedure_add_return_value (procedure,
+${pspec});
+CODE
+
+            if ($postproc ne '') {
+		$pspec = "procedure->values[$argc]";
+		$postproc =~ s/^/'  '/meg;
+		$out->{register} .= eval qq/"$postproc"/;
+	    }
+
+	    $argc++;
+	}
+
+	$out->{register} .= <<CODE;
+  gimp_pdb_register_procedure (pdb, procedure);
+  g_object_unref (procedure);
+CODE
+
+	if (exists $proc->{invoke}->{headers}) {
+	    foreach $header (@{$proc->{invoke}->{headers}}) {
+		$out->{headers}->{$header}++;
+	    }
+	}
+
+	$out->{code} .= "\nstatic GimpValueArray *\n";
+	$out->{code} .= "${name}_invoker (GimpProcedure         *procedure,\n";
+	$out->{code} .=  ' ' x length($name) . "          Gimp                  *gimp,\n";
+	$out->{code} .=  ' ' x length($name) . "          GimpContext           *context,\n";
+	$out->{code} .=  ' ' x length($name) . "          GimpProgress          *progress,\n";
+	$out->{code} .=  ' ' x length($name) . "          const GimpValueArray  *args,\n";
+	$out->{code} .=  ' ' x length($name) . "          GError               **error)\n{\n";
+
+	my $code = "";
+
+	if (exists $proc->{invoke}->{no_marshalling}) {
+	    $code .= &format_code_frag($proc->{invoke}->{code}, 0) . "}\n";
+	}
+	else {
+	    my $invoker = "";
+	
+	    $invoker .= ' ' x 2 . "GimpValueArray *return_vals;\n" if scalar @outargs;
+	    $invoker .= &declare_args($proc, $out, 0, qw(inargs));
+	    $invoker .= &declare_args($proc, $out, 1, qw(outargs));
+
+	    $invoker .= &marshal_inargs($proc, 0);
+	    $invoker .= "\n" if $invoker && $invoker !~ /\n\n/s;
+
+	    my $frag = "";
+
+	    if (exists $proc->{invoke}->{code}) {
+		$frag = &format_code_frag($proc->{invoke}->{code}, $success);
+		$frag = ' ' x 2 . "if (success)\n" . $frag if $success;
+		$success = ($frag =~ /success =/) unless $success;
+	    }
+
+	    chomp $invoker if !$frag;
+	    $code .= $invoker . $frag;
+	    $code .= "\n" if $frag =~ /\n\n/s || $invoker;
+	    $code .= &marshal_outargs($proc) . "}\n";
+	}
+
+	if ($success) {
+	    $out->{code} .= ' ' x 2 . "gboolean success";
+	    unless ($proc->{invoke}->{success} eq 'NONE') {
+		$out->{code} .= " = $proc->{invoke}->{success}";
+	    }
+	    $out->{code} .= ";\n";
+	}
+
+        $out->{code} .= $code;
+    }
+
+    my $gpl = <<'GPL';
+/* GIMP - The GNU Image Manipulation Program
+ * Copyright (C) 1995-2003 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 3 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, see <https://www.gnu.org/licenses/>.
+ */
+
+/* NOTE: This file is auto-generated by pdbgen.pl. */
+
+GPL
+
+    my $group_procs = "";
+    my $longest = 0;
+    my $once = 0;
+    my $pcount = 0.0;
+
+    foreach $group (@main::groups) {
+	my $out = $out{$group};
+
+	foreach (@{$main::grp{$group}->{headers}}) { $out->{headers}->{$_}++ }
+
+	$out->{headers}->{"\"core/gimpparamspecs.h\""}++;
+
+	my @headers = sort {
+	    my ($x, $y) = ($a, $b);
+	    foreach ($x, $y) {
+		if (/^</) {
+		    s/^</!/;
+		}
+		elsif (!/libgimp/) {
+		    s/^/~/;
+		}
+	    }
+	    $x cmp $y;
+	} keys %{$out->{headers}};
+
+	my $headers = "";
+	my $lib = 0;
+	my $seen = 0;
+	my $sys = 0;
+	my $base = 0;
+	my $error = 0;
+	my $utils = 0;
+	my $context = 0;
+	my $intl = 0;
+
+	foreach (@headers) {
+	    $seen++ if /^</;
+
+	    if ($sys == 0 && !/^</) {
+		$sys = 1;
+		$headers .= "\n" if $seen;
+		$headers .= "#include <gegl.h>\n\n";
+		$headers .= "#include <gdk-pixbuf/gdk-pixbuf.h>\n\n";
+	    }
+
+	    $seen = 0 if !/^</;
+
+	    if (/libgimp/) {
+		$lib = 1;
+	    }
+	    else {
+		$headers .= "\n" if $lib;
+		$lib = 0;
+
+		if ($sys == 1 && $base == 0) {
+		    $base = 1;
+		    $headers .= "#include \"libgimpbase/gimpbase.h\"\n\n";
+		    $headers .= "#include \"pdb-types.h\"\n\n";
+		}
+	    }
+
+	    if (/gimp-intl/) {
+		$intl = 1;
+	    }
+	    elsif (/gimppdb-utils/) {
+		$utils = 1;
+	    }
+	    elsif (/gimppdberror/) {
+		$error = 1;
+	    }
+	    elsif (/gimppdbcontext/) {
+		$context = 1;
+	    }
+	    else {
+		$headers .= "#include $_\n";
+	    }
+	}
+
+	$headers .= "\n";
+	$headers .= "#include \"gimppdb.h\"\n";
+	$headers .= "#include \"gimppdberror.h\"\n" if $error;
+	$headers .= "#include \"gimppdb-utils.h\"\n" if $utils;
+	$headers .= "#include \"gimppdbcontext.h\"\n" if $context;
+	$headers .= "#include \"gimpprocedure.h\"\n";
+	$headers .= "#include \"internal-procs.h\"\n";
+
+	$headers .= "\n#include \"gimp-intl.h\"\n" if $intl;
+
+	my $extra = {};
+	if (exists $main::grp{$group}->{extra}->{app}) {
+	    $extra = $main::grp{$group}->{extra}->{app}
+	}
+
+	my $cfile = "$builddir/".canonicalize(${group})."-cmds.c$FILE_EXT";
+	open CFILE, "> $cfile" or die "Can't open $cfile: $!\n";
+	print CFILE $gpl;
+	print CFILE qq/#include "config.h"\n\n/;
+	print CFILE $headers, "\n";
+	print CFILE $extra->{decls}, "\n" if exists $extra->{decls};
+	print CFILE "\n", $extra->{code} if exists $extra->{code};
+	print CFILE $out->{code};
+	print CFILE "\nvoid\nregister_${group}_procs (GimpPDB *pdb)\n";
+	print CFILE "{\n  GimpProcedure *procedure;\n$out->{register}}\n";
+	close CFILE;
+	&write_file($cfile, $destdir);
+
+	my $decl = "register_${group}_procs";
+	push @group_decls, $decl;
+	$longest = length $decl if $longest < length $decl;
+
+	$group_procs .=  ' ' x 2 . "register_${group}_procs (pdb);\n";
+	$pcount += $out->{pcount};
+    }
+
+    if (! $ENV{PDBGEN_GROUPS}) {
+	my $internal = "$builddir/internal-procs.h$FILE_EXT";
+	open IFILE, "> $internal" or die "Can't open $internal: $!\n";
+	print IFILE $gpl;
+	my $guard = "__INTERNAL_PROCS_H__";
+	print IFILE <<HEADER;
+#ifndef $guard
+#define $guard
+
+HEADER
+
+        print IFILE "void   internal_procs_init" . ' ' x ($longest - length "internal_procs_init") . " (GimpPDB *pdb);\n\n";
+
+	print IFILE "/* Forward declarations for registering PDB procs */\n\n";
+	foreach (@group_decls) {
+	    print IFILE "void   $_" . ' ' x ($longest - length $_) . " (GimpPDB *pdb);\n";
+	}
+
+	print IFILE <<HEADER;
+
+#endif /* $guard */
+HEADER
+	close IFILE;
+	&write_file($internal, $destdir);
+
+	$internal = "$builddir/internal-procs.c$FILE_EXT";
+	open IFILE, "> $internal" or die "Can't open $internal: $!\n";
+	print IFILE $gpl;
+	print IFILE qq@#include "config.h"\n\n@;
+	print IFILE qq@#include <glib-object.h>\n\n@;
+	print IFILE qq@#include "pdb-types.h"\n\n@;
+	print IFILE qq@#include "gimppdb.h"\n\n@;
+	print IFILE qq@#include "internal-procs.h"\n\n@;
+	chop $group_procs;
+	print IFILE "\n/* $total procedures registered total */\n\n";
+	print IFILE <<BODY;
+void
+internal_procs_init (GimpPDB *pdb)
+{
+  g_return_if_fail (GIMP_IS_PDB (pdb));
+
+$group_procs
+}
+BODY
+	close IFILE;
+	&write_file($internal, $destdir);
+    }
+}
+
+1;