app.pl 24.5 KB
Newer Older
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 8 9 10 11 12 13 14
# (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
15
# along with this program.  If not, see <https://www.gnu.org/licenses/>.
16 17 18

package Gimp::CodeGen::app;

19 20
$destdir  = "$main::destdir/app/pdb";
$builddir = "$main::builddir/app/pdb";
21 22 23 24

*arg_types = \%Gimp::CodeGen::pdb::arg_types;
*arg_parse = \&Gimp::CodeGen::pdb::arg_parse;

Manish Singh's avatar
Manish Singh committed
25 26
*enums = \%Gimp::CodeGen::enums::enums;

27
*write_file = \&Gimp::CodeGen::util::write_file;
Manish Singh's avatar
Manish Singh committed
28 29
*FILE_EXT   = \$Gimp::CodeGen::util::FILE_EXT;

30 31 32
use Text::Wrap qw(wrap);

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 38
    $Text::Wrap::unexpand = 0;
    $str = wrap($leading, $subsequent_leading, $str);
39
    $str =~ s/^\s*//s;
40 41
    $str =~ s/(.)\n(.)/$1\\n"\n$2/g;
    $str =~ s/(.)$/$1"/s;
42 43 44
    $str;
}

Manish Singh's avatar
Manish Singh committed
45 46 47 48 49 50 51 52 53 54 55 56 57 58 59
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";

60 61
    $code =~ s/^\s+$//mg;

Manish Singh's avatar
Manish Singh committed
62 63 64
    $code;
}

65 66 67
sub declare_args {
    my $proc = shift;
    my $out = shift;
68
    my $outargs = shift;
Manish Singh's avatar
Manish Singh committed
69

Manish Singh's avatar
Manish Singh committed
70
    local $result = "";
Manish Singh's avatar
Manish Singh committed
71

72
    foreach (@_) {
73
	my @args = @{$proc->{$_}} if (defined $proc->{$_});
Manish Singh's avatar
Manish Singh committed
74

75
	foreach (@args) {
Manish Singh's avatar
Manish Singh committed
76 77 78
	    my ($type, $name) = &arg_parse($_->{type});
	    my $arg = $arg_types{$type};

Manish Singh's avatar
Manish Singh committed
79
	    if ($arg->{array} && !exists $_->{array}) {
Manish Singh's avatar
Manish Singh committed
80 81 82
		warn "Array without number of elements param in $proc->{name}";
	    }

83
	    unless (exists $_->{no_declare} || exists $_->{dead}) {
84 85 86 87 88
		if ($outargs) {
		    $result .= "  $arg->{type}$_->{name} = $arg->{init_value}";
		}
		else {
		    $result .= "  $arg->{const_type}$_->{name}";
Manish Singh's avatar
Manish Singh committed
89
		}
Manish Singh's avatar
Manish Singh committed
90
		$result .= ";\n";
Manish Singh's avatar
Manish Singh committed
91

Manish Singh's avatar
Manish Singh committed
92 93
		if (exists $arg->{headers}) {
		    foreach (@{$arg->{headers}}) {
94 95 96 97 98 99
			$out->{headers}->{$_}++;
		    }
		}
	    }
	}
    }
Manish Singh's avatar
Manish Singh committed
100

101
    $result;
Manish Singh's avatar
Manish Singh committed
102 103
}

104
sub marshal_inargs {
Manish Singh's avatar
Manish Singh committed
105
    my ($proc, $argc) = @_;
Manish Singh's avatar
Manish Singh committed
106

107 108
    my $result = "";
    my %decls;
Manish Singh's avatar
Manish Singh committed
109

110
    my @inargs = @{$proc->{inargs}} if (defined $proc->{inargs});
Manish Singh's avatar
Manish Singh committed
111

112 113 114
    foreach (@inargs) {
	my($pdbtype, @typeinfo) = &arg_parse($_->{type});
	my $arg = $arg_types{$pdbtype};
115 116
	my $var = $_->{name};
	my $value;
Manish Singh's avatar
Manish Singh committed
117

118
	$value = "gimp_value_array_index (args, $argc)";
119 120 121
	if (!exists $_->{dead}) {
	    $result .= eval qq/"  $arg->{get_value_func};\n"/;
	}
122

123
	$argc++;
124

125
	if (!exists $_->{no_validate}) {
126
	    $success = 1;
127
	}
128
    }
Manish Singh's avatar
Manish Singh committed
129

130
    $result = "\n" . $result . "\n" if $result;
131 132 133 134 135
    $result;
}

