#!/usr/bin/perl -w
#
# Perl script to extract declarations of functions, macros, enums, structs and
# unions from GTK+, GDK, and GLIB, to be used for generating DocBook
# documentation.
#
# It outputs all declarations found to a file named 'gXXX-decl.txt', and the
# list of decarations to another file 'gXXX-decl-list.txt'.
# This second list file is then organized into sections ready to output the
# sgml pages.
#
# NOTE: There are currently a few special cases:
#   gdk_image_new_bitmap, GtkArgGetFunc, GtkArgSetFunc
# These didn't have parameter names in the headers, so they are added here.
# We should probably do something about them at some point.
#

use Getopt::Long;

# Options

# name of documentation module
my $MODULE;
my $OUTPUT_DIR;

%optctl = (module => \$MODULE,
	   'output-dir' => \$OUTPUT_DIR);
GetOptions(\%optctl, "module=s", "output-dir:s");

$OUTPUT_DIR = $OUTPUT_DIR ? $OUTPUT_DIR : ".";

if (!-d ${OUTPUT_DIR}) {
    mkdir($OUTPUT_DIR, 0755) || die "Cannot create $OUTPUT_DIR: $!";
}

# Backup existing files
if (-f "${OUTPUT_DIR}/$MODULE-decl-list.txt") {
    rename ("${OUTPUT_DIR}/$MODULE-decl-list.txt",
	    "${OUTPUT_DIR}/$MODULE-decl-list.bak");
}

if (-f "${OUTPUT_DIR}/$MODULE-decl.txt") {
    rename ("${OUTPUT_DIR}/$MODULE-decl.txt",
	    "${OUTPUT_DIR}/$MODULE-decl.bak");
}

open (LIST, ">${OUTPUT_DIR}/$MODULE-decl-list.txt")
    || die "Can't open ${OUTPUT_DIR}/$MODULE-decl-list.txt";
open (TYPES, ">${OUTPUT_DIR}/$MODULE-decl.txt")
    || die "Can't open ${OUTPUT_DIR}/$MODULE-decl.txt";

$main_list = $object_list = "";

for $file (@ARGV) {
    my $file_prefix = $file;
    $file_prefix =~ s/\.h$//;
    ($list, $type) = &ScanHeader($file);
    if ($type) {
	$object_list .= "<SECTION>\n<FILE>$file_prefix</FILE>\n$list</SECTION>\n";
    } else {
	$main_list .= "<SECTION>\n<FILE>$file_prefix</FILE>\n$list</SECTION>\n";
    }
}

print LIST $object_list, $main_list;
close (LIST);
close (TYPES);

