#!/usr/bin/perl -w
#
#	Create GTK+ Objective-C class library from GTK+ include files.
#	Copyright (c) 1998, 1999, 2000  Elmar Ludwig

#	This program is free software; you can redistribute it and/or
#	modify it under the terms of the GNU General Public License as
#	published by the Free Software Foundation; either version 2 of
#	the License, or (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 along with this program; if not, write to the Free
#	Software Foundation, Inc., 59 Temple Place, Suite 330, Boston,
#	MA 02111-1307, USA.
#
#	As a special exception to the GNU General Public License, if
#	you distribute files generated by this script (`gtkgen') as part
#	of a program or library that uses the `GToolKit' library, you may
#	include them under the same distribution terms that you use for
#	the rest of that program.

#	This is a rather stupid script to generate Objective-C wrapper
#	classes from the standard GTK+ include files. It reads a set of
#	GTK+ include files and creates an interface and implementation
#	file for each class found. The script should also work with most
#	include files of related packages - if they are formatted in the
#	same way and follow the standard GTK+ naming conventions. However,
#	you may have to extend the class name prefix mapping table below
#	(and in `mkclasses') if the classes you want to wrap do not start
#	with any of the standard prefixes listed there.
#
#	You have to provide a file `classes.in' (or use the `--classes'
#	option to name it differently) containing a table of *all* GTK+
#	classes (i.e. GtkObject and its subclasses) that may appear in
#	the input files to process. For your own projects, it is probably
#	best to copy the `classes.in' file provided with this library and
#	merge in any new classes. You can run `mkclasses' to gather the
#	required information about the new classes. In this case, read
#	the comments inside `mkclasses' for a short description of all
#	the fields in the class table file. Note: This format has changed
#	significantly for version 0.9.4 of the `gtkgen' command.
#
#	For each created class, gtkgen looks for a file named after the
#	class name with `.in' appended (e.g. `GTKObject.in') and appends
#	its contents to the generated class implementation. This is an
#	easy way to add methods written by hand to the generated files.
#	Sections in the input file marked with `%extern'...`%end' will go
#	into the corresponding header file (before the class interface),
#	whereas `%interface'...`%end' will place its contents inside the
#	class interface (to add instance variables). See `GTKWindow.in'
#	for an example of how this can be used.
#
#	Usage: gtkgen [options] [header_file]...
#
#	Options:  --classes file	read the class table from FILE
#		  --output file		output file for class implementations
#		  --package name	create a package include file
#		  --strict		assume strict source formatting rules

use integer;
use Getopt::Long;

Getopt::Long::Configure('bundling', 'no_getopt_compat', 'no_ignore_case');

$classes = 'classes.in';		# default class table file

if (!GetOptions('classes=s', \$classes, 'output=s', \$output,
		'package=s', \$package, 'strict', \$strict,
		'help', \$help) || defined $help)
{
    die "Usage: $0 [options] [header_file]...\n",
	"Create Objective-C classes from GTK+ include files.\n\n",
	"  --classes file\tread class table from FILE instead of classes.in\n",
	"  --output file\t\tprint generated class implementations to FILE\n",
	"  --package name\tcreate master include file for package NAME\n",
	"  --strict\t\tassume strict formatting rules for input files\n",
	"  --help\t\tdisplay this help text and exit\n";
}

# prefix mappings for GTK+, GDK, Pango and GNOME
%prefix = ('Gtk', 'GTK', 'Gdk', 'GDK', 'Pango', 'Pango_', 'Gnome', 'Gnome_');
$prefix = '('.join('|', keys %prefix).')';
$mapped = '('.join('|', values %prefix).')';

%map = %rmap = ();			# class map hash tables

	## ========================================================== ##

sub map					# map GTK+ class -> Objective-C class
{
    my ($name) = @_;

    return defined $map{$name} ? $map{$name}[1] : $name;
}

sub uppercase				# new_with_label -> newWithLabel
{
    my ($name) = @_;

    $name =~ s/_([a-z])/\u$1/g;		# use s/[A-Z]/_\l$&/g to reverse this
    return $name;
}

sub typeinfo				# type string or 0 (autodetect)
{
    my ($name) = @_;

    return $name eq 'GTKObject' || $map{$rmap{$name}}[4] ne '' ?
		'0' : '"'.$name.'"';
}