sub marshal_outargs {
    my $proc = shift;
136
    my $result;
137
    my $argc = 0;
138
    my @outargs = @{$proc->{outargs}} if (defined $proc->{outargs});
Manish Singh's avatar
Manish Singh committed
139

140 141 142 143 144 145 146 147 148 149 150
    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
    }

151 152
    if (scalar @outargs) {
	my $outargs = "";
Manish Singh's avatar
Manish Singh committed
153

154 155 156
	foreach (@{$proc->{outargs}}) {
	    my ($pdbtype) = &arg_parse($_->{type});
	    my $arg = $arg_types{$pdbtype};
157
	    my $var = $_->{name};
158
	    my $var_len;
159
	    my $value;
Manish Singh's avatar
Manish Singh committed
160

161
	    $argc++;
Manish Singh's avatar
Manish Singh committed
162

163
	    $value = "gimp_value_array_index (return_vals, $argc)";
Manish Singh's avatar
Manish Singh committed
164

165 166 167 168 169 170 171 172 173 174 175
	    if (exists $_->{array}) {
		my $arrayarg = $_->{array};

		if (exists $arrayarg->{name}) {
		    $var_len = $arrayarg->{name};
		}
		else {
		    $var_len = 'num_' . $_->{name};
		}
	    }

176
	    $outargs .= eval qq/"  $arg->{set_value_func};\n"/;
177
	}
Manish Singh's avatar
Manish Singh committed
178

179 180
	$outargs =~ s/^/' ' x 2/meg if $success;
	$outargs =~ s/^/' ' x 2/meg if $success && $argc > 1;
Manish Singh's avatar
Manish Singh committed
181

182 183 184 185 186
	$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;
187
        $result .= "\n" . ' ' x 2 . "return return_vals;\n";
188 189
    }
    else {
190 191
	if ($success) {
	    $result =~ s/return_vals =/return/;
192
	    $result =~ s/       error/error/;
193 194 195
	}
	else {
	    $result =~ s/  return_vals =/\n  return/;
196
	    $result =~ s/       error/error/;
197
	}
198
    }
Manish Singh's avatar
Manish Singh committed
199

200 201 202
    $result;
}

