pdb/app.pl

   1 # GIMP - The GNU Image Manipulation Program
   2 # Copyright (C) 1998-2003 Manish Singh <yosh@gimp.org>
   3
   4 # This program is free software: you can redistribute it and/or modify
   5 # it under the terms of the GNU General Public License as published by
   6 # the Free Software Foundation; either version 3 of the License, or
   7 # (at your option) any later version.
   8
   9 # This program is distributed in the hope that it will be useful,
  10 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12 # GNU General Public License for more details.
  13
  14 # You should have received a copy of the GNU General Public License
  15 # along with this program.  If not, see <https://www.gnu.org/licenses/>.
  16
  17 package Gimp::CodeGen::app;
  18
  19 $destdir  = "$main::destdir/app/pdb";
  20 $builddir = "$main::builddir/app/pdb";
  21
  22 *arg_types = \%Gimp::CodeGen::pdb::arg_types;
  23 *arg_parse = \&Gimp::CodeGen::pdb::arg_parse;
  24
  25 *enums = \%Gimp::CodeGen::enums::enums;
  26
  27 *write_file = \&Gimp::CodeGen::util::write_file;
  28 *FILE_EXT   = \$Gimp::CodeGen::util::FILE_EXT;
  29
  30 use Text::Wrap qw(wrap);
  31
  32 sub quotewrap {
  33     my ($str, $indent, $subsequent_indent) = @_;
  34     my $leading = ' ' x $indent . '"';
  35     my $subsequent_leading = ' ' x $subsequent_indent . '"';
  36     $Text::Wrap::columns = 1000;
  37     $Text::Wrap::unexpand = 0;
  38     $str = wrap($leading, $subsequent_leading, $str);
  39     $str =~ s/^\s*//s;
  40     $str =~ s/(.)\n(.)/$1\\n"\n$2/g;
  41     $str =~ s/(.)$/$1"/s;
  42     $str;
  43 }
  44
  45 sub format_code_frag {
  46     my ($code, $indent) = @_;
  47
  48     chomp $code;
  49     $code =~ s/\t/' ' x 8/eg;
  50
  51     if (!$indent && $code =~ /^\s*{\s*\n.*\n\s*}\s*$/s) {
  52         $code =~ s/^\s*{\s*\n//s;
  53         $code =~ s/\n\s*}\s*$//s;
  54     }
  55     else {
  56         $code =~ s/^/' ' x ($indent ? 4 : 2)/meg;
  57     }
  58     $code .= "\n";
  59
  60     $code =~ s/^\s+$//mg;
  61
  62     $code;
  63 }
  64
  65 sub declare_args {
  66     my $proc = shift;
  67     my $out = shift;
  68     my $outargs = shift;
  69
  70     local $result = "";
  71
  72     foreach (@_) {
  73         my @args = @{$proc->{$_}} if (defined $proc->{$_});
  74
  75         foreach (@args) {
  76             my ($type, $name) = &arg_parse($_->{type});
  77             my $arg = $arg_types{$type};
  78
  79             if ($arg->{array} && !exists $_->{array}) {
  80                 warn "Array without number of elements param in $proc->{name}";
  81             }
  82
  83             unless (exists $_->{no_declare} || exists $_->{dead}) {
  84                 if ($outargs) {
  85                     $result .= "  $arg->{type}$_->{name} = $arg->{init_value}";
  86                 }
  87                 else {
  88                     $result .= "  $arg->{const_type}$_->{name}";
  89                 }
  90                 $result .= ";\n";
  91
  92                 if (exists $arg->{headers}) {
  93                     foreach (@{$arg->{headers}}) {
  94                         $out->{headers}->{$_}++;
  95                     }
  96                 }
  97             }
  98         }
  99     }
 100
 101     $result;
 102 }
 103
 104 sub marshal_inargs {
 105     my ($proc, $argc) = @_;
 106
 107     my $result = "";
 108     my %decls;
 109
 110     my @inargs = @{$proc->{inargs}} if (defined $proc->{inargs});
 111
 112     foreach (@inargs) {
 113         my($pdbtype, @typeinfo) = &arg_parse($_->{type});
 114         my $arg = $arg_types{$pdbtype};
 115         my $var = $_->{name};
 116         my $value;
 117
 118         $value = "gimp_value_array_index (args, $argc)";
 119         if (!exists $_->{dead}) {
 120             $result .= eval qq/"  $arg->{get_value_func};\n"/;
 121         }
 122
 123         $argc++;
 124
 125         if (!exists $_->{no_validate}) {
 126             $success = 1;
 127         }
 128     }
 129
 130     $result = "\n" . $result . "\n" if $result;
 131     $result;
 132 }
 133
 134 sub marshal_outargs {
 135     my $proc = shift;
 136     my $result;
 137     my $argc = 0;
 138     my @outargs = @{$proc->{outargs}} if (defined $proc->{outargs});
 139
 140     if ($success) {
 141         $result = <<CODE;
 142   return_vals = gimp_procedure_get_return_values (procedure, success,
 143                                                   error ? *error : NULL);
 144 CODE
 145     } else {
 146         $result = <<CODE;
 147   return_vals = gimp_procedure_get_return_values (procedure, TRUE, NULL);
 148 CODE
 149     }
 150
 151     if (scalar @outargs) {
 152         my $outargs = "";
 153
 154         foreach (@{$proc->{outargs}}) {
 155             my ($pdbtype) = &arg_parse($_->{type});
 156             my $arg = $arg_types{$pdbtype};
 157             my $var = $_->{name};
 158             my $var_len;
 159             my $value;
 160
 161             $argc++;
 162
 163             $value = "gimp_value_array_index (return_vals, $argc)";
 164
 165             if (exists $_->{array}) {
 166                 my $arrayarg = $_->{array};
 167
 168                 if (exists $arrayarg->{name}) {
 169                     $var_len = $arrayarg->{name};
 170                 }
 171                 else {
 172                     $var_len = 'num_' . $_->{name};
 173                 }
 174             }
 175
 176             $outargs .= eval qq/"  $arg->{set_value_func};\n"/;
 177         }
 178
 179         $outargs =~ s/^/' ' x 2/meg if $success;
 180         $outargs =~ s/^/' ' x 2/meg if $success && $argc > 1;
 181
 182         $result .= "\n" if $success || $argc > 1;
 183         $result .= ' ' x 2 . "if (success)\n" if $success;
 184         $result .= ' ' x 4 . "{\n" if $success && $argc > 1;
 185         $result .= $outargs;
 186         $result .= ' ' x 4 . "}\n" if $success && $argc > 1;
 187         $result .= "\n" . ' ' x 2 . "return return_vals;\n";
 188     }
 189     else {
 190         if ($success) {
 191             $result =~ s/return_vals =/return/;
 192             $result =~ s/       error/error/;
 193         }
 194         else {
 195             $result =~ s/  return_vals =/\n  return/;
 196             $result =~ s/       error/error/;
 197         }
 198     }
 199
 200     $result;
 201 }
 202
 203 sub generate_pspec {
 204     my $arg = shift;
 205     my ($pdbtype, @typeinfo) = &arg_parse($arg->{type});
 206     my $name = $arg->{canonical_name};
 207     my $nick = $arg->{canonical_name};
 208     my $blurb = exists $arg->{desc} ? $arg->{desc} : "";
 209     my $min;
 210     my $max;
 211     my $default;
 212     my $flags = 'GIMP_PARAM_READWRITE';
 213     my $pspec = "";
 214     my $postproc = "";
 215
 216     $nick =~ s/-/ /g;
 217
 218     if (exists $arg->{no_validate}) {
 219         $flags .= ' | GIMP_PARAM_NO_VALIDATE';
 220     }
 221
 222     if ($pdbtype eq 'image') {
 223         $none_ok = exists $arg->{none_ok} ? 'TRUE' : 'FALSE';
 224         $pspec = <<CODE;
 225 gimp_param_spec_image_id ("$name",
 226                           "$nick",
 227                           "$blurb",
 228                           pdb->gimp, $none_ok,
 229                           $flags)
 230 CODE
 231     }
 232     elsif ($pdbtype eq 'item') {
 233         $none_ok = exists $arg->{none_ok} ? 'TRUE' : 'FALSE';
 234         $pspec = <<CODE;
 235 gimp_param_spec_item_id ("$name",
 236                          "$nick",
 237                          "$blurb",
 238                          pdb->gimp, $none_ok,
 239                          $flags)
 240 CODE
 241     }
 242     elsif ($pdbtype eq 'drawable') {
 243         $none_ok = exists $arg->{none_ok} ? 'TRUE' : 'FALSE';
 244         $pspec = <<CODE;
 245 gimp_param_spec_drawable_id ("$name",
 246                              "$nick",
 247                              "$blurb",
 248                              pdb->gimp, $none_ok,
 249                              $flags)
 250 CODE
 251     }
 252     elsif ($pdbtype eq 'layer') {
 253         $none_ok = exists $arg->{none_ok} ? 'TRUE' : 'FALSE';
 254         $pspec = <<CODE;
 255 gimp_param_spec_layer_id ("$name",
 256                           "$nick",
 257                           "$blurb",
 258                           pdb->gimp, $none_ok,
 259                           $flags)
 260 CODE
 261     }
 262     elsif ($pdbtype eq 'channel') {
 263         $none_ok = exists $arg->{none_ok} ? 'TRUE' : 'FALSE';
 264         $pspec = <<CODE;
 265 gimp_param_spec_channel_id ("$name",
 266                             "$nick",
 267                             "$blurb",
 268                             pdb->gimp, $none_ok,
 269                             $flags)
 270 CODE
 271     }
 272     elsif ($pdbtype eq 'layer_mask') {
 273         $none_ok = exists $arg->{none_ok} ? 'TRUE' : 'FALSE';
 274         $pspec = <<CODE;
 275 gimp_param_spec_layer_mask_id ("$name",
 276                                "$nick",
 277                                "$blurb",
 278                                pdb->gimp, $none_ok,
 279                                $flags)
 280 CODE
 281     }
 282     elsif ($pdbtype eq 'selection') {
 283         $none_ok = exists $arg->{none_ok} ? 'TRUE' : 'FALSE';
 284         $pspec = <<CODE;
 285 gimp_param_spec_selection_id ("$name",
 286                               "$nick",
 287                               "$blurb",
 288                               pdb->gimp, $none_ok,
 289                               $flags)
 290 CODE
 291     }
 292     elsif ($pdbtype eq 'vectors') {
 293         $none_ok = exists $arg->{none_ok} ? 'TRUE' : 'FALSE';
 294         $pspec = <<CODE;
 295 gimp_param_spec_vectors_id ("$name",
 296                             "$nick",
 297                             "$blurb",
 298                             pdb->gimp, $none_ok,
 299                             $flags)
 300 CODE
 301     }
 302     elsif ($pdbtype eq 'display') {
 303         $none_ok = exists $arg->{none_ok} ? 'TRUE' : 'FALSE';
 304         $pspec = <<CODE;
 305 gimp_param_spec_display_id ("$name",
 306                             "$nick",
 307                             "$blurb",
 308                             pdb->gimp, $none_ok,
 309                             $flags)
 310 CODE
 311     }
 312     elsif ($pdbtype eq 'tattoo') {
 313         $pspec = <<CODE;
 314 g_param_spec_uint ("$name",
 315                    "$nick",
 316                    "$blurb",
 317                    1, G_MAXUINT32, 1,
 318                    $flags)
 319 CODE
 320     }
 321     elsif ($pdbtype eq 'guide') {
 322         $pspec = <<CODE;
 323 g_param_spec_uint ("$name",
 324                    "$nick",
 325                    "$blurb",
 326                    1, G_MAXUINT32, 1,
 327                    $flags)
 328 CODE
 329     }
 330     elsif ($pdbtype eq 'sample_point') {
 331         $pspec = <<CODE;
 332 g_param_spec_uint ("$name",
 333                    "$nick",
 334                    "$blurb",
 335                    1, G_MAXUINT32, 1,
 336                    $flags)
 337 CODE
 338     }
 339     elsif ($pdbtype eq 'float') {
 340         $min = defined $typeinfo[0] ? $typeinfo[0] : -G_MAXDOUBLE;
 341         $max = defined $typeinfo[2] ? $typeinfo[2] : G_MAXDOUBLE;
 342         $default = exists $arg->{default} ? $arg->{default} : defined $typeinfo[0] ? $typeinfo[0] : 0.0;
 343         $pspec = <<CODE;
 344 g_param_spec_double ("$name",
 345                      "$nick",
 346                      "$blurb",
 347                      $min, $max, $default,
 348                      $flags)
 349 CODE
 350     }
 351     elsif ($pdbtype eq 'int32') {
 352         if (defined $typeinfo[0]) {
 353             $min = ($typeinfo[1] eq '<') ? ($typeinfo[0] + 1) : $typeinfo[0];
 354         }
 355         else {
 356             $min = G_MININT32;
 357         }
 358         if (defined $typeinfo[2]) {
 359             $max = ($typeinfo[3] eq '<') ? ($typeinfo[2] - 1) : $typeinfo[2];
 360         }
 361         else {
 362             $max = G_MAXINT32;
 363         }
 364         $default = exists $arg->{default} ? $arg->{default} : defined $typeinfo[0] ? $typeinfo[0] : 0;
 365         $pspec = <<CODE;
 366 gimp_param_spec_int32 ("$name",
 367                        "$nick",
 368                        "$blurb",
 369                        $min, $max, $default,
 370                        $flags)
 371 CODE
 372     }
 373     elsif ($pdbtype eq 'int16') {
 374         if (defined $typeinfo[0]) {
 375             $min = ($typeinfo[1] eq '<') ? ($typeinfo[0] + 1) : $typeinfo[0];
 376         }
 377         else {
 378             $min = G_MININT16;
 379         }
 380         if (defined $typeinfo[2]) {
 381             $max = ($typeinfo[3] eq '<') ? ($typeinfo[2] - 1) : $typeinfo[2];
 382         }
 383         else {
 384             $max = G_MAXINT16;
 385         }
 386         $default = exists $arg->{default} ? $arg->{default} : defined $typeinfo[0] ? $typeinfo[0] : 0;
 387         $pspec = <<CODE;
 388 gimp_param_spec_int16 ("$name",
 389                        "$nick",
 390                        "$blurb",
 391                        $min, $max, $default,
 392                        $flags)
 393 CODE
 394     }
 395     elsif ($pdbtype eq 'int8') {
 396         if (defined $typeinfo[0]) {
 397             $min = ($typeinfo[1] eq '<') ? ($typeinfo[0] + 1) : $typeinfo[0];
 398         }
 399         else {
 400             $min = 0;
 401         }
 402         if (defined $typeinfo[2]) {
 403             $max = ($typeinfo[3] eq '<') ? ($typeinfo[2] - 1) : $typeinfo[2];
 404         }
 405         else {
 406             $max = G_MAXUINT8;
 407         }
 408         $default = exists $arg->{default} ? $arg->{default} : defined $typeinfo[0] ? $typeinfo[0] : 0;
 409         $pspec = <<CODE;
 410 gimp_param_spec_int8 ("$name",
 411                       "$nick",
 412                       "$blurb",
 413                       $min, $max, $default,
 414                       $flags)
 415 CODE
 416     }
 417     elsif ($pdbtype eq 'boolean') {
 418         $default = exists $arg->{default} ? $arg->{default} : FALSE;
 419         $pspec = <<CODE;
 420 g_param_spec_boolean ("$name",
 421                       "$nick",
 422                       "$blurb",
 423                       $default,
 424                       $flags)
 425 CODE
 426     }
 427     elsif ($pdbtype eq 'string') {
 428         $allow_non_utf8 = exists $arg->{allow_non_utf8} ? 'TRUE' : 'FALSE';
 429         $null_ok = exists $arg->{null_ok} ? 'TRUE' : 'FALSE';
 430         $non_empty = exists $arg->{non_empty} ? 'TRUE' : 'FALSE';
 431         $default = exists $arg->{default} ? $arg->{default} : NULL;
 432         $pspec = <<CODE;
 433 gimp_param_spec_string ("$name",
 434                         "$nick",
 435                         "$blurb",
 436                         $allow_non_utf8, $null_ok, $non_empty,
 437                         $default,
 438                         $flags)
 439 CODE
 440     }
 441     elsif ($pdbtype eq 'enum') {
 442         $enum_type = $typeinfo[0];
 443         $enum_type =~ s/([a-z])([A-Z])/$1_$2/g;
 444         $enum_type =~ s/([A-Z]+)([A-Z])/$1_$2/g;
 445         $enum_type =~ tr/[a-z]/[A-Z]/;
 446         $enum_type =~ s/^GIMP/GIMP_TYPE/;
 447         $enum_type =~ s/^GEGL/GEGL_TYPE/;
 448         $default = exists $arg->{default} ? $arg->{default} : $enums{$typeinfo[0]}->{symbols}[0];
 449
 450         my ($foo, $bar, @remove) = &arg_parse($arg->{type});
 451
 452         foreach (@remove) {
 453             $postproc .= 'gimp_param_spec_enum_exclude_value (GIMP_PARAM_SPEC_ENUM ($pspec),';
 454             $postproc .= "\n                                    $_);\n";
 455         }
 456
 457         if ($postproc eq '') {
 458             $pspec = <<CODE;
 459 g_param_spec_enum ("$name",
 460                    "$nick",
 461                    "$blurb",
 462                    $enum_type,
 463                    $default,
 464                    $flags)
 465 CODE
 466         }
 467         else {
 468             $pspec = <<CODE;
 469 gimp_param_spec_enum ("$name",
 470                       "$nick",
 471                       "$blurb",
 472                       $enum_type,
 473                       $default,
 474                       $flags)
 475 CODE
 476         }
 477     }
 478     elsif ($pdbtype eq 'unit') {
 479         $typeinfo[0] = 'GIMP_UNIT_PIXEL' unless defined $typeinfo[0];
 480         $allow_pixels = $typeinfo[0] eq 'GIMP_UNIT_PIXEL' ? TRUE : FALSE;
 481         $allow_percent = exists $arg->{allow_percent} ? TRUE : FALSE;
 482         $default = exists $arg->{default} ? $arg->{default} : $typeinfo[0];
 483         $pspec = <<CODE;
 484 gimp_param_spec_unit ("$name",
 485                       "$nick",
 486                       "$blurb",
 487                       $allow_pixels,
 488                       $allow_percent,
 489                       $default,
 490                       $flags)
 491 CODE
 492     }
 493     elsif ($pdbtype eq 'color') {
 494         $has_alpha = exists $arg->{has_alpha} ? TRUE : FALSE;
 495         $default = exists $arg->{default} ? $arg->{default} : NULL;
 496         $pspec = <<CODE;
 497 gimp_param_spec_rgb ("$name",
 498                      "$nick",
 499                      "$blurb",
 500                      $has_alpha,
 501                      $default,
 502                      $flags)
 503 CODE
 504     }
 505     elsif ($pdbtype eq 'parasite') {
 506         $pspec = <<CODE;
 507 gimp_param_spec_parasite ("$name",
 508                           "$nick",
 509                           "$blurb",
 510                           $flags)
 511 CODE
 512     }
 513     elsif ($pdbtype eq 'int32array') {
 514         $pspec = <<CODE;
 515 gimp_param_spec_int32_array ("$name",
 516                              "$nick",
 517                              "$blurb",
 518                              $flags)
 519 CODE
 520     }
 521     elsif ($pdbtype eq 'int16array') {
 522         $pspec = <<CODE;
 523 gimp_param_spec_int16_array ("$name",
 524                              "$nick",
 525                              "$blurb",
 526                              $flags)
 527 CODE
 528     }
 529     elsif ($pdbtype eq 'int8array') {
 530         $pspec = <<CODE;
 531 gimp_param_spec_int8_array ("$name",
 532                             "$nick",
 533                             "$blurb",
 534                             $flags)
 535 CODE
 536     }
 537     elsif ($pdbtype eq 'floatarray') {
 538         $pspec = <<CODE;
 539 gimp_param_spec_float_array ("$name",
 540                              "$nick",
 541                              "$blurb",
 542                              $flags)
 543 CODE
 544     }
 545     elsif ($pdbtype eq 'stringarray') {
 546         $pspec = <<CODE;
 547 gimp_param_spec_string_array ("$name",
 548                               "$nick",
 549                               "$blurb",
 550                               $flags)
 551 CODE
 552     }
 553     elsif ($pdbtype eq 'colorarray') {
 554         $pspec = <<CODE;
 555 gimp_param_spec_color_array ("$name",
 556                              "$nick",
 557                              "$blurb",
 558                              $flags)
 559 CODE
 560     }
 561     else {
 562         warn "Unsupported PDB type: $arg->{name} ($arg->{type})";
 563         exit -1;
 564     }
 565
 566     $pspec =~ s/\s$//;
 567
 568     return ($pspec, $postproc);
 569 }
 570
 571 sub canonicalize {
 572     $_ = shift; s/_/-/g; return $_;
 573 }
 574
 575 sub generate {
 576     my @procs = @{(shift)};
 577     my %out;
 578     my $total = 0.0;
 579     my $argc;
 580
 581     foreach $name (@procs) {
 582         my $proc = $main::pdb{$name};
 583         my $out = \%{$out{$proc->{group}}};
 584
 585         my @inargs = @{$proc->{inargs}} if (defined $proc->{inargs});
 586         my @outargs = @{$proc->{outargs}} if (defined $proc->{outargs});
 587
 588         my $blurb = $proc->{blurb};
 589         my $help = $proc->{help};
 590
 591         my $procedure_name;
 592
 593         local $success = 0;
 594
 595         if ($proc->{deprecated}) {
 596             if ($proc->{deprecated} eq 'NONE') {
 597                 if (!$blurb) {
 598                     $blurb = "Deprecated: There is no replacement for this procedure.";
 599                 }
 600                 if ($help) {
 601                     $help .= "\n\n";
 602                 }
 603                 $help .= "Deprecated: There is no replacement for this procedure.";
 604             }
 605             else {
 606                 if (!$blurb) {
 607                     $blurb = "Deprecated: Use '$proc->{deprecated}' instead.";
 608                 }
 609                 if ($help) {
 610                     $help .= "\n\n";
 611                 }
 612                 $help .= "Deprecated: Use '$proc->{deprecated}' instead.";
 613             }
 614         }
 615
 616         $help =~ s/gimp(\w+)\(\s*\)/"'gimp".canonicalize($1)."'"/ge;
 617
 618         if ($proc->{group} eq "plug_in_compat") {
 619             $procedure_name = "$proc->{canonical_name}";
 620         } else {
 621             $procedure_name = "gimp-$proc->{canonical_name}";
 622         }
 623
 624         $out->{pcount}++; $total++;
 625
 626         $out->{register} .= <<CODE;
 627
 628   /*
 629    * gimp-$proc->{canonical_name}
 630    */
 631   procedure = gimp_procedure_new (${name}_invoker);
 632   gimp_object_set_static_name (GIMP_OBJECT (procedure),
 633                                "$procedure_name");
 634   gimp_procedure_set_static_strings (procedure,
 635                                      "$procedure_name",
 636                                      @{[ &quotewrap($blurb, 2, 37) ]},
 637                                      @{[ &quotewrap($help,  2, 37) ]},
 638                                      "$proc->{author}",
 639                                      "$proc->{copyright}",
 640                                      "$proc->{date}",
 641                                      @{[$proc->{deprecated} ? "\"$proc->{deprecated}\"" : 'NULL']});
 642 CODE
 643
 644         $argc = 0;
 645
 646         foreach $arg (@inargs) {
 647             my ($pspec, $postproc) = &generate_pspec($arg);
 648
 649             $pspec =~ s/^/' ' x length("  gimp_procedure_add_argument (")/meg;
 650
 651             $out->{register} .= <<CODE;
 652   gimp_procedure_add_argument (procedure,
 653 ${pspec});
 654 CODE
 655
 656             if ($postproc ne '') {
 657                 $pspec = "procedure->args[$argc]";
 658                 $postproc =~ s/^/'  '/meg;
 659                 $out->{register} .= eval qq/"$postproc"/;
 660             }
 661
 662             $argc++;
 663         }
 664
 665         $argc = 0;
 666
 667         foreach $arg (@outargs) {
 668             my ($pspec, $postproc) = &generate_pspec($arg);
 669             my $argc = 0;
 670
 671             $pspec =~ s/^/' ' x length("  gimp_procedure_add_return_value (")/meg;
 672
 673             $out->{register} .= <<CODE;
 674   gimp_procedure_add_return_value (procedure,
 675 ${pspec});
 676 CODE
 677
 678             if ($postproc ne '') {
 679                 $pspec = "procedure->values[$argc]";
 680                 $postproc =~ s/^/'  '/meg;
 681                 $out->{register} .= eval qq/"$postproc"/;
 682             }
 683
 684             $argc++;
 685         }
 686
 687         $out->{register} .= <<CODE;
 688   gimp_pdb_register_procedure (pdb, procedure);
 689   g_object_unref (procedure);
 690 CODE
 691
 692         if (exists $proc->{invoke}->{headers}) {
 693             foreach $header (@{$proc->{invoke}->{headers}}) {
 694                 $out->{headers}->{$header}++;
 695             }
 696         }
 697
 698         $out->{code} .= "\nstatic GimpValueArray *\n";
 699         $out->{code} .= "${name}_invoker (GimpProcedure         *procedure,\n";
 700         $out->{code} .=  ' ' x length($name) . "          Gimp                  *gimp,\n";
 701         $out->{code} .=  ' ' x length($name) . "          GimpContext           *context,\n";
 702         $out->{code} .=  ' ' x length($name) . "          GimpProgress          *progress,\n";
 703         $out->{code} .=  ' ' x length($name) . "          const GimpValueArray  *args,\n";
 704         $out->{code} .=  ' ' x length($name) . "          GError               **error)\n{\n";
 705
 706         my $code = "";
 707
 708         if (exists $proc->{invoke}->{no_marshalling}) {
 709             $code .= &format_code_frag($proc->{invoke}->{code}, 0) . "}\n";
 710         }
 711         else {
 712             my $invoker = "";
 713
 714             $invoker .= ' ' x 2 . "GimpValueArray *return_vals;\n" if scalar @outargs;
 715             $invoker .= &declare_args($proc, $out, 0, qw(inargs));
 716             $invoker .= &declare_args($proc, $out, 1, qw(outargs));
 717
 718             $invoker .= &marshal_inargs($proc, 0);
 719             $invoker .= "\n" if $invoker && $invoker !~ /\n\n/s;
 720
 721             my $frag = "";
 722
 723             if (exists $proc->{invoke}->{code}) {
 724                 $frag = &format_code_frag($proc->{invoke}->{code}, $success);
 725                 $frag = ' ' x 2 . "if (success)\n" . $frag if $success;
 726                 $success = ($frag =~ /success =/) unless $success;
 727             }
 728
 729             chomp $invoker if !$frag;
 730             $code .= $invoker . $frag;
 731             $code .= "\n" if $frag =~ /\n\n/s || $invoker;
 732             $code .= &marshal_outargs($proc) . "}\n";
 733         }
 734
 735         if ($success) {
 736             $out->{code} .= ' ' x 2 . "gboolean success";
 737             unless ($proc->{invoke}->{success} eq 'NONE') {
 738                 $out->{code} .= " = $proc->{invoke}->{success}";
 739             }
 740             $out->{code} .= ";\n";
 741         }
 742
 743         $out->{code} .= $code;
 744     }
 745
 746     my $gpl = <<'GPL';
 747 /* GIMP - The GNU Image Manipulation Program
 748  * Copyright (C) 1995-2003 Spencer Kimball and Peter Mattis
 749  *
 750  * This program is free software: you can redistribute it and/or modify
 751  * it under the terms of the GNU General Public License as published by
 752  * the Free Software Foundation; either version 3 of the License, or
 753  * (at your option) any later version.
 754  *
 755  * This program is distributed in the hope that it will be useful,
 756  * but WITHOUT ANY WARRANTY; without even the implied warranty of
 757  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 758  * GNU General Public License for more details.
 759  *
 760  * You should have received a copy of the GNU General Public License
 761  * along with this program.  If not, see <https://www.gnu.org/licenses/>.
 762  */
 763
 764 /* NOTE: This file is auto-generated by pdbgen.pl. */
 765
 766 GPL
 767
 768     my $group_procs = "";
 769     my $longest = 0;
 770     my $once = 0;
 771     my $pcount = 0.0;
 772
 773     foreach $group (@main::groups) {
 774         my $out = $out{$group};
 775
 776         foreach (@{$main::grp{$group}->{headers}}) { $out->{headers}->{$_}++ }
 777
 778         $out->{headers}->{"\"core/gimpparamspecs.h\""}++;
 779
 780         my @headers = sort {
 781             my ($x, $y) = ($a, $b);
 782             foreach ($x, $y) {
 783                 if (/^</) {
 784                     s/^</!/;
 785                 }
 786                 elsif (!/libgimp/) {
 787                     s/^/~/;
 788                 }
 789             }
 790             $x cmp $y;
 791         } keys %{$out->{headers}};
 792
 793         my $headers = "";
 794         my $lib = 0;
 795         my $seen = 0;
 796         my $sys = 0;
 797         my $base = 0;
 798         my $error = 0;
 799         my $utils = 0;
 800         my $context = 0;
 801         my $intl = 0;
 802
 803         foreach (@headers) {
 804             $seen++ if /^</;
 805
 806             if ($sys == 0 && !/^</) {
 807                 $sys = 1;
 808                 $headers .= "\n" if $seen;
 809                 $headers .= "#include <gegl.h>\n\n";
 810                 $headers .= "#include <gdk-pixbuf/gdk-pixbuf.h>\n\n";
 811             }
 812
 813             $seen = 0 if !/^</;
 814
 815             if (/libgimp/) {
 816                 $lib = 1;
 817             }
 818             else {
 819                 $headers .= "\n" if $lib;
 820                 $lib = 0;
 821
 822                 if ($sys == 1 && $base == 0) {
 823                     $base = 1;
 824                     $headers .= "#include \"libgimpbase/gimpbase.h\"\n\n";
 825                     $headers .= "#include \"pdb-types.h\"\n\n";
 826                 }
 827             }
 828
 829             if (/gimp-intl/) {
 830                 $intl = 1;
 831             }
 832             elsif (/gimppdb-utils/) {
 833                 $utils = 1;
 834             }
 835             elsif (/gimppdberror/) {
 836                 $error = 1;
 837             }
 838             elsif (/gimppdbcontext/) {
 839                 $context = 1;
 840             }
 841             else {
 842                 $headers .= "#include $_\n";
 843             }
 844         }
 845
 846         $headers .= "\n";
 847         $headers .= "#include \"gimppdb.h\"\n";
 848         $headers .= "#include \"gimppdberror.h\"\n" if $error;
 849         $headers .= "#include \"gimppdb-utils.h\"\n" if $utils;
 850         $headers .= "#include \"gimppdbcontext.h\"\n" if $context;
 851         $headers .= "#include \"gimpprocedure.h\"\n";
 852         $headers .= "#include \"internal-procs.h\"\n";
 853
 854         $headers .= "\n#include \"gimp-intl.h\"\n" if $intl;
 855
 856         my $extra = {};
 857         if (exists $main::grp{$group}->{extra}->{app}) {
 858             $extra = $main::grp{$group}->{extra}->{app}
 859         }
 860
 861         my $cfile = "$builddir/".canonicalize(${group})."-cmds.c$FILE_EXT";
 862         open CFILE, "> $cfile" or die "Can't open $cfile: $!\n";
 863         print CFILE $gpl;
 864         print CFILE qq/#include "config.h"\n\n/;
 865         print CFILE $headers, "\n";
 866         print CFILE $extra->{decls}, "\n" if exists $extra->{decls};
 867         print CFILE "\n", $extra->{code} if exists $extra->{code};
 868         print CFILE $out->{code};
 869         print CFILE "\nvoid\nregister_${group}_procs (GimpPDB *pdb)\n";
 870         print CFILE "{\n  GimpProcedure *procedure;\n$out->{register}}\n";
 871         close CFILE;
 872         &write_file($cfile, $destdir);
 873
 874         my $decl = "register_${group}_procs";
 875         push @group_decls, $decl;
 876         $longest = length $decl if $longest < length $decl;
 877
 878         $group_procs .=  ' ' x 2 . "register_${group}_procs (pdb);\n";
 879         $pcount += $out->{pcount};
 880     }
 881
 882     if (! $ENV{PDBGEN_GROUPS}) {
 883         my $internal = "$builddir/internal-procs.h$FILE_EXT";
 884         open IFILE, "> $internal" or die "Can't open $internal: $!\n";
 885         print IFILE $gpl;
 886         my $guard = "__INTERNAL_PROCS_H__";
 887         print IFILE <<HEADER;
 888 #ifndef $guard
 889 #define $guard
 890
 891 HEADER
 892
 893         print IFILE "void   internal_procs_init" . ' ' x ($longest - length "internal_procs_init") . " (GimpPDB *pdb);\n\n";
 894
 895         print IFILE "/* Forward declarations for registering PDB procs */\n\n";
 896         foreach (@group_decls) {
 897             print IFILE "void   $_" . ' ' x ($longest - length $_) . " (GimpPDB *pdb);\n";
 898         }
 899
 900         print IFILE <<HEADER;
 901
 902 #endif /* $guard */
 903 HEADER
 904         close IFILE;
 905         &write_file($internal, $destdir);
 906
 907         $internal = "$builddir/internal-procs.c$FILE_EXT";
 908         open IFILE, "> $internal" or die "Can't open $internal: $!\n";
 909         print IFILE $gpl;
 910         print IFILE qq@#include "config.h"\n\n@;
 911         print IFILE qq@#include <glib-object.h>\n\n@;
 912         print IFILE qq@#include "pdb-types.h"\n\n@;
 913         print IFILE qq@#include "gimppdb.h"\n\n@;
 914         print IFILE qq@#include "internal-procs.h"\n\n@;
 915         chop $group_procs;
 916         print IFILE "\n/* $total procedures registered total */\n\n";
 917         print IFILE <<BODY;
 918 void
 919 internal_procs_init (GimpPDB *pdb)
 920 {
 921   g_return_if_fail (GIMP_IS_PDB (pdb));
 922
 923 $group_procs
 924 }
 925 BODY
 926         close IFILE;
 927         &write_file($internal, $destdir);
 928     }
 929 }
 930
 931 1;