sub endswith				# is substr at end?
{
    my ($str, $substr) = @_;

    return substr($str, -length $substr) eq $substr;
}

sub basename				# calculate basename
{
    my ($name) = @_;

    return $name =~ /^.*\/(.*)/ ? $1 : $name;
}

sub dirname				# calculate dirname
{
    my ($name) = @_;

    return $name =~ /^(.*)\/.*/ ? $1 : '';
}

sub include				# find Objective-C include file
{
    my ($name) = @_;
    my $file = &dirname($map{$name}[5]);

    $file = $file eq 'gtk' ? 'GToolKit/' : $file.'_objc/' if $file ne '';
    return $file.$map{$name}[1].'.h';
}

sub copyleft				# default copyright header
{
    my ($file) = @_;
    my ($license, $version) = ('Lesser ', 'version 2.1');

    return
      "/*\n".
      " * GToolKit - Objective-C interface to the GIMP Toolkit\n".
      " * Copyright (c) 1998, 1999, 2000  Elmar Ludwig\n".
      " *\n".
      " * Generated automatically from $file by gtkgen.\n".
      " *\n".
      " * This library is free software; you can redistribute it and/or\n".
      " * modify it under the terms of the GNU ${license}General Public\n".
      " * License as published by the Free Software Foundation; either\n".
      " * $version of the License, or (at your option) any later version.\n".
      " */\n";
}

	## ========================================================== ##

open(IN, $classes) || die "cannot open $classes: $!";
open(OUTPUT, ">$output") || die "cannot create $output: $!" if defined $output;

while (<IN>)				# read class table
{
    chomp;
    next if /^\s*#/ || /^\s*$/;		# comment or empty line

    @info = split(/;/);			# info fields: see `mkclasses'
    $map{$info[0]} = [@info];		# make a copy here
    $rmap{$info[1]} = $info[0];		# reverse mapping
}

close IN;

# this is a special case (gtkmain.h and gtkrc.h -> GTKMain)
$map{'GtkMain'} = ['GtkMain', 'GTKMain', 'main', 'gtk',
		   'NSObject', 'gtk/gtkmain.h'];