203 204
sub generate_pspec {
    my $arg = shift;
205
    my ($pdbtype, @typeinfo) = &arg_parse($arg->{type});
206 207
    my $name = $arg->{canonical_name};
    my $nick = $arg->{canonical_name};
208
    my $blurb = exists $arg->{desc} ? $arg->{desc} : "";
209 210 211 212 213
    my $min;
    my $max;
    my $default;
    my $flags = 'GIMP_PARAM_READWRITE';
    my $pspec = "";
214
    my $postproc = "";
215 216 217

    $nick =~ s/-/ /g;

218
    if (exists $arg->{no_validate}) {
219 220 221 222
	$flags .= ' | GIMP_PARAM_NO_VALIDATE';
    }

    if ($pdbtype eq 'image') {
223
	$none_ok = exists $arg->{none_ok} ? 'TRUE' : 'FALSE';
224 225 226 227
	$pspec = <<CODE;
gimp_param_spec_image_id ("$name",
                          "$nick",
                          "$blurb",
228
                          pdb->gimp, $none_ok,
229
                          $flags)
230 231 232 233 234 235 236 237 238 239
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)
240 241 242
CODE
    }
    elsif ($pdbtype eq 'drawable') {
243
	$none_ok = exists $arg->{none_ok} ? 'TRUE' : 'FALSE';
244
	$pspec = <<CODE;
245 246 247
gimp_param_spec_drawable_id ("$name",
                             "$nick",
                             "$blurb",
248
                             pdb->gimp, $none_ok,
249
                             $flags)
250 251 252
CODE
    }
    elsif ($pdbtype eq 'layer') {
253
	$none_ok = exists $arg->{none_ok} ? 'TRUE' : 'FALSE';
254
	$pspec = <<CODE;
255 256 257
gimp_param_spec_layer_id ("$name",
                          "$nick",
                          "$blurb",
258
                          pdb->gimp, $none_ok,
259
                          $flags)
260 261 262
CODE
    }
    elsif ($pdbtype eq 'channel') {
263
	$none_ok = exists $arg->{none_ok} ? 'TRUE' : 'FALSE';
264
	$pspec = <<CODE;
265 266 267
gimp_param_spec_channel_id ("$name",
                            "$nick",
                            "$blurb",
268
                            pdb->gimp, $none_ok,
269
                            $flags)
270 271 272
CODE
    }
    elsif ($pdbtype eq 'layer_mask') {
273
	$none_ok = exists $arg->{none_ok} ? 'TRUE' : 'FALSE';
274
	$pspec = <<CODE;
275 276 277
gimp_param_spec_layer_mask_id ("$name",
                               "$nick",
                               "$blurb",
278
                               pdb->gimp, $none_ok,
279
                               $flags)
280 281 282
CODE
    }
    elsif ($pdbtype eq 'selection') {
283
	$none_ok = exists $arg->{none_ok} ? 'TRUE' : 'FALSE';
284
	$pspec = <<CODE;
285 286 287
gimp_param_spec_selection_id ("$name",
                              "$nick",
                              "$blurb",
288
                              pdb->gimp, $none_ok,
289
                              $flags)
290 291 292
CODE
    }
    elsif ($pdbtype eq 'vectors') {
293
	$none_ok = exists $arg->{none_ok} ? 'TRUE' : 'FALSE';
294
	$pspec = <<CODE;
295 296 297
gimp_param_spec_vectors_id ("$name",
                            "$nick",
                            "$blurb",
298
                            pdb->gimp, $none_ok,
299
                            $flags)
300 301 302
CODE
    }
    elsif ($pdbtype eq 'display') {
303
	$none_ok = exists $arg->{none_ok} ? 'TRUE' : 'FALSE';
304 305 306 307
	$pspec = <<CODE;
gimp_param_spec_display_id ("$name",
                            "$nick",
                            "$blurb",
308
                            pdb->gimp, $none_ok,
309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327
                            $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)
328 329 330 331 332 333 334 335 336
CODE
    }
    elsif ($pdbtype eq 'sample_point') {
	$pspec = <<CODE;
g_param_spec_uint ("$name",
                   "$nick",
                   "$blurb",
                   1, G_MAXUINT32, 1,
                   $flags)
337 338 339 340 341 342 343 344 345 346 347 348 349 350 351
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') {
352 353 354 355 356 357 358 359 360 361 362 363
	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;
	}
364 365
	$default = exists $arg->{default} ? $arg->{default} : defined $typeinfo[0] ? $typeinfo[0] : 0;
	$pspec = <<CODE;
366 367 368 369 370
gimp_param_spec_int32 ("$name",
                       "$nick",
                       "$blurb",
                       $min, $max, $default,
                       $flags)
371 372 373
CODE
    }
    elsif ($pdbtype eq 'int16') {
374 375 376 377 378 379 380 381 382 383 384 385
	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;
	}
386 387
	$default = exists $arg->{default} ? $arg->{default} : defined $typeinfo[0] ? $typeinfo[0] : 0;
	$pspec = <<CODE;
388 389 390 391 392
gimp_param_spec_int16 ("$name",
                       "$nick",
                       "$blurb",
                       $min, $max, $default,
                       $flags)
393 394 395
CODE
    }
    elsif ($pdbtype eq 'int8') {
396 397 398 399 400 401 402 403 404 405 406 407
	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;
	}
408 409
	$default = exists $arg->{default} ? $arg->{default} : defined $typeinfo[0] ? $typeinfo[0] : 0;
	$pspec = <<CODE;
410 411 412 413 414
gimp_param_spec_int8 ("$name",
                      "$nick",
                      "$blurb",
                      $min, $max, $default,
                      $flags)
415 416 417 418 419 420 421 422 423 424 425 426 427
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') {
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 432 433 434 435
	$default = exists $arg->{default} ? $arg->{default} : NULL;
	$pspec = <<CODE;
