lib.pl 18.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 19

package Gimp::CodeGen::lib;

# Generates all the libgimp C wrappers (used by plugins)
20 21
$destdir  = "$main::destdir/libgimp";
$builddir = "$main::builddir/libgimp";
22 23 24 25

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

26 27
*enums = \%Gimp::CodeGen::enums::enums;

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

31 32 33 34 35
use Text::Wrap qw(wrap);

sub desc_wrap {
    my ($str) = @_;
    my $leading = ' * ';
36 37
    my $wrapped;

38 39 40
    $str =~ s/&/&amp\;/g;
    $str =~ s/\</&lt\;/g;
    $str =~ s/\>/&gt\;/g;
41
    $Text::Wrap::columns = 72;
42 43 44
    $wrapped = wrap($leading, $leading, $str);
    $wrapped =~ s/[ \t]+\n/\n/g;
    return $wrapped;
45 46
}

47 48 49 50
sub generate {
    my @procs = @{(shift)};
    my %out;

Manish Singh's avatar
Manish Singh committed
51
    sub libtype {
Manish Singh's avatar
Manish Singh committed
52
	my $arg = shift;
53
	my $outarg = shift;
Manish Singh's avatar
Manish Singh committed
54 55
	my ($type, $name) = &arg_parse($arg->{type});
	my $argtype = $arg_types{$type};
56
	my $rettype = '';
Manish Singh's avatar
Manish Singh committed
57
	
58
	if (exists $argtype->{id}) {
59 60
	    return 'gint32 ';
	}
Manish Singh's avatar
Manish Singh committed
61 62 63 64 65

	if ($type eq 'enum') {
	    return "$name ";
	}

66 67 68 69 70 71 72 73 74 75
	if ($outarg) {
	    $rettype .= $argtype->{type};
	}
	else {
	    if (exists $argtype->{struct}) {
		$rettype .= 'const ';
	    }
	    $rettype .= $argtype->{const_type};
	}
	
Manish Singh's avatar
Manish Singh committed
76
	$rettype =~ s/int32/int/ unless exists $arg->{keep_size};
Sven Neumann's avatar
Sven Neumann committed
77
	$rettype .= '*' if exists $argtype->{struct};
Manish Singh's avatar
Manish Singh committed
78
	return $rettype;
Manish Singh's avatar
Manish Singh committed
79 80
    }

Manish Singh's avatar
Manish Singh committed
81
    foreach $name (@procs) {
82 83 84
	my $proc = $main::pdb{$name};
	my $out = \%{$out{$proc->{group}}};

85 86
	my @inargs = @{$proc->{inargs}} if (defined $proc->{inargs});
	my @outargs = @{$proc->{outargs}} if (defined $proc->{outargs});
87

88
	my $funcname = "gimp_$name"; my $wrapped = "";
89
	my %usednames;
90
	my $retdesc = "Returns: ";
Manish Singh's avatar
Manish Singh committed
91

92 93 94 95 96 97 98 99 100 101
	if ($proc->{deprecated}) {
	    if ($proc->{deprecated} eq 'NONE') {
		push @{$out->{protos}}, "GIMP_DEPRECATED\n";
	    }
	    else {
		my $underscores = $proc->{deprecated};
		$underscores =~ s/-/_/g;

		push @{$out->{protos}}, "GIMP_DEPRECATED_FOR($underscores)\n";
	    }
102 103
	}

104
	# Find the return argument (defaults to the first arg if not
105
	# explicitly set
106
	my $retarg  = undef; $retvoid = 0;
107
	foreach (@outargs) { $retarg = $_, last if exists $_->{retval} }
Manish Singh's avatar
Manish Singh committed
108 109
	unless ($retarg) {
	    if (scalar @outargs) {
110 111 112 113 114 115 116
		if (exists $outargs[0]->{void_ret}) {
		    $retvoid = 1;
		}
		else {
		    $retarg = exists $outargs[0]->{num} ? $outargs[1]
							: $outargs[0];
		}
Manish Singh's avatar
Manish Singh committed
117 118
	    }
	}
119

120
	my $rettype;
121
	if ($retarg) {
122
	    $rettype = &libtype($retarg, 1);
123
	    chop $rettype unless $rettype =~ /\*$/;
Manish Singh's avatar
Manish Singh committed
124 125

	    $retarg->{retval} = 1;
126

127
	    $retdesc .= exists $retarg->{desc} ? $retarg->{desc} : "";
128 129

	    if ($retarg->{type} eq 'stringarray') {
130
		$retdesc .= ". The returned value must be freed with g_strfreev().";
131
	    }
132 133 134 135 136 137 138
	}
	else {
	    # No return values
	    $rettype = 'void';
	}

	# The parameters to the function
139
	my $arglist = ""; my $argpass = "";
140
	my $argdesc = ""; my $sincedesc = "";
141 142
	foreach (@inargs) {
	    my ($type) = &arg_parse($_->{type});
143
	    my $desc = exists $_->{desc} ? $_->{desc} : "";
144
	    my $arg = $arg_types{$type};
Manish Singh's avatar
Manish Singh committed
145

146 147
	    $wrapped = "_" if exists $_->{wrap};

148 149
	    $usednames{$_->{name}}++;

150
	    $arglist .= &libtype($_, 0);
151
	    $arglist .= $_->{name};
152
	    $arglist .= '_ID' if $arg->{id};
153 154 155
	    $arglist .= ', ';

	    $argdesc .= " * \@$_->{name}";
156
	    $argdesc .= '_ID' if $arg->{id};
157
	    $argdesc .= ": $desc";
158 159

	    # This is what's passed into gimp_run_procedure
160
	    $argpass .= "\n" . ' ' x 36;
161
	    $argpass .= "GIMP_PDB_$arg->{name}, ";
162

163
	    $argpass .= "$_->{name}";
164
	    $argpass .= '_ID' if $arg->{id};
165

166
	    $argpass .= ',';
167 168 169

            unless ($argdesc =~ /[\.\!\?]$/) { $argdesc .= '.' }
            $argdesc .= "\n";
170 171 172 173
	}

	# This marshals the return value(s)
	my $return_args = "";
Manish Singh's avatar
Manish Singh committed
174
	my $return_marshal = "gimp_destroy_params (return_vals, nreturn_vals);";
175

176 177 178
	# return success/failure boolean if we don't have anything else
	if ($rettype eq 'void') {
	    $return_args .= "\n" . ' ' x 2 . "gboolean success = TRUE;";
179
	    $retdesc .= "TRUE on success.";
180 181
	}

182
	# We only need to bother with this if we have to return a value
183
	if ($rettype ne 'void' || $retvoid) {
Manish Singh's avatar
Manish Singh committed
184
	    my $once = 0;
185
	    my $firstvar;
186
	    my @initnums;
Manish Singh's avatar
Manish Singh committed
187

188 189 190 191
	    foreach (@outargs) {
		my ($type) = &arg_parse($_->{type});
		my $arg = $arg_types{$type};
		my $var;
Manish Singh's avatar
Manish Singh committed
192

193
		$return_marshal = "" unless $once++;
Manish Singh's avatar
Manish Singh committed
194

195 196
		$wrapped = "_" if exists $_->{wrap};

197 198 199
		$_->{libname} = exists $usednames{$_->{name}} ? "ret_$_->{name}"
							      : $_->{name};

Manish Singh's avatar
Manish Singh committed
200
	        if (exists $_->{num}) {
Manish Singh's avatar
Manish Singh committed
201
		    if (!exists $_->{no_lib}) {
202
			push @initnums, $_;
Manish Singh's avatar
Manish Singh committed
203 204
		    }
		}
205
		elsif (exists $_->{retval}) {
206
		    $return_args .= "\n" . ' ' x 2;
207
		    $return_args .= &libtype($_, 1);
208 209

		    # The return value variable
210
		    $var = $_->{libname};
211
		    $var .= '_ID' if $arg->{id};
212 213 214 215 216
		    $return_args .= $var;

		    # Save the first var to "return" it
		    $firstvar = $var unless defined $firstvar;

217
		    if ($arg->{id}) {
218 219 220
			# Initialize all IDs to -1
			$return_args .= " = -1";
		    }
221 222
		    elsif ($_->{libdef}) {
			$return_args .= " = $_->{libdef}";
223 224
		    }
		    else {
225
			$return_args .= " = $arg->{init_value}";
226
		    }
Manish Singh's avatar
Manish Singh committed
227

228
		    $return_args .= ";";
Manish Singh's avatar
Manish Singh committed
229 230 231 232

		    if (exists $_->{array} && exists $_->{array}->{no_lib}) {
			$return_args .= "\n" . ' ' x 2 . "gint num_$var;";
		    }
233
		}
234
		elsif ($retvoid) {
235
		    push @initnums, $_ unless exists $arg->{struct};
236
		}
Manish Singh's avatar
Manish Singh committed
237 238
	    }

239 240
	    if (scalar(@initnums)) {
		foreach (@initnums) {
241
		    $return_marshal .= "\*$_->{libname} = ";
242 243 244 245 246 247 248 249 250 251 252
		    my ($type) = &arg_parse($_->{type});
		    for ($arg_types{$type}->{type}) {
			/\*$/     && do { $return_marshal .= "NULL";  last };
			/boolean/ && do { $return_marshal .= "FALSE"; last };
			/double/  && do { $return_marshal .= "0.0";   last };
					  $return_marshal .= "0";
		    }
		    $return_marshal .= ";\n  ";
		}
		$return_marshal =~ s/\n  $/\n\n  /s;
	    }
Manish Singh's avatar
Manish Singh committed
253

254 255 256 257 258 259 260 261 262
	    if ($rettype eq 'void') {
		$return_marshal .= <<CODE;
success = return_vals[0].data.d_status == GIMP_PDB_SUCCESS;

  if (success)
CODE
	    }
	    else {
		$return_marshal .= <<CODE;
263
if (return_vals[0].data.d_status == GIMP_PDB_SUCCESS)
264
CODE
265
	    }
Manish Singh's avatar
Manish Singh committed
266 267 268 269 270 271

	    $return_marshal .= ' ' x 4 . "{\n" if $#outargs;

	    my $argc = 1; my ($numpos, $numtype);
	    foreach (@outargs) {
		my ($type) = &arg_parse($_->{type});
272
                my $desc = exists $_->{desc} ? $_->{desc} : "";
Manish Singh's avatar
Manish Singh committed
273 274
		my $arg = $arg_types{$type};
		my $var;
275
	    
276 277 278
		my $ch = "";
		my $cf = "";

Manish Singh's avatar
Manish Singh committed
279
		if ($type =~ /^string(array)?/) {
280 281
		    $ch = 'g_strdup (';
		    $cf = ')';
Manish Singh's avatar
Manish Singh committed
282
		}
283
		elsif ($type =~ /parasite/) {
284
		    $ch = 'gimp_parasite_copy (&';
285
		    $cf = ')';
286
		}
287
		elsif ($type =~ /boolean|enum|guide|sample_point/) {
288 289
		    $type = 'int32';
		}
Manish Singh's avatar
Manish Singh committed
290

Manish Singh's avatar
Manish Singh committed
291
		if (exists $_->{num}) {
Manish Singh's avatar
Manish Singh committed
292 293
		    $numpos = $argc;
		    $numtype = $type;
294 295
		    if (!exists $_->{no_lib}) {
			$arglist .= "gint \*$_->{libname}, ";
296
			$argdesc .= " * \@$_->{libname}: $desc";
297
		    }
Manish Singh's avatar
Manish Singh committed
298 299 300 301 302 303
		}
		elsif (exists $_->{array}) {
		    my $datatype = $arg->{type};
		    chop $datatype;
		    $datatype =~ s/ *$//;

304
		    my $var = $_->{libname}; my $dh = ""; my $df = "";
305 306
		    unless (exists $_->{retval}) {
			$var = "*$var"; $dh = "(*"; $df = ")";
307
			if ($type eq 'stringarray') {
308
			    $arglist .= "$datatype**$_->{libname}, ";
309 310
			}
			else {
311
			    $arglist .= "$datatype **$_->{libname}, ";
312
			}
313
			$argdesc .= " * \@$_->{libname}: $desc";
314 315
		    }

316 317 318
		    if ($ch || $cf) {
			$return_args .= "\n" . ' ' x 2 . "gint i;";
		    }
Manish Singh's avatar
Manish Singh committed
319 320 321 322

		    my $numvar = '*' . $_->{array}->{name};
		    $numvar = "num_$_->{name}" if exists $_->{array}->{no_lib};

323
		    $return_marshal .= <<NUMVAR;
Manish Singh's avatar
Manish Singh committed
324
      $numvar = return_vals[$numpos].data.d_$numtype;
325 326 327 328 329 330 331 332 333 334 335 336 337 338 339
NUMVAR

                    if ($type =~ /stringarray/) {
                        $return_marshal .= <<CP;
      if ($numvar > 0)
        {
          $var = g_new0 ($datatype, $numvar + 1);
          for (i = 0; i < $numvar; i++)
            $dh$_->{name}$df\[i] = ${ch}return_vals[$argc].data.d_$type\[i]${cf};
        }
CP
	            }
                    else {
                        $return_marshal .= <<NEW . (($ch || $cf) ? <<CP1 : <<CP2);
      $var = g_new ($datatype, $numvar);
340
NEW
Manish Singh's avatar
Manish Singh committed
341
      for (i = 0; i < $numvar; i++)
342
        $dh$_->{name}$df\[i] = ${ch}return_vals[$argc].data.d_$type\[i]${cf};
Manish Singh's avatar
Manish Singh committed
343
CP1
344 345 346
      memcpy ($var,
              return_vals[$argc].data.d_$type,
              $numvar * sizeof ($datatype));
347
CP2
348
                    }
Sven Neumann's avatar
Sven Neumann committed
349
		    $out->{headers} = "#include <string.h>\n" unless ($ch || $cf);
350
                }
351
		else {
Manish Singh's avatar
Manish Singh committed
352
		    # The return value variable
353 354 355 356
		    $var = "";

		    unless (exists $_->{retval}) {
			$var .= '*';
357
			$arglist .= &libtype($_, 1);
358 359
			$arglist .= '*' unless exists $arg->{struct};
			$arglist .= "$_->{libname}";
360
			$arglist .= '_ID' if $arg->{id};
361
			$arglist .= ', ';
362 363

			$argdesc .= " * \@$_->{libname}";
364
			$argdesc .= '_ID' if $arg->{id};
365
			$argdesc .= ": $desc";
366 367 368
		    }

		    $var = exists $_->{retval} ? "" : '*';
369
		    $var .= $_->{libname};
370
		    $var .= '_ID' if $arg->{id};
Manish Singh's avatar
Manish Singh committed
371

Manish Singh's avatar
Manish Singh committed
372
		    $return_marshal .= ' ' x 2 if $#outargs;
Manish Singh's avatar
Manish Singh committed
373
		    $return_marshal .= <<CODE
374
    $var = ${ch}return_vals[$argc].data.d_$type${cf};
Manish Singh's avatar
Manish Singh committed
375
CODE
376
		}
Manish Singh's avatar
Manish Singh committed
377

378 379 380 381
                if ($argdesc) {
                    unless ($argdesc =~ /[\.\!\?]$/) { $argdesc .= '.' }
                    unless ($argdesc =~ /\n$/)       { $argdesc .= "\n" }
		}
382 383
		$argc++;
	    }
Manish Singh's avatar
Manish Singh committed
384 385 386

	    $return_marshal .= ' ' x 4 . "}\n" if $#outargs;

387 388 389 390 391
	    $return_marshal .= <<'CODE';

  gimp_destroy_params (return_vals, nreturn_vals);

CODE
392
	    unless ($retvoid) {
393 394 395
		$return_marshal .= ' ' x 2 . "return $firstvar;";
	    }
	    else {
396
		$return_marshal .= ' ' x 2 . "return success;";
397
	    }
398
	}
399 400 401 402 403 404 405 406
	else {
	    $return_marshal = <<CODE;
success = return_vals[0].data.d_status == GIMP_PDB_SUCCESS;

  $return_marshal

  return success;
CODE
407

408 409
	    chop $return_marshal;
	}
410 411

	if ($arglist) {
412 413 414
	    my @arglist = split(/, /, $arglist);
	    my $longest = 0; my $seen = 0;
	    foreach (@arglist) {
415
		/(const \w+) \S+/ || /(\w+) \S+/;
416 417 418 419
		my $len = length($1);
		my $num = scalar @{[ /\*/g ]};
		$seen = $num if $seen < $num;
		$longest = $len if $longest < $len;
Manish Singh's avatar
Manish Singh committed
420 421
	    }

422
	    $longest += $seen;
Manish Singh's avatar
Manish Singh committed
423 424 425

	    my $once = 0; $arglist = "";
	    foreach (@arglist) {
426 427
		my $space = rindex($_, ' ');
		my $len = $longest - $space + 1;
428
		$len -= scalar @{[ /\*/g ]};
429
		substr($_, $space, 1) = ' ' x $len if $space != -1 && $len > 1;
430 431 432 433
		$arglist .= "\t" if $once;
                $arglist .= $_;
                $arglist .= ",\n";
		$once++;
Manish Singh's avatar
Manish Singh committed
434
	    }
435
	    $arglist =~ s/,\n$//;
436
	}
Manish Singh's avatar
Manish Singh committed
437 438 439
	else {
	    $arglist = "void";
	}
440 441
	
	$rettype = 'gboolean' if $rettype eq 'void';
442 443

	# Our function prototype for the headers
Manish Singh's avatar
Manish Singh committed
444 445
	(my $hrettype = $rettype) =~ s/ //g;

446
	my $proto = "$hrettype $wrapped$funcname ($arglist);\n";
447
	$proto =~ s/ +/ /g;
448

449
        push @{$out->{protos}}, $proto;
Manish Singh's avatar
Manish Singh committed
450 451

	my $clist = $arglist;
452
	my $padlen = length($wrapped) + length($funcname) + 2;
453
	my $padding = ' ' x $padlen;
454
	$clist =~ s/\t/$padding/eg;
455

456 457
        unless ($retdesc =~ /[\.\!\?]$/) { $retdesc .= '.' }

458
        if ($proc->{since}) {
459
	    $sincedesc = "\n *\n * Since: $proc->{since}";
460 461
	}

462 463
	my $procdesc = '';

464
	if ($proc->{deprecated}) {
465
            if ($proc->{deprecated} eq 'NONE') {
466 467 468 469 470 471 472 473
		if ($proc->{blurb}) {
		    $procdesc = &desc_wrap($proc->{blurb}) . "\n *\n";
		}
		if ($proc->{help}) {
		    $procdesc .= &desc_wrap($proc->{help}) . "\n *\n";
		}
		$procdesc .= &desc_wrap("Deprecated: There is no replacement " .
					"for this procedure.");
474 475
	    }
	    else {
476 477 478
		my $underscores = $proc->{deprecated};
		$underscores =~ s/-/_/g;

479 480 481 482 483 484 485 486
		if ($proc->{blurb}) {
		    $procdesc = &desc_wrap($proc->{blurb}) . "\n *\n";
		}
		if ($proc->{help}) {
		    $procdesc .= &desc_wrap($proc->{help}) . "\n *\n";
		}
		$procdesc .= &desc_wrap("Deprecated: " .
					"Use $underscores() instead.");
487
	    }
488 489 490 491 492
	}
	else {
	    $procdesc = &desc_wrap($proc->{blurb}) . "\n *\n" .
			&desc_wrap($proc->{help});
	}
493

494 495
	$retdesc = &desc_wrap($retdesc);

496
	$out->{code} .= <<CODE;
497

498 499 500
/**
 * $wrapped$funcname:
$argdesc *
501
$procdesc
502
 *
503
$retdesc$sincedesc
504
 **/
505
$rettype
506
$wrapped$funcname ($clist)
507
{
508
  GimpParam *return_vals;
509
  gint nreturn_vals;$return_args
510

511
  return_vals = gimp_run_procedure ("gimp-$proc->{canonical_name}",
512 513
                                    \&nreturn_vals,$argpass
                                    GIMP_PDB_END);
514 515 516 517 518 519

  $return_marshal
}
CODE
    }

520
    my $lgpl_top = <<'LGPL';
521
/* LIBGIMP - The GIMP Library
522
 * Copyright (C) 1995-2003 Peter Mattis and Spencer Kimball
523
 *
524 525 526 527
LGPL

    my $lgpl_bottom = <<'LGPL';
 *
528
 * This library is free software: you can redistribute it and/or
529
 * modify it under the terms of the GNU Lesser General Public
530
 * License as published by the Free Software Foundation; either
531
 * version 3 of the License, or (at your option) any later version.
532 533 534 535
 *
 * This library 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
536
 * Lesser General Public License for more details.
537
 *
538
 * You should have received a copy of the GNU Lesser General Public
539
 * License along with this library.  If not, see
540
 * <https://www.gnu.org/licenses/>.
541
 */
542

543
/* NOTE: This file is auto-generated by pdbgen.pl */
Manish Singh's avatar
Manish Singh committed
544

545 546
LGPL

547 548
    # We generate two files, a _pdb.h file with prototypes for all
    # the functions we make, and a _pdb.c file for the actual implementation
549
    while (my($group, $out) = each %out) {
550 551 552 553 554 555
        my $hname = "${group}pdb.h"; 
        my $cname = "${group}pdb.c";
        if ($group ne 'gimp') {
	    $hname = "gimp${hname}"; 
	    $cname = "gimp${cname}";
        }
556 557
        $hname =~ s/_//g; $hname =~ s/pdb\./_pdb./;
        $cname =~ s/_//g; $cname =~ s/pdb\./_pdb./;
558 559
	my $hfile = "$builddir/$hname$FILE_EXT";
	my $cfile = "$builddir/$cname$FILE_EXT";
560

Manish Singh's avatar
Manish Singh committed
561 562 563 564 565
	my $extra = {};
	if (exists $main::grp{$group}->{extra}->{lib}) {
	    $extra = $main::grp{$group}->{extra}->{lib}
	}

566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582
	if (exists $extra->{protos}) {
	    my $proto = "";
	    foreach (split(/\n/, $extra->{protos})) {
		next if /^\s*$/;

		if (/^\t/ && length($proto)) {
		    s/\s+/ /g; s/ $//; s/^ /\t/;
		    $proto .= $_ . "\n";
		}
		else {
		    push @{$out->{protos}}, $proto if length($proto);

		    s/\s+/ /g; s/^ //; s/ $//;
		    $proto = $_ . "\n";
		}
	    }
	}
583 584

	my @longest = (0, 0, 0); my @arglist = (); my $seen = 0;
585
	foreach (@{$out->{protos}}) {
586
	    my $arglist;
Manish Singh's avatar
Manish Singh committed
587

588
	    if (!/^GIMP_DEPRECATED/) {
589
		my $len;
Manish Singh's avatar
Manish Singh committed
590

591 592
		$arglist = [ split(' ', $_, 3) ];

593 594 595 596
		if ($arglist->[1] =~ /^_/) {
		    $arglist->[0] = "G_GNUC_INTERNAL ".$arglist->[0];
		}

597 598 599 600 601 602 603 604 605 606 607 608 609 610 611
		for (0..1) {
		    $len = length($arglist->[$_]);
		    $longest[$_] = $len if $longest[$_] < $len;
		}

		foreach (split(/,/, $arglist->[2])) {
		    next unless /(const \w+) \S+/ || /(\w+) \S+/;
		    $len = length($1) + 1;
		    my $num = scalar @{[ /\*/g ]};
		    $seen = $num if $seen < $num;
		    $longest[2] = $len if $longest[2] < $len;
		}
	    }
	    else {
		$arglist = $_;
Manish Singh's avatar
Manish Singh committed
612 613 614 615 616
	    }

	    push @arglist, $arglist;
	}

617
	$longest[2] += $seen;
618

619
	@{$out->{protos}} = ();
Manish Singh's avatar
Manish Singh committed
620
	foreach (@arglist) {
621
	    my $arg;
Manish Singh's avatar
Manish Singh committed
622

623 624 625 626 627 628 629
	    if (ref) {
		my ($type, $func, $arglist) = @$_;

		my @args = split(/,/, $arglist); $arglist = "";

		foreach (@args) {
		    $space = rindex($_, ' ');
630 631 632
                    if ($space > 0 && substr($_, $space - 1, 1) eq ')') {
                        $space = rindex($_, ' ', $space - 1)
                    }
633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652
		    my $len = $longest[2] - $space + 1;

		    $len -= scalar @{[ /\*/g ]};
		    $len++ if /\t/;

		    if ($space != -1 && $len > 1) {
			substr($_, $space, 1) = ' ' x $len;
		    }

		    $arglist .= $_;
		    $arglist .= "," if !/;\n$/;
		}

		$arg = $type;
		$arg .= ' ' x ($longest[0] - length($type) + 1) . $func;
		$arg .= ' ' x ($longest[1] - length($func) + 1) . $arglist;
		$arg =~ s/\t/' ' x ($longest[0] + $longest[1] + 3)/eg;
	    }
	    else {
		$arg = $_;
Manish Singh's avatar
Manish Singh committed
653
	    }
654

655
	    push @{$out->{protos}}, $arg;
Manish Singh's avatar
Manish Singh committed
656 657
	}

Manish Singh's avatar
Manish Singh committed
658 659
	my $body;
	$body = $extra->{decls} if exists $extra->{decls};
660
	foreach (@{$out->{protos}}) { $body .= $_ }
661 662 663
        if ($out->{deprecated}) {
	    $body .= "#endif /* GIMP_DISABLE_DEPRECATED */\n";
	}
Manish Singh's avatar
Manish Singh committed
664
	chomp $body;
665

666
	open HFILE, "> $hfile" or die "Can't open $hfile: $!\n";
667 668 669 670
        print HFILE $lgpl_top;
        print HFILE " * $hname\n";
        print HFILE $lgpl_bottom;
 	my $guard = "__GIMP_\U$group\E_PDB_H__";
671
	print HFILE <<HEADER;
672 673 674 675
#if !defined (__GIMP_H_INSIDE__) && !defined (GIMP_COMPILATION)
#error "Only <libgimp/gimp.h> can be included directly."
#endif

676 677 678
#ifndef $guard
#define $guard

679
G_BEGIN_DECLS
680

681 682
/* For information look into the C source or the html documentation */

683

Manish Singh's avatar
Manish Singh committed
684
$body
685 686


687
G_END_DECLS
688 689 690 691

#endif /* $guard */
HEADER
	close HFILE;
692
	&write_file($hfile, $destdir);
693 694

	open CFILE, "> $cfile" or die "Can't open $cfile: $!\n";
695 696 697
        print CFILE $lgpl_top;
        print CFILE " * $cname\n";
        print CFILE $lgpl_bottom;
Sven Neumann's avatar
Sven Neumann committed
698
        print CFILE qq/#include "config.h"\n\n/;
699
	print CFILE $out->{headers}, "\n" if exists $out->{headers};
700
	print CFILE qq/#include "gimp.h"\n/;
701 702 703 704 705 706 707 708 709 710 711 712 713
	$long_desc = &desc_wrap($main::grp{$group}->{doc_long_desc});
	print CFILE <<SECTION_DOCS;


/**
 * SECTION: $main::grp{$group}->{doc_title}
 * \@title: $main::grp{$group}->{doc_title}
 * \@short_description: $main::grp{$group}->{doc_short_desc}
 *
${long_desc}
 **/

SECTION_DOCS
Manish Singh's avatar
Manish Singh committed
714
	print CFILE "\n", $extra->{code} if exists $extra->{code};
715 716
	print CFILE $out->{code};
	close CFILE;
717
	&write_file($cfile, $destdir);
718
    }
719 720

    if (! $ENV{PDBGEN_GROUPS}) {
721
        my $gimp_pdb_headers = "$builddir/gimp_pdb_headers.h$FILE_EXT";
722
	open PFILE, "> $gimp_pdb_headers" or die "Can't open $gimp_pdb_headers: $!\n";
723
        print PFILE $lgpl_top;
724
        print PFILE " * gimp_pdb_headers.h\n";
725
        print PFILE $lgpl_bottom;
726
	my $guard = "__GIMP_PDB_HEADERS_H__";
727
	print PFILE <<HEADER;
728 729 730 731
#if !defined (__GIMP_H_INSIDE__) && !defined (GIMP_COMPILATION)
#error "Only <libgimp/gimp.h> can be included directly."
#endif

732 733 734 735 736 737
#ifndef $guard
#define $guard

HEADER
	my @groups;
	foreach $group (keys %out) {
738 739 740 741
	    my $hname = "${group}pdb.h";
	    if ($group ne 'gimp') {
		$hname = "gimp${hname}";
	    }
742 743 744 745 746 747 748 749 750 751 752
	    $hname =~ s/_//g; $hname =~ s/pdb\./_pdb./;
	    push @groups, $hname;
	}
	foreach $group (sort @groups) {
	    print PFILE "#include <libgimp/$group>\n";
	}
	print PFILE <<HEADER;

#endif /* $guard */
HEADER
	close PFILE;
753
	&write_file($gimp_pdb_headers, $destdir);
754
    }
755
}