#!/usr/bin/perl -s
#
#	Copyright (c) 1998, 1999  Elmar Ludwig - Universitaet Osnabrueck
#
#	Create GTK Objective-C Class Library from gtk Include Files.
#
#	Note: This script will not work with Perl 4!
#
#	Options:    -skip	skip the first class definition found
#		    -stdout	print implementation files to stdout

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

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

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

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

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

open (FILE, $ARGV[0]) || die "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 "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';
}

@method = ();

while (<FILE>)
{
    if (/^\s*\/\*/)
    {
	if (/\b(internal|deprecated|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/(_[hvc])_/$1/g;

	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;

	$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)
		    {
			$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/\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/;

	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);
    }
}

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 file: $!";
    print OUT "#ifndef GTOOLKIT_GTOOLKIT_H\n#define GTOOLKIT_GTOOLKIT_H\n\n";

    open(OUT2, '>GTK.h') || die "cannot create file: $!";
    open(IN2, 'GTK.h.in') || die 'cannot find GTK.h.in!';
    print OUT2 $_ while ($_ = <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
{
    open(OUT, defined $stdout ? '>-' : ">$class.m")
	|| die "cannot create output file: $!";
    print OUT "#include <GToolKit/GToolKit.h>\n\n";
    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";

    $ifile = $super =~ /^NS/ ? 'GTK' : $super;
    open(OUT, ">$class.h") || die "cannot create 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 <GToolKit/$ifile.h>\n";	# ."#define id gtk_id\n"
    print OUT "#include <gtk/$ARGV[0]>\n\n";	# ."#undef id\n\n"
    print OUT "#include <gtk/gtkrc.h>\n" if $ARGV[0] eq 'gtkmain.h';
    print OUT "\@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;