gimp_param_spec_string ("$name",
                        "$nick",
                        "$blurb",
436
                        $allow_non_utf8, $null_ok, $non_empty,
437 438 439 440 441 442 443 444 445 446
                        $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/;
447
	$enum_type =~ s/^GEGL/GEGL_TYPE/;
448
	$default = exists $arg->{default} ? $arg->{default} : $enums{$typeinfo[0]}->{symbols}[0];
449 450 451 452 453 454 455 456 457 458

	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;
459 460 461 462 463 464 465
g_param_spec_enum ("$name",
                   "$nick",
                   "$blurb",
                   $enum_type,
                   $default,
                   $flags)
CODE
466 467 468 469 470 471 472 473 474 475 476
	}
	else {
	    $pspec = <<CODE;
gimp_param_spec_enum ("$name",
                      "$nick",
                      "$blurb",
                      $enum_type,
                      $default,
                      $flags)
CODE
        }
477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493
    }
    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') {
494
	$has_alpha = exists $arg->{has_alpha} ? TRUE : FALSE;
495 496 497 498 499
	$default = exists $arg->{default} ? $arg->{default} : NULL;
	$pspec = <<CODE;
gimp_param_spec_rgb ("$name",
                     "$nick",
                     "$blurb",
500
                     $has_alpha,
501 502 503 504 505 506 507 508 509 510 511 512
                     $default,
                     $flags)
CODE
    }
    elsif ($pdbtype eq 'parasite') {
	$pspec = <<CODE;
gimp_param_spec_parasite ("$name",
                          "$nick",
                          "$blurb",
                          $flags)
CODE
    }
513
    elsif ($pdbtype eq 'int32array') {
514
	$pspec = <<CODE;
515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542
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)
543 544 545 546 547 548 549 550
CODE
    }
    elsif ($pdbtype eq 'stringarray') {
	$pspec = <<CODE;
gimp_param_spec_string_array ("$name",
                              "$nick",
                              "$blurb",
                              $flags)
551 552 553 554 555 556 557 558
CODE
    }
    elsif ($pdbtype eq 'colorarray') {
	$pspec = <<CODE;
gimp_param_spec_color_array ("$name",
                             "$nick",
                             "$blurb",
                             $flags)
559 560 561 562 563 564 565 566 567
CODE
    }
    else {
	warn "Unsupported PDB type: $arg->{name} ($arg->{type})";
	exit -1;
    }

    $pspec =~ s/\s$//;

568
    return ($pspec, $postproc);
569 570
}

571 572 573 574
sub canonicalize {
    $_ = shift; s/_/-/g; return $_;
}

575 576 577 578
sub generate {
    my @procs = @{(shift)};
    my %out;
    my $total = 0.0;
579
    my $argc;
580

Manish Singh's avatar
Manish Singh committed
581
    foreach $name (@procs) {
582 583 584
	my $proc = $main::pdb{$name};
	my $out = \%{$out{$proc->{group}}};

585 586
	my @inargs = @{$proc->{inargs}} if (defined $proc->{inargs});
	my @outargs = @{$proc->{outargs}} if (defined $proc->{outargs});
587

588
	my $blurb = $proc->{blurb};
589 590
	my $help = $proc->{help};

591 592
	my $procedure_name;

593 594
	local $success = 0;

595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615
	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.";
	    }
	}

616 617
	$help =~ s/gimp(\w+)\(\s*\)/"'gimp".canonicalize($1)."'"/ge;

618 619 620 621 622 623
	if ($proc->{group} eq "plug_in_compat") {
	    $procedure_name = "$proc->{canonical_name}";
	} else {
	    $procedure_name = "gimp-$proc->{canonical_name}";
	}

624 625
	$out->{pcount}++; $total++;

Michael Natterer's avatar
Michael Natterer committed
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 639 640 641
                                     "$proc->{author}",
                                     "$proc->{copyright}",
                                     "$proc->{date}",
                                     @{[$proc->{deprecated} ? "\"$proc->{deprecated}\"" : 'NULL']});
642 643
CODE

644 645 646 647
        $argc = 0;

        foreach $arg (@inargs) {
	    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 654
${pspec});
CODE
655

