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                                     @{[ &quotewrap($blurb, 2, 37) ]},
637                                     @{[ &quotewrap($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