#!/usr/bin/perl -s
#
#	Copyright (c) 2000  Elmar Ludwig - Universitaet Osnabrueck
#	Create GTK Objective-C Class Library from GTK Include Files.

#	This library is free software; you can redistribute it and/or
#	modify it under the terms of the GNU Library General Public
#	License as published by the Free Software Foundation; either
#	version 2 of the License, or (at your option) any later version.
#
#	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
#	Library General Public License for more details.
#
#	You should have received a copy of the GNU Library General Public
#	License along with this library; if not, write to the
#	Free Software Foundation, Inc., 59 Temple Place - Suite 330,
#	Boston, MA 02111-1307, USA.

#	This is a rather stupid script to generate Objective-C wrapper
#	classes from the standard GTK include files. It should also work
#	with include files of related packages - if they are formatted
#	in the same way and follow the standard GTK naming conventions.
#	Note that this version can only process one header file at a time.
#
#	You have to provide a file `classes.in' with the names of *all*
#	gtk classes (i.e. GtkObject and its subclasses) that may appear in
#	the files to process. For your own projects, it is probably best
#	to copy the classes.in file provided with this library and add the
#	new classes. Each class name can optionally be followed by the
#	installation directory of its include file (installation location
#	relative to the standard include path). The default for this is
#	"gtk", so it can be omitted for all the standard gtk classes.
#
#	Usage: gtkgen [options] header_file.h
#
#	Options:    -skip	skip the first class definition found
#		    -stdout	print implementation files to stdout

%MAP = %DIR = ();
%SPECIAL = ( 'GTKAccelGroup', '',	# `special' subclasses of GTK
	     'GTKMenuFactory', '',
	     'GTKStyle', '' );

sub gtk
{
    my $tmp = $_[0];
    $tmp = $MAP{$tmp} if defined $MAP{$tmp};
    return $tmp;
}

sub up
{
    my $tmp = $_[0];
    $tmp =~ s/_([a-z])/\u$1/g;
    return $tmp;
}

sub down
{
    my $tmp = $_[0];
    $tmp =~ s/[A-Z]/_\l$&/g;
    return $tmp;
}

open (IN, 'classes.in') || die "cannot open classes.in: $!";
while (<IN>)
{
    next if $_ =~ /^\s*#/ || $_ =~ /^\s*$/;
    ($_, $dir) = split;
    $tmp = $_;
    $tmp =~ s/^Gtk/GTK/;
    $MAP{$_} = $tmp;
    $DIR{$tmp} = $dir;
}
close IN;

open (FILE, $ARGV[0]) || die "cannot open $ARGV[0]: $!";
$ARGV[0] =~ s%.*/%%;

if (defined $skip)
{
    # skip special cases...
}
elsif ($ARGV[0] eq 'gtkmain.h')
{
    $tmp = "${&}gtkmain.h ${&}gtkrc.h";
    open (FILE, "cat $tmp|") || die "cannot open $ARGV[0]: $!";
    $gclass = 'GtkMain';
    $gname = 'Main';
    $class = 'GTKMain';
    $cname = '';
    $super = 'NSObject';
}
elsif ($ARGV[0] eq 'gtkaccelgroup.h')
{
    $gclass = 'GtkAccelGroup';
    $gname = 'AccelGroup';
    $class = &gtk($gclass);
    $cname = &down($gname);
    $super = 'GTK';
}
elsif ($ARGV[0] eq 'gtkmenufactory.h')
{
    $gclass = 'GtkMenuFactory';
    $gname = 'MenuFactory';
    $class = &gtk($gclass);
    $cname = &down($gname);
    $super = 'GTK';
}

$tmp = '';
@method = ();