656
            if ($postproc ne '') {
657
		$pspec = "procedure->args[$argc]";
658 659 660 661 662
		$postproc =~ s/^/'  '/meg;
		$out->{register} .= eval qq/"$postproc"/;
	    }

	    $argc++;
663 664
	}

665 666
	$argc = 0;

667
	foreach $arg (@outargs) {
668 669
	    my ($pspec, $postproc) = &generate_pspec($arg);
	    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 676
${pspec});
CODE
677

678
            if ($postproc ne '') {
679
		$pspec = "procedure->values[$argc]";
680 681 682 683 684
		$postproc =~ s/^/'  '/meg;
		$out->{register} .= eval qq/"$postproc"/;
	    }

	    $argc++;
685 686
	}

687
	$out->{register} .= <<CODE;
688
  gimp_pdb_register_procedure (pdb, procedure);
689
  g_object_unref (procedure);
690 691 692
CODE

	if (exists $proc->{invoke}->{headers}) {
Manish Singh's avatar
Manish Singh committed
693
	    foreach $header (@{$proc->{invoke}->{headers}}) {
694 695 696 697
		$out->{headers}->{$header}++;
	    }
	}

698
	$out->{code} .= "\nstatic GimpValueArray *\n";
699
	$out->{code} .= "${name}_invoker (GimpProcedure         *procedure,\n";
700 701 702 703 704
	$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";
705

Manish Singh's avatar
Manish Singh committed
706 707
	my $code = "";

708 709
	if (exists $proc->{invoke}->{no_marshalling}) {
	    $code .= &format_code_frag($proc->{invoke}->{code}, 0) . "}\n";
710
	}
711
	else {
Manish Singh's avatar
Manish Singh committed
712 713
	    my $invoker = "";
	
714
	    $invoker .= ' ' x 2 . "GimpValueArray *return_vals;\n" if scalar @outargs;
715 716
	    $invoker .= &declare_args($proc, $out, 0, qw(inargs));
	    $invoker .= &declare_args($proc, $out, 1, qw(outargs));
Manish Singh's avatar
Manish Singh committed
717 718 719

	    $invoker .= &marshal_inargs($proc, 0);
	    $invoker .= "\n" if $invoker && $invoker !~ /\n\n/s;
720

Manish Singh's avatar
Manish Singh committed
721
	    my $frag = "";
Manish Singh's avatar
Manish Singh committed
722

Manish Singh's avatar
Manish Singh committed
723 724 725 726 727
	    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;
	    }
Manish Singh's avatar
Manish Singh committed
728

Manish Singh's avatar
Manish Singh committed
729
	    chomp $invoker if !$frag;
Manish Singh's avatar
Manish Singh committed
730 731 732 733
	    $code .= $invoker . $frag;
	    $code .= "\n" if $frag =~ /\n\n/s || $invoker;
	    $code .= &marshal_outargs($proc) . "}\n";
	}
734

Manish Singh's avatar
Manish Singh committed
735
	if ($success) {
Manish Singh's avatar
Manish Singh committed
736 737 738 739 740
	    $out->{code} .= ' ' x 2 . "gboolean success";
	    unless ($proc->{invoke}->{success} eq 'NONE') {
		$out->{code} .= " = $proc->{invoke}->{success}";
	    }
	    $out->{code} .= ";\n";
Manish Singh's avatar
Manish Singh committed
741 742
	}

