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 17package 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 30use Text::Wrap qw(wrap); 31 32sub 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 45sub 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 65sub 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 104sub 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 134sub 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); 144CODE 145 } else { 146 $result = <<CODE; 147 return_vals = gimp_procedure_get_return_values (procedure, TRUE, NULL); 148CODE 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 203sub 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; 225gimp_param_spec_image_id ("$name", 226 "$nick", 227 "$blurb", 228 pdb->gimp, $none_ok, 229 $flags) 230CODE 231 } 232 elsif ($pdbtype eq 'item') { 233 $none_ok = exists $arg->{none_ok} ? 'TRUE' : 'FALSE'; 234 $pspec = <<CODE; 235gimp_param_spec_item_id ("$name", 236 "$nick", 237 "$blurb", 238 pdb->gimp, $none_ok, 239 $flags) 240CODE 241 } 242 elsif ($pdbtype eq 'drawable') { 243 $none_ok = exists $arg->{none_ok} ? 'TRUE' : 'FALSE'; 244 $pspec = <<CODE; 245gimp_param_spec_drawable_id ("$name", 246 "$nick", 247 "$blurb", 248 pdb->gimp, $none_ok, 249 $flags) 250CODE 251 } 252 elsif ($pdbtype eq 'layer') { 253 $none_ok = exists $arg->{none_ok} ? 'TRUE' : 'FALSE'; 254 $pspec = <<CODE; 255gimp_param_spec_layer_id ("$name", 256 "$nick", 257 "$blurb", 258 pdb->gimp, $none_ok, 259 $flags) 260CODE 261 } 262 elsif ($pdbtype eq 'channel') { 263 $none_ok = exists $arg->{none_ok} ? 'TRUE' : 'FALSE'; 264 $pspec = <<CODE; 265gimp_param_spec_channel_id ("$name", 266 "$nick", 267 "$blurb", 268 pdb->gimp, $none_ok, 269 $flags) 270CODE 271 } 272 elsif ($pdbtype eq 'layer_mask') { 273 $none_ok = exists $arg->{none_ok} ? 'TRUE' : 'FALSE'; 274 $pspec = <<CODE; 275gimp_param_spec_layer_mask_id ("$name", 276 "$nick", 277 "$blurb", 278 pdb->gimp, $none_ok, 279 $flags) 280CODE 281 } 282 elsif ($pdbtype eq 'selection') { 283 $none_ok = exists $arg->{none_ok} ? 'TRUE' : 'FALSE'; 284 $pspec = <<CODE; 285gimp_param_spec_selection_id ("$name", 286 "$nick", 287 "$blurb", 288 pdb->gimp, $none_ok, 289 $flags) 290CODE 291 } 292 elsif ($pdbtype eq 'vectors') { 293 $none_ok = exists $arg->{none_ok} ? 'TRUE' : 'FALSE'; 294 $pspec = <<CODE; 295gimp_param_spec_vectors_id ("$name", 296 "$nick", 297 "$blurb", 298 pdb->gimp, $none_ok, 299 $flags) 300CODE 301 } 302 elsif ($pdbtype eq 'display') { 303 $none_ok = exists $arg->{none_ok} ? 'TRUE' : 'FALSE'; 304 $pspec = <<CODE; 305gimp_param_spec_display_id ("$name", 306 "$nick", 307 "$blurb", 308 pdb->gimp, $none_ok, 309 $flags) 310CODE 311 } 312 elsif ($pdbtype eq 'tattoo') { 313 $pspec = <<CODE; 314g_param_spec_uint ("$name", 315 "$nick", 316 "$blurb", 317 1, G_MAXUINT32, 1, 318 $flags) 319CODE 320 } 321 elsif ($pdbtype eq 'guide') { 322 $pspec = <<CODE; 323g_param_spec_uint ("$name", 324 "$nick", 325 "$blurb", 326 1, G_MAXUINT32, 1, 327 $flags) 328CODE 329 } 330 elsif ($pdbtype eq 'sample_point') { 331 $pspec = <<CODE; 332g_param_spec_uint ("$name", 333 "$nick", 334 "$blurb", 335 1, G_MAXUINT32, 1, 336 $flags) 337CODE 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; 344g_param_spec_double ("$name", 345 "$nick", 346 "$blurb", 347 $min, $max, $default, 348 $flags) 349CODE 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; 366gimp_param_spec_int32 ("$name", 367 "$nick", 368 "$blurb", 369 $min, $max, $default, 370 $flags) 371CODE 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; 388gimp_param_spec_int16 ("$name", 389 "$nick", 390 "$blurb", 391 $min, $max, $default, 392 $flags) 393CODE 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; 410gimp_param_spec_int8 ("$name", 411 "$nick", 412 "$blurb", 413 $min, $max, $default, 414 $flags) 415CODE 416 } 417 elsif ($pdbtype eq 'boolean') { 418 $default = exists $arg->{default} ? $arg->{default} : FALSE; 419 $pspec = <<CODE; 420g_param_spec_boolean ("$name", 421 "$nick", 422 "$blurb", 423 $default, 424 $flags) 425CODE 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; 433gimp_param_spec_string ("$name", 434 "$nick", 435 "$blurb", 436 $allow_non_utf8, $null_ok, $non_empty, 437 $default, 438 $flags) 439CODE 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; 459g_param_spec_enum ("$name", 460 "$nick", 461 "$blurb", 462 $enum_type, 463 $default, 464 $flags) 465CODE 466 } 467 else { 468 $pspec = <<CODE; 469gimp_param_spec_enum ("$name", 470 "$nick", 471 "$blurb", 472 $enum_type, 473 $default, 474 $flags) 475CODE 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; 484gimp_param_spec_unit ("$name", 485 "$nick", 486 "$blurb", 487 $allow_pixels, 488 $allow_percent, 489 $default, 490 $flags) 491CODE 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; 497gimp_param_spec_rgb ("$name", 498 "$nick", 499 "$blurb", 500 $has_alpha, 501 $default, 502 $flags) 503CODE 504 } 505 elsif ($pdbtype eq 'parasite') { 506 $pspec = <<CODE; 507gimp_param_spec_parasite ("$name", 508 "$nick", 509 "$blurb", 510 $flags) 511CODE 512 } 513 elsif ($pdbtype eq 'int32array') { 514 $pspec = <<CODE; 515gimp_param_spec_int32_array ("$name", 516 "$nick", 517 "$blurb", 518 $flags) 519CODE 520 } 521 elsif ($pdbtype eq 'int16array') { 522 $pspec = <<CODE; 523gimp_param_spec_int16_array ("$name", 524 "$nick", 525 "$blurb", 526 $flags) 527CODE 528 } 529 elsif ($pdbtype eq 'int8array') { 530 $pspec = <<CODE; 531gimp_param_spec_int8_array ("$name", 532 "$nick", 533 "$blurb", 534 $flags) 535CODE 536 } 537 elsif ($pdbtype eq 'floatarray') { 538 $pspec = <<CODE; 539gimp_param_spec_float_array ("$name", 540 "$nick", 541 "$blurb", 542 $flags) 543CODE 544 } 545 elsif ($pdbtype eq 'stringarray') { 546 $pspec = <<CODE; 547gimp_param_spec_string_array ("$name", 548 "$nick", 549 "$blurb", 550 $flags) 551CODE 552 } 553 elsif ($pdbtype eq 'colorarray') { 554 $pspec = <<CODE; 555gimp_param_spec_color_array ("$name", 556 "$nick", 557 "$blurb", 558 $flags) 559CODE 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 571sub canonicalize { 572 $_ = shift; s/_/-/g; return $_; 573} 574 575sub 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 @{[ "ewrap($blurb, 2, 37) ]}, 637 @{[ "ewrap($help, 2, 37) ]}, 638 "$proc->{author}", 639 "$proc->{copyright}", 640 "$proc->{date}", 641 @{[$proc->{deprecated} ? "\"$proc->{deprecated}\"" : 'NULL']}); 642CODE 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}); 654CODE 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}); 676CODE 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); 690CODE 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 766GPL 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 891HEADER 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 */ 903HEADER 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; 918void 919internal_procs_init (GimpPDB *pdb) 920{ 921 g_return_if_fail (GIMP_IS_PDB (pdb)); 922 923$group_procs 924} 925BODY 926 close IFILE; 927 &write_file($internal, $destdir); 928 } 929} 930 9311; 932