while (defined ($ARGV = shift))		# process arguments
{
    open(FILE, $ARGV) || die "cannot open $ARGV: $!";
    $file = &basename($ARGV);

    @classes = grep(&endswith($ARGV, @{$_}[5]), values %map);
    print STDERR "skipping $file...\n" if $#classes == -1;

    foreach $ref (@classes)
    {
	$gclass = @{$ref}[0];		# GtkButton
	$class  = @{$ref}[1];		# GTKButton
	$alloc  = @{$ref}[2];		# button
	$cname  = @{$ref}[3];		# gtk_button
	$super  = @{$ref}[4];		# GtkBin
	$hfile  = @{$ref}[5];		# gtk/gtkbutton.h

	seek(FILE, 0, 0);
	undef $include;			# additional includes
	undef $fake_instance;		# fake instance methods

	if ($file eq 'gtkmain.h')	# gtkmain.h
	{
	    $name = $ARGV;
	    $name =~ s/\bgtkmain\.h/gtkrc.h/;
	    open(FILE, "cat $ARGV $name|") || die "cannot open $name: $!";
	    $include = "#include <gtk/gtkrc.h>\n";
	    $fake_instance = 'yes';
	}

	## =============== read the class input file ================ ##

	$in_extern = $in_ivars = $in_method = $in_exclude = $in_impl = '';
	%in_map = ('%extern', \$in_extern, '%interface', \$in_ivars,
		   '%method', \$in_method, '%exclude', \$in_exclude,
		   '%end', \$in_impl)
	    unless defined %in_map;		# map of tokens

	if (open(IN, "$class.in"))
	{
	    $ref = \$in_impl;			# implementation section

	    while (<IN>)
	    {
		if (/^%\w+/)			# section token
		{
		    die "unknown $& in $class.in" unless defined $in_map{$&};
		    $ref = $in_map{$&};
		    next;
		}

		if ($ref == \$in_impl && /^[+-]/)
		{
		    $_ .= <IN> until index($_, '{') > -1 || eof;
		    $in_method .= $_;
		}

		${$ref} .= $_;			# append current line
	    }
	    $in_method =~ s/\s*\{.*/;/g;	# method declarations
	    close IN;
	}

	## =============== scan current include file ================ ##

	%classes = ();
	%methods = ();
	@methods = ();
	$method_name = qr/^([\s\w*]*)\b${cname}_(\w+)/;	# avoid recompilation
	$method_type = qr/^(const\s+)?$gclass\s*\*/;
	$initializer = qr/^$alloc([A-Z])/;
	$comment = '';
	$lastline = '';

	while (<FILE>)
	{
	    if (/^\s*\/\*/)
	    {
		$_ .= <FILE> until /\*\//;
		# omit deprecated/private methods (but keep GtkMenuFactory)
		if (/\b(deprecated|internal|obsolete|private|non-public)/i &&
		    $file ne 'gtkmenufactory.h')	# TODO: obsolete
		{
		    $_ = <FILE>;
		    $_ = <FILE> if /^\s*$/;
		    $_ = <FILE> until /^\s*$/ || eof;
		    $comment = '';
		}
		next;					# skip to end of line
	    }

	    next if /\w;\s*$/;				# not a function

	    if (/$method_name/)				# find function name
	    {
		$type = $1;
		$func = $2;
		$name = &uppercase($2);

		next if $name =~ /^construct/ ||	# reserved name
			$name =~ /^dialog[A-Z]/ && $class =~ /Selection$/ ||
			index($in_exclude, $cname.'_'.$func."\n") > -1 ||
			defined $methods{$name};
		$methods{$name} = '';			# mark as seen

		$_ .= <FILE> until /\(\s*\S/ || eof;	# args on next line
		s/\(\s*\)/(void)/g;
		s/^.*\(\s*//s;

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

		$type = 'GtkType' if $name eq 'getType';# guint -> GtkType
		$method = /$method_type/ ? '- ' : '+ ';

		$use_key = 'no';

		if ($name =~ /^newv?($|[^a-z])/)	# initializer
		{
		    $method = '+ (id) '.$name;

		    if ($name !~ /^newWith[A-Z]/)	# TODO: (From|With)?
		    {
			$method .= 'With';
			$use_key = 'new';
		    }
		}
		else					# normal method
		{
		    $method .= "($type) $name";
		}

		$_ .= <FILE> until /\)\s*;/ || eof;	# find end of method
		s/\/\*.*?\*\// /gs;
		s/\b(\w+)\s*\[\d*\]/ *$1/g;		# prepend space
		s/\)\s*;\s*$//;
		y/\n/ /;

		@_ = split(/,/);
		shift @_ if index($method, '-') == 0;	# skip first parameter

		foreach (@_)				# parameter list
		{
		    die "invalid parameter ($_) in $file" unless /[\w.]/;

		    ($type, $var) = /^\s*(\S.*)\b(\w+)\s*$/ ? ($1, $2)
							    : ($_, '');
		    last if $type =~ /^void\s*$/;
#		    $var =~ y/_/ /;			# TODO: not yet
#		    $var =~ s/\bstr\b/string/g;
#		    $var =~ s/\bval\b/value/g;
#		    $var =~ s/\b[hv]adj\b/${&}ustment/g;
#		    $var =~ y/ /_/;

		    if ($var ne '')			# build selector
		    {
			if ($use_key ne 'no')
			{
			    $key = &uppercase($var);
			    # simplify some initializer names
			    $key =~ s/$initializer/$1/ if $use_key eq 'new';
			    $method .= $use_key eq 'new' ? "\u$key" : " $key";
			}
			$method .= ":($type) $var";
		    }
		    elsif (/^\s*\.\.\.$/)		# va_list
		    {
			$method .= ':(gpointer) dummy' if $use_key ne 'yes';
			$method .= ', ...';
		    }
		    else				# format error
		    {
			s/^\s*//;
			die "format error ($_) in $file";
		    }
		    $use_key = 'yes';
		}

		while ($method =~ /\b$prefix[A-Z]\w+/go)# class dependencies
		{
		    $classes{$&} = '' if $& ne $gclass && defined $map{$&};
		}

		$method =~ s/\s+/ /g;
		$method =~ s/\( /(/g;
		$method =~ s/ \)/)/g;
		$method =~ s/\b$prefix[A-Z]\w+/&map($&)/ego;
#		$method =~ s/\bgboolean\b/BOOL/g;	# TODO: not yet
#		$method =~ s/\bgstring\b/NSString */g;	# TODO: not yet
		$method =~ s/\bg?char *\*/NSString */g;	# unsigned?
#		$method =~ s/\bg?uchar *\*/NSData */g;	# don't do this!
		$method =~ s/\bGList *\*/NSArray */g;
#		$method =~ s/\bGSList *\*/NSArray*/g;	# don't do this!
		$method =~ s/\b(new\w*)With$/$1/;
		$method =~ s/\bnargs:/nArgs:/;

		next if $method eq '- (void) init' ||
			index($method, '...') > -1 ||	# va_list
			index($method, '+ (void) classInit') == 0 ||
			index($method, 'argc argv:') > -1 &&
			    ($class eq 'GTKMain');

		if (defined $strict)			# strict formatting
		{
		    # NSString without `const' indicates out parameter
		    $method =~ s/:\(NSString \*\)/:(gchar *)/g;
		}

		if ($method =~ s/^\+ \(id\) new/+ (id) $alloc/)
		{					# store method
		    push @methods, [$method, '[auto]', $comment];
		    $method = "- (id) init$'";
		    $comment = '';
		    $func .= ':';			# add marker
		}
							# store method
		$method =~ s/^\+/-/ if defined $fake_instance;
		push @methods, [$method, $func, $comment];
	    }
	}
	continue
	{						# store comment
#	    $comment = /^\s*\/\*.*?\*\//s ? $&."\n" : '' if /\S/;
	    $lastline = $_;
	}

	## ============= write the implementation file ============== ##

	open(OUTPUT, ">$class.m") || die "cannot create $class.m: $!"
	    unless defined $output;

	print OUTPUT &copyleft($file);		# print header
	print OUTPUT '#include <', &include($_), ">\n"
	    foreach ($gclass, keys %classes);
	print OUTPUT "\n\@implementation $class\n";

	$initializer = qr/^$alloc/;		# avoid recompilation

	foreach $ref (@methods)
	{
	    $_    = @{$ref}[0];			# method declaration
	    $name = @{$ref}[1];			# GTK+ function name
	    $comm = @{$ref}[2];			# comment text (if any)

	    # simplify some selector names (don't you just love Perl? :-)
	    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 gtoolkit_list_to_array() in GTKCTree
	    s/^(.) \(NSArray \*\) (findAllByRow)/$1 (GList *) $2/;

	    # special notation:	(NSArray  *) <--> string array
	    #			(NSArray *)  <--> object array (glist)
	    #			(NSArray*)   <--> object array (gslist)

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

	    @{$ref}[0] = $_;			# modify @methods

	    # analyse the method declaration (return type mandatory)
	    /^(.) \(([^)]+)\) ([\w:]+)/;
	    $vars = $2 eq 'void' ? '' : 'return ';

	    if ($name eq '[auto]')		# allocator method
	    {
		$name = $3.$';
		$name =~ s/$initializer/init/;
		$name =~ s/\([^)]+\) //g;
		$call = "[[($class *)[self alloc] $name] autorelease];";
	    }
	    else				# standard method
	    {
		$kind = $1;			# '+' or '-'
		$type = $2;			# return type
		@_ = split(/\w+:/, $');		# parameter list
		$close = ')';

		if (index($name, ':') > -1)	# init marker
		{
		    chop $name;
		    $kind = '+';
		    $call = '[self initWithGtk:';
		    $close = ']';
		}
		elsif (index($2, 'NSString *') > -1)
		{				# string
		    $call = 'gtoolkit_objc_string(';
		}
		elsif (index($2, 'NSArray  *') > -1)
		{				# string array (cast)
		    $call = 'gtoolkit_strvec_to_array((const char **)';
		}
		elsif (index($2, 'NSArray *') > -1)
		{				# object array
		    $call = 'gtoolkit_list_to_array(';
		}
#		elsif (index($2, 'NSArray*') > -1)
#		{				# object array
#		    $call = 'gtoolkit_slist_to_array(';
#		}
		elsif ($2 =~ /\b$mapped[A-Z]\w+/o)
		{				# object
		    $call = 'gtoolkit_object(';
		    $close = ', '.&typeinfo($&).')';
		}
		else
		{				# other
		    $call = $close = '';
		}

		$call .= $cname.'_'.$name.'(';
		$call .= 'gtk,' if $kind eq '-' && !defined $fake_instance;

		$return = '';
		$count = 0;

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

		    if ($ptype =~ /\* *\*/ &&	# out parameter
			(index($ptype, 'NSString *') > -1 ||
			 $ptype =~ /\b$mapped[A-Z]\w+/o))
		    {
			if ($type ne 'void')	# store return value
			{
			    $return = ";\n    ${vars}_retval_1";
			    $vars = $type." _retval_1;\n    ";
			    $call = '_retval_1 = '.$call;
			    $type = 'void';	# do this only once
			}

			++$count;
			if (index($ptype, 'NSString *') > -1)
			{
			    $vars = "char *_outval_$count;\n    ".$vars;
			    $call .= '&_outval_'.$count.',';
			    $close .= ";\n    *$parm = gtoolkit_objc_string".
				      "(_outval_$count)";
			}
			else			# object reference
			{
			    $vars = $rmap{$&}." *_outval_$count;\n    ".$vars;
			    $call .= '&_outval_'.$count.',';
			    $close .= ";\n    *$parm = gtoolkit_object".
				      "(_outval_$count, ".&typeinfo($&).')';
			}
		    }
		    elsif (index($ptype, 'NSString *') > -1)
		    {				# string
			$call .= "gtoolkit_utf8_string($parm),";
		    }
		    elsif (index($ptype, 'NSArray  *') > -1)
		    {				# string array (cast)
			$call .= "(char **)gtoolkit_array_to_strvec($parm),";
		    }
		    elsif (index($ptype, 'NSArray *') > -1)
		    {				# object array
			$call .= "gtoolkit_array_to_list($parm),";
		    }
#		    elsif (index($ptype, 'NSArray*') > -1)
#		    {				# object array
#			$call .= "gtoolkit_array_to_slist($parm),";
#		    }
		    elsif ($ptype =~ /\b$mapped[A-Z]\w+/o)
		    {				# object
#			$call .= "[$parm gtk],";
			$call .= "$parm ?$parm->gtk : 0,";
		    }
		    else
		    {				# other
			$call .= $parm.',';
		    }
		}

		chop $call if substr($call, -1) eq ',';
		$call .= ')'.$close.$return.';';
	    }

	    print OUTPUT $comm, $_, "\n{\n    ", $vars, $call, "\n}\n";
	}

	print OUTPUT $in_impl, "\@end\n";
	close OUTPUT unless defined $output;

	## ================= write the include file ================= ##

	open(OUT, ">$class.h") || die "cannot create $class.h: $!";

	$guard = uc(&include($gclass));
	$guard =~ y/A-Z0-9/_/c;
	$ifile = defined $map{$super} ? &include($super) : 'GToolKit/GTK.h';
	$super = 'GTK' if $super eq '';

	print OUT &copyleft($file),		# print header
		  "#ifndef $guard\n",
		  "#define $guard\n\n",
		  "#include <$ifile>\n",	# "#define id gtk_id\n",
		  "#include <$hfile>\n";	# "#undef  id\n\n",
	print OUT $include if defined $include;

	print OUT "\n" if %classes;		# class declarations
	print OUT '@class ', &map($_), ";\n" foreach sort keys %classes;

	print OUT "\n", $in_extern,
		  "\@interface $class : ", &map($super), "\n",
		  $in_ivars;			# instance vars and methods
	print OUT $_, ";\n" foreach map(@{$_}[0], @methods);
	print OUT $in_method,
		  "\@end\n",
		  "\n#endif /* $guard */\n";
	close OUT;
    }
    close FILE;
}

close OUTPUT if defined $output;

	## ============= write the master include file ============== ##

if (defined $package)
{
    open(OUT, ">$package.h") || die "cannot create $package.h: $!";

    $guard = $include = '';

    foreach (sort map(&include($_), keys %map))	# all include files
    {
	next unless /^\Q$package\E(_objc)?\//io;
	$guard = &dirname($_) if $guard eq '';	# package directory
 	$include .= "#include <$_>\n";
    }

    $guard = uc($guard.'/'.$package.'.h');
    $guard =~ y/A-Z0-9/_/c;

    print OUT &copyleft($classes),		# print header
	      "#ifndef $guard\n",
	      "#define $guard\n\n";

    if (open(IN, "$package.in"))		# package input file
    {
	print OUT <IN>;
	close IN;
    }

    print OUT $include,				# print includes
	      "\n#endif /* $guard */\n";
    close OUT;
}