while (<FILE>)
{
    if (/^\s*\/\*/)
    {
	if (/\b(deprecated|internal|obsolete|private)\b/i)
	{
	    $_ = <FILE> until /\*\//;
	    $_ = <FILE> until /^\s*$/ || eof;
	}
	else
	{
	    $_ = <FILE> until /\*\//;
	    $_ = $';
	}
    }

    if (!defined $gname && /^\s*struct\s+_(Gtk([A-Z]\w+))Class/)
    {
	if (defined $skip)
	{
	    undef $skip;
	    next;
	}

	$gclass = $1;
	$gname = $2;
	$class = &gtk($gclass);
	$cname = &down($gname);
	$cname =~ s/(?<=_)([hvcs])_/$1/g;	# avoid loop here

	while (<FILE>)
	{
	    if (!defined $super && /;\s*$/)
	    {
		$super = /(Gtk[A-Z]\w+)Class/ ? &gtk($1) : 'GTK';
	    }
	    last if /^\s*\}/;	# good choice ?
	}
    }

    next if /\w;\s*$/;

    if (defined $gname && /^([\s\w*]*)gtk${cname}_(\w+)/o)
    {
	$type = $1;
	$name = &up($2);

	next if $name =~ /^dialog[A-Z]/ && $class =~ /Selection$/;

	next if defined $METHOD{$name};
	$METHOD{$name} = '1';
	undef $loop;
	undef $loop1;

	$_ .= <FILE> if index($_, '(') == -1;
	s/\(\s*\)/(void)/g;
	s/^.*\(\s*//s;

	if ($type =~ /^\s*$/)				# type on previous line
	{
	    $type = $tmp =~ /^[\s\w*]*$/ && $tmp =~ /\w/ ? $tmp : 'int';
	    chomp $type;
	}

	$type = 'GtkType' if $name eq 'getType';	# guint -> GtkType
	$method = /^$gclass[\s*]/o ? '- ' : '+ ';

	if ($name =~ /^new($|[^a-uw-z])/)
	{
	    if ($name !~ /^newWith[A-Z]/)
	    {
		$method = '+ '.$name.'With';
		$loop = 'new';
	    }
	    else
	    {
		$method = '+ '.$name;
	    }
	}
	else
	{
	    $method .= "($type) $name";
	}
	$end = 0;

	until ($end)
	{
	    $_ = <FILE> if defined $loop1;

	    s/(\w+)\[\]/ *$1/g;
	    @_ = split(/,/, $_);

	    foreach (@_)
	    {
		next if /^\s*$/;
		$end = eof FILE || /\);/;

		if (!defined $loop1 && $method =~ /^-/)
		{
		    $loop1 = '';
		    next;
		}

		/(\w*)[),;\s]*$/;
		$var = $1;
		$key = &up($1);
		s/(\w*)[),;\s]*$//;
		$parm = /\s*(.*)/ ? $1 : '';

		if ($var)
		{
		    last if $var eq 'void';
		    if (defined $loop)
		    {
			# simplify some constructor names
			$key =~ s/^\l$gname([A-Z])/$1/o if $loop eq 'new';
			$method .= $loop eq 'new' ? "\u$key" : " $key";
		    }
		    $method .= ":($parm) $var";
		}
		elsif ($parm eq '...')
		{
		    $method .= ':(gpointer) dummy' if !defined $loop;
		    $method .= ', ...';
		}
		else
		{
		    die "format error in $ARGV[0]";
		}
		$loop = $loop1 = '';
	    }
	}

	$method =~ s/\s+/ /g;
	$method =~ s/\( /(/g;
	$method =~ s/ \)/)/g;
	$method =~ s/\bGtk[A-Z]\w+/&gtk($&)/ge;
#	$method =~ s/\bgboolean\b/BOOL/g;
	$method =~ s/\bg?char *\*/NSString */g;
#	$method =~ s/\bg?uchar *\*/NSData */g;
	$method =~ s/\bGList *\*/NSArray */g;
#	$method =~ s/\bGSList *\*/NSArray*/g;
	$method =~ s/\bnewWith$/new/;
	$method =~ s/\bnargs:/nArgs:/;

	next if $method eq '- (void) init' || $method =~ /\.\.\./ ||
		$method =~ /^\+ \(void\) classInit:/;

	if ($method =~ s/^. new($|[^a-uw-z])/+ \l$gname$1/)
	{
	    push @method, $method;
	    $name{$method} = '[auto]';
	    $method = "- init$1$'";
	    $name .= ':';
	}

	$method =~ s/^\+/-/ if $cname eq '';
	push @method, $method;
	$name{$method} = &down($name);
    }
} continue
{
    $tmp = $_;
}

close FILE;

exit if $class eq 'GtkType';	# GtkType is not a real class