Manish Singh's avatar
Manish Singh committed
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 754 755 756 757 758 759 760
 * (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
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. */
Manish Singh's avatar
Manish Singh committed
765

766 767
GPL

768 769 770 771 772
    my $group_procs = "";
    my $longest = 0;
    my $once = 0;
    my $pcount = 0.0;

773 774 775
    foreach $group (@main::groups) {
	my $out = $out{$group};

Manish Singh's avatar
Manish Singh committed
776
	foreach (@{$main::grp{$group}->{headers}}) { $out->{headers}->{$_}++ }
777

778 779
	$out->{headers}->{"\"core/gimpparamspecs.h\""}++;

780 781 782
	my @headers = sort {
	    my ($x, $y) = ($a, $b);
	    foreach ($x, $y) {
783 784 785 786 787 788
		if (/^</) {
		    s/^</!/;
		}
		elsif (!/libgimp/) {
		    s/^/~/;
		}
789 790 791
	    }
	    $x cmp $y;
	} keys %{$out->{headers}};
792 793 794 795 796 797

	my $headers = "";
	my $lib = 0;
	my $seen = 0;
	my $sys = 0;
	my $base = 0;
798
	my $error = 0;
799
	my $utils = 0;
800
	my $context = 0;
801
	my $intl = 0;
802

803 804
	foreach (@headers) {
	    $seen++ if /^</;
805

806 807
	    if ($sys == 0 && !/^</) {
		$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 816 817 818 819 820
	    if (/libgimp/) {
		$lib = 1;
	    }
	    else {
		$headers .= "\n" if $lib;
		$lib = 0;
821

822 823
		if ($sys == 1 && $base == 0) {
		    $base = 1;
824
		    $headers .= "#include \"libgimpbase/gimpbase.h\"\n\n";
825
		    $headers .= "#include \"pdb-types.h\"\n\n";
826 827
		}
	    }
828

829 830 831 832 833 834
	    if (/gimp-intl/) {
		$intl = 1;
	    }
	    elsif (/gimppdb-utils/) {
		$utils = 1;
	    }
835 836 837
	    elsif (/gimppdberror/) {
		$error = 1;
	    }
838 839 840
	    elsif (/gimppdbcontext/) {
		$context = 1;
	    }
841 842 843
	    else {
		$headers .= "#include $_\n";
	    }
Manish Singh's avatar
Manish Singh committed
844
	}
Manish Singh's avatar
Manish Singh committed
845

846 847
	$headers .= "\n";
	$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

Manish Singh's avatar
Manish Singh committed
856 857 858 859 860
	my $extra = {};
	if (exists $main::grp{$group}->{extra}->{app}) {
	    $extra = $main::grp{$group}->{extra}->{app}
	}

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/;
Manish Singh's avatar
Manish Singh committed
865 866 867
	print CFILE $headers, "\n";
	print CFILE $extra->{decls}, "\n" if exists $extra->{decls};
	print CFILE "\n", $extra->{code} if exists $extra->{code};
868
	print CFILE $out->{code};
869 870
	print CFILE "\nvoid\nregister_${group}_procs (GimpPDB *pdb)\n";
	print CFILE "{\n  GimpProcedure *procedure;\n$out->{register}}\n";
871
	close CFILE;
872
	&write_file($cfile, $destdir);
873 874 875 876 877

	my $decl = "register_${group}_procs";
	push @group_decls, $decl;
	$longest = length $decl if $longest < length $decl;

878
	$group_procs .=  ' ' x 2 . "register_${group}_procs (pdb);\n";
879 880 881
	$pcount += $out->{pcount};
    }

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";
Manish Singh's avatar
Manish Singh committed
885 886 887 888 889 890
	print IFILE $gpl;
	my $guard = "__INTERNAL_PROCS_H__";
	print IFILE <<HEADER;
#ifndef $guard
#define $guard

891 892 893 894 895 896 897 898 899 900
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;
Manish Singh's avatar
Manish Singh committed
901 902 903 904

#endif /* $guard */
HEADER
	close IFILE;
905
	&write_file($internal, $destdir);
Manish Singh's avatar
Manish Singh committed
906

907
	$internal = "$builddir/internal-procs.c$FILE_EXT";
908
	open IFILE, "> $internal" or die "Can't open $internal: $!\n";
Manish Singh's avatar
Manish Singh committed
909 910
	print IFILE $gpl;
	print IFILE qq@#include "config.h"\n\n@;
911 912
	print IFILE qq@#include <glib-object.h>\n\n@;
	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@;
Manish Singh's avatar
Manish Singh committed
915
	chop $group_procs;
Manish Singh's avatar
Manish Singh committed
916
	print IFILE "\n/* $total procedures registered total */\n\n";
917 918
	print IFILE <<BODY;
void
919
internal_procs_init (GimpPDB *pdb)
920
{
921
  g_return_if_fail (GIMP_IS_PDB (pdb));
922

923 924 925
$group_procs
}
BODY
Manish Singh's avatar
Manish Singh committed
926
	close IFILE;
927
	&write_file($internal, $destdir);
928 929 930 931
    }
}

1;