#!/usr/bin/perl -w
#
#	Build a class table from GTK+ include files for use by gtkgen.
#	Copyright (c) 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.

#	This script reads a set of GTK+ include files and builds a class
#	table suitable for use by `gtkgen' from the list of classes found.
#	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. A class list is a simple text file containing
#	the following information about each class (one class per line,
#	info fields separated by `;'):
#
#	GTK+ class name				(Example: GtkButton)
#	Objective-C class name			(	  GTKButton)
#	Objective-C allocator method prefix	(	  button)
#	GTK+ function name prefix		(	  gtk_button)
#	GTK+ super class name			(	  GtkBin)
#	name of GTK+ include file		(	  gtk/gtkbutton.h)
#
#	Usage: mkclasses [options] [header_file]...
#
#	Options:  --add class	    include additional CLASS in output
#		  --exclude class   omit CLASS from output (if found)
#		  --path dir	    set include file directory to DIR

use integer;
use Getopt::Long;

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

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

@classes = @add = @exclude = ();
$path = '';

if (!GetOptions('add=s@', \@add, 'exclude=s@', \@exclude, 'path=s', \$path,
		'help', \$help) || defined $help)
{
    die "Usage: $0 [options] [header_file]...\n",
	"Build `classes.in' file for `gtkgen'.\n\n",
	"  --add class\t\tinclude additional CLASS in output\n",
	"  --exclude class\tomit CLASS from output (if found)\n",
	"  --path dir\t\tset include file directory to DIR\n",
	"  --help\t\tdisplay this help text and exit\n";
}

sub class_name				# get modified class name
{
    my ($name, $with_pref) = @_;

    if ($with_pref)			# change class name prefix
    {
	$name =~ s/^$prefix/$prefix{$&}/o;
    }
    else				# make first word lowercase
    {
	$name =~ s/^$prefix//o;
	$name =~ s/^([A-Z]+)($|[A-Z][a-z_0-9])/\L$1\E$2/;
	$name =~ s/^([A-Z])/\l$1/;
    }
    return $name;
}

sub func_prefix				# common function prefix
{
    my ($name) = @_;

    $name =~ s/([A-Z]{2,})([A-Z][a-z_0-9])/$1_$2/g;
    $name =~ s/([A-Z])/_\l$1/g;
    $name =~ s/(?<=_)([a-z])_/$1/g;	# avoid loop here
    $name =~ s/^_//;
    return $name;
}

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

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

sub push_item				# push item into list
{
    my ($name, $super, $file) = @_;

    push @classes, [$name, &class_name($name, 1), &class_name($name, 0),
		    &func_prefix($name), $super, $path.&basename($file)];
}

# add the initial classes
$path .= '/' if $path ne '';
&push_item($_, '', lc().'.h') foreach @add;

while (<>)				# scan all input files
{
    if (/^\s*struct\s+_($prefix[A-Z]\w+)Class\s*\{?\s*$/o)
    {
	$name = $1;
	next if grep($name eq $_, @exclude);

	$_ = <> until /;\s*$/ || eof;	# find super class
	$super = /\b($prefix[A-Z]\w+)Class\b/o ? $1 : '';
	&push_item($name, $super, $ARGV);
    }
}

# print final class table
print join(';', @{$_}), "\n" foreach @classes;