if (!defined $class)
{
    if ($ARGV[0] ne 'gtk.h')
    {
	undef $skip if $ARGV[0] eq 'gtkaccelgroup.h'
		    || $ARGV[0] eq 'gtkmenufactory.h';
	print STDERR "skipping $ARGV[0]...\n" if defined $skip;
	exit;
    }

    open(OUT, '>GToolKit.h') || die "cannot create output file: $!";
    print OUT "#ifndef GTOOLKIT_GTOOLKIT_H\n#define GTOOLKIT_GTOOLKIT_H\n\n";

    open(OUT2, '>GTK.h') || die "cannot create output file: $!";
    open(IN2, 'GTK.h.in') || die "cannot find GTK.h.in: $!";
    print OUT2 $_ while defined($_ = <IN2>) && $_ ne "#>>#\n";

    foreach (sort keys %MAP)
    {
	print OUT "#include <GToolKit/$MAP{$_}.h>\n";
	print OUT2 "\@class $MAP{$_};\n";
    }

    print OUT2 $_ while <IN2>;
    close IN2;
    close OUT2;

    if (open(IN, 'GToolKit.in'))
    {
	print OUT $_ while <IN>;
	close IN;
    }
    print OUT "\n#endif\n";
}
else
{
    $dir = $DIR{$class} ? $DIR{$class} : 'GToolKit';
    open(OUT, defined $stdout ? '>-' : ">$class.m")
	|| die "cannot create output file: $!";

    print OUT "#include <GToolKit/GToolKit.h>\n";
    print OUT "#include <$dir/$class.h>\n\n";	# if $dir ne 'GToolKit';
    print OUT "\@implementation $class\n";
    foreach (@method)
    {
	next if $cname eq '' && index($_, 'argc argv') > -1;
	$name = $name{$_};

	# simplify some selector names
	s/^([^:+]*\b(?>(?:set|get|is|\w+With)?)\w+)(To|For)([A-Z])(\w*)
	  (:[^:]*)\b(?:(?i)\3)\4:/$1$5\l$2$3$4:/x;
	s/^([^:+]*\b(?>(?:set|get|is|\w+With)?)\w*[A-Z]\w+)([A-Z])(\w*)
	  (:[^:]*)\b(?:(?i)\2)\3:/$1$4\l$2$3:/x;

	# avoid problems with GList_to_NSArray
	s/^(.) \( *NSArray \* *\)/$1 (GList *)/ if /[Ff]indAll/;

	# use (NSArray *) instead of (char **)
	s/\( *NSString \*\* *\) (\w+(_list|[^s_]s))\b/(NSArray  *) $1/g;
	s/^(.) \( *NSString \*\* *\)/$1 (NSArray  *)/;
	s/NSString \* \*/NSArray  */g;

	/^(.) (\([^)]+\) )?([\w:]+)/;

	print OUT "$_\n{\n    ";
	$vars = $2 eq '(void) ' ? '' : 'return ';

	if ($name eq '[auto]')
	{
	    $tmp = $3.$';
	    $tmp =~ s/^\l$gname/init/o;
	    $tmp =~ s/\([^)]+\) //g;
	    $call = "[[($class *)[self alloc] $tmp] autorelease];";
	}
	else
	{
	    $tmp = $1;
	    $type = $2 ne '' ? $2 : '(id)';
	    @_ = split(/\w+:/, $');

	    $close = $call = '';
	    $index = 0;
	    if (index($2, 'NSString *') > -1)
	    {
		$call .= 'String_to_NSString(';
		$close = ')';
	    }
	    elsif (index($2, 'NSArray  *') > -1)
	    {
		$call .= 'StrVec_to_NSArray((const char **)';
		$close = ')';
	    }
	    elsif (index($2, 'NSArray *') > -1)
	    {
		$call .= 'GList_to_NSArray(';
		$close = ')';
	    }
#	    elsif (index($2, 'NSArray*') > -1)
#	    {
#		$call .= 'GSList_to_NSArray(';
#		$close = ')';
#	    }
	    elsif ($2 =~ /GTK\w+/)
	    {
		$call .= 'Gtk_to_Object(';
		$close = defined $SPECIAL{$&} ? ", \"$&\")" : ', 0)';	# GTK.m
	    }
	    if (index($name, ':') > -1)
	    {
		$tmp = '+';
		chop $name;
		$call .= '[self initWithGtk:';
		$close = ']';
	    }

	    $call .= "gtk${cname}_$name(";
	    $call .= $tmp eq '-' && $cname ? 'gtk,' : '';
	    $type =~ s/[()]//g;
	    $tmp = '';

	    foreach (@_)
	    {
		/\(([^)]+)\)/;
		$parm = $';

		if (index($1, '**') > -1 &&
		    (index($1, 'NSString') > -1 || index($1, 'GTK') > -1))
		{
		    if ($type ne '' && $type ne 'void ')
		    {
			$tmp = "\n    ${vars}_retval_1;";
			$vars = "$type _retval_1;\n    ";
			$call = '_retval_1 = '.$call;
			$type = '';
		    }

		    ++$index;
		    if (index($1, 'NSString') > -1)
		    {
			$vars = "char *_outval_$index;\n    ".$vars;
			$call .= '&_outval_'.$index.',';
			$close .= ";\n    *$parm = String_to_NSString".
				  "(_outval_$index)";
		    }
		    else
		    {
			$vars = "$1 _outval_$index;\n    ".$vars;
			$vars =~ s/GTK/Gtk/;
			$vars =~ s/\*\*/*/;
			$call .= '&_outval_'.$index.',';
			$close .= ";\n    *$parm = Gtk_to_Object".
				  "(_outval_$index, 0)";
		    }
		}
		elsif (index($1, 'NSString *') > -1)
		{
		    $call .= "NSString_to_String($parm),";
		}
		elsif (index($1, 'NSArray  *') > -1)
		{
		    $call .= "(char **)NSArray_to_StrVec($parm),";
		}
		elsif (index($1, 'NSArray *') > -1)
		{
		    $call .= "NSArray_to_GList($parm),";
		}
#		elsif (index($1, 'NSArray*') > -1)
#		{
#		    $call .= "NSArray_to_GSList($parm),";
#		}
		elsif ($1 =~ /GTK\w+/)
		{
		    $call .= "[$parm gtk],";
		}
		else
		{
		    $call .= $parm.',';
		}
	    }
	    $call =~ s/,?$/)$close;$tmp/;
	}
	print OUT $vars, $call, "\n}\n";
    }
    if (open(IN, "$class.in"))
    {
	while (<IN>)
	{
	    print OUT $_ unless /^%/;
	}
	close IN;
    }
    print OUT "\@end\n";

    $dir = $DIR{$class} ? $DIR{$class} : 'gtk';
    $ifile = $DIR{$super} ? $DIR{$super} : 'GToolKit';
    $ifile .= $super =~ /^NS/ ? '/GTK' : '/'.$super;
    open(OUT, ">$class.h") || die "cannot create output file: $!";

    print OUT
	"/*\n",
	" * GToolKit - Objective-C interface to the GIMP Toolkit\n",
	" * Copyright (c) 1999  Elmar Ludwig - Universitaet Osnabrueck\n",
	" *\n",
	" * Generated automatically from $ARGV[0] by gtkgen.\n",
	" *\n",
	" * This library is free software; you can redistribute it and/or\n",
	" * modify it under the terms of the GNU Library General Public\n",
	" * License as published by the Free Software Foundation; either\n",
	" * version 2 of the License, or (at your option) any later version.\n",
	" */\n";
    print OUT "#ifndef GTOOLKIT_\U$class\E_H\n";
    print OUT "#define GTOOLKIT_\U$class\E_H\n\n";
    print OUT "#include <$ifile.h>\n";		#."#define id gtk_id\n"
    print OUT "#include <$dir/$ARGV[0]>\n";	# ."#undef id\n\n"
    print OUT "#include <$dir/gtkrc.h>\n" if $ARGV[0] eq 'gtkmain.h';
    print OUT "\n\@interface $class : $super\n";
    if (open(IN, "$class.in"))
    {
	while (<IN>)
	{
	    print OUT $_ if s/^%%//;		# this needs to be redesigned
	}
	close IN;
    }
    foreach (@method)
    {
	next if $cname eq '' && index($_, 'argc argv') > -1;
	print OUT "$_;\n";
    }
    if (open(IN, "$class.in"))
    {
	while (<IN>)
	{
	    print OUT "$_;\n" if /^[+-]/ && chomp;
	}
	close IN;
    }
    print OUT "\@end\n";
    if (open(IN, "$class.in"))
    {
	while (<IN>)
	{
	    next if /^%%/;
	    print OUT $_ if s/^%//;
	}
	close IN;
    }
    print OUT "\n#endif\n";
}

close OUT;