# This scans a header file, looking for declarations of functions, macros,
# typedefs, structs and unions, which it outputs to the TYPES file.
# It also outputs a list of declarations to the LIST file.
sub ScanHeader {
    local ($input_file) = @_;

#    print "Scanning: $input_file\n";
    $list = "";
    @objects = ();

    if (! -f $input_file) {
	print "File doesn't exist: $input_file\n";
	return ("", 0);
    }

    open(INPUT, $input_file)
	|| die "Couldn't open file: $input_file";
    $in_declaration = "";
    while(<INPUT>) {
	# For GTK, look for a widget class to use as the section title.
	# Style isn't really an object.
	if (m/^struct\s+_(Gtk\S+)Class/) {
	    if ($1 ne 'GtkStyle') {
		$list .= "<TITLE>$1</TITLE>\n";
	    }
	}

	if (!$in_declaration) {
	    # We don't want '#defines' here
	    if (m/^(G_INLINE_FUNC\s+)?([^#\s\/]\w*)\s*(\**)\s*(g[^_]*_\S+)\s*\(/) {
		$ret_type = $2;
		$modifier = $3;
		$function = $4;
		$args = $';

		# Don't want typedefs
		if ($ret_type ne 'typedef') {
#		    print "Function: $function, Returns: ${ret_type}$modifier\n";
		    $in_declaration = "function";
		}

	    } elsif (m/^typedef\s+((const\s+)?\w+)\s*(\**)\s*\(\*(G\S+)\)\s*\(/) {
		$ret_type = $1;
		$modifier = $3;
		$function = $4;
		$args = $';
		$in_declaration = "user_function";

	    } elsif (m/^\s*#\s*define\s+(\w+)/) {
		$macro = $1;
		# Don't want __G_*_H or _FNMATCH_H or __P macros
		if ($macro !~ m/^__G.*_H__$/
		    && $macro ne "_FNMATCH_H" && $macro ne "__P") {
		    $args = $_;
		    $in_declaration = "macro";
		}

	    } elsif (m/^typedef\s+enum/) {
		$args = $_;
		$in_declaration = "enum";

	    } elsif (s/^struct\s+_(\w+)/struct $1/) {
		$struct = $1;
		$args = $_;
		# We skip object structs
		if ($struct =~ m/^(Gtk\S+)Class/ && $1 ne 'GtkStyle') {
#		    print "Found class: $1\n";
		    push (@objects, $1);
		} else {
		    $in_declaration = "struct";
		}

	    } elsif (s/^union\s+_(\w+)/union $1/) {
		$union = $1;
		$args = $_;
		$in_declaration = "union";

	    } elsif (m/^typedef\s+(.+[\s\*])(\w\S*);/) {
		if ($1 !~ m/^struct\s/ && $1 !~ m/^union\s/) {
#		    print "Found typedef: $_";
		    $list .= "$2\n";
		    print TYPES "<TYPEDEF>\n<NAME>$2</NAME>\n$_</TYPEDEF>\n";
		}
	    } elsif (m/^typedef\s+/) {
#		print "Skipping typedef: $_";
	    }
	} else {
	    $args .= $_;
	}

	if ($in_declaration eq 'function') {
	    if ($args =~ s/\).*$//) {
		$args =~ s/^\s+//;
		$args =~ s/\n\s+/\n/g;
		$args =~ s/\s+$//;
		$args =~ s/\s+\n/\n/g;
		$list .= "$function\n";
		print TYPES "<FUNCTION>\n<NAME>$function</NAME>\n<RETURNS>$ret_type $modifier</RETURNS>\n$args\n</FUNCTION>\n";
		$in_declaration = "";
	    }
	}

	if ($in_declaration eq 'user_function') {
	    if ($args =~ s/\).*$//) {
		# Special cases
		if ($function eq 'GtkArgGetFunc'
		    || $function eq 'GtkArgSetFunc') {
		    $args = "GtkObject *object, GtkArg *arg, guint arg_id\n";
		}

		$list .= "$function\n";
		print TYPES "<USER_FUNCTION>\n<NAME>$function</NAME>\n<RETURNS>$ret_type $modifier</RETURNS>\n$args</USER_FUNCTION>\n";
		$in_declaration = "";
	    }
	}

	if ($in_declaration eq 'macro') {
	    if ($args !~ m/\\\s*$/) {
		$list .= "$macro\n";
		print TYPES "<MACRO>\n<NAME>$macro</NAME>\n$args</MACRO>\n";
		$in_declaration = "";
	    }
	}

	if ($in_declaration eq 'enum') {
	    if ($args =~ m/\}\s*(\w+);\s*$/) {
		$list .= "$1\n";
		print TYPES "<ENUM>\n<NAME>$1</NAME>\n$args</ENUM>\n";

		$in_declaration = "";
	    }
	}

	if ($in_declaration eq 'struct') {
	    if ($args =~ m/\}\s*;\s*$/) {
		$list .= "$struct\n";
		print TYPES "<STRUCT>\n<NAME>$struct</NAME>\n$args</STRUCT>\n";

		$in_declaration = "";
	    }
	}

	if ($in_declaration eq 'union') {
	    if ($args =~ m/\}\s*;\s*$/) {
		$list .= "$union\n";
		print TYPES "<UNION>\n<NAME>$union</NAME>\n$args</UNION>\n";

		$in_declaration = "";
	    }
	}
    }
    close(INPUT);

    # Take out any object structs
    for ($i = 0; $i <= $#objects; $i++) {
	$object = $objects[$i];
	$list =~ s/^$object\n//m;
	$list =~ s/^${object}Class\n//m;
    }


    # Try to separate the standard macros and function
    $class = "";
    $standard_decl = "";
    if ($list =~ m/^GTK_IS_(.*)_CLASS/m) {
	$class = $1;
    } elsif ($list =~ m/^GTK_IS_(.*)/m) {
	$class = $1;
    }
    if ($class ne "") {
	if ($list =~ s/^GTK_$class\n//m)            { $standard_decl .= $&; }
	if ($list =~ s/^GTK_IS_$class\n//m)         { $standard_decl .= $&; }
	if ($list =~ s/^GTK_TYPE_$class\n//m)       { $standard_decl .= $&; }
	if ($list =~ s/^gtk_.*_get_type\n//m)       { $standard_decl .= $&; }
	if ($list =~ s/^GTK_${class}_CLASS\n//m)    { $standard_decl .= $&; }
	if ($list =~ s/^GTK_IS_${class}_CLASS\n//m) { $standard_decl .= $&; }

        if ($standard_decl ne "") {
	    $list .= "<SUBSECTION>\n<NAME>Standard</NAME>\n$standard_decl";
	}
	return ($list, 1);
    } else {
	return ($list, 0);
    }
}
