#!/usr/bin/perl -w
# $Id$
# Reads source files with comments of the form:
#/**
# * @builtin foo -> ret
# * Description
# */
# from stdin or argv and produces a sorted (new! improved!)
# html list of them to stdout, which should be passed to makehtml.
#
# Martin Vidner <mvidner@suse.cz>

use strict;

# usage: $0 [-a] sources...
# The builtins are sorted by name. If -a is given, thay are
# instead sorted by first arguments (assumedly SCR paths)

my $sort_by_arg = 0;
if (@ARGV > 0 && $ARGV[0] eq "-a")
{
    shift;
    $sort_by_arg = 1;
}

# debug
my $verbose = 0;

# main data
my @entries;
my $entry;

my $state = "boring"; # or "comment"
while (<>)
{
    if ($state eq "boring")
    {
	if (/^\s*\/\*\*/)
	{
	    $state = "comment";
	}
	next;
    }
    elsif ($state eq "comment")
    {
	if (/^\s*\*+\/\s*$/)
	{
	    $state = "boring";
	    if ($entry)
	    {
		push @entries, $entry;
		$entry = 0;
	    }
	    next;
	}
    }

    # now we are in a comment:
    if (/^\s*\*?\s* \@builtin \s* (.*?) \s* -> \s* (.*)/x)
    {
	my $signature = $1;
	my $ret = $2;
	$signature =~ /^ ([^\(]*?) ( \s* \( \s* ( [^,]* ) .* \) )? \s* $/x;
	my $name = $1;
	my $args = $2 || "";
	my $firstarg = $3 || "";
	print STDERR "-  sig:  '$signature'\n" if $verbose;
	print STDERR "-- ret:  '$ret'\n" if $verbose;
	print STDERR "-- name: '$name'\n" if $verbose;
	print STDERR "-- 1arg: '$firstarg'\n" if $verbose;

	my $e = {
	    signature => "$name $args",
	    ret => $ret,
	    name => $name,
	    first => $firstarg,
	    docs => "",
	    subentries => [],
	};

	# some comments contain more than one @builtin, eg y2debug & al.
	# so we just hang them under the main one:
	if (! $entry)
	{
	    $entry = $e;
	}
	else
	{
	    push @{$entry->{subentries}}, $e;
	}
    }
    elsif ($entry)
    {
	# tidy the text up and append it to the current entry
	s/^ \s* \* \s*//x; #remove leading spaces and asterisk
	s/^$/<p>/;
	s/\@since\s(.*)/<p><b>Since:<\/b> $1/;
	s/\@example\s(.*)/Example:<pre>$1<\/pre>/;

	$entry->{docs} .= $_;
    }
}

# sort entries in two different ways
sub by_name_arg
{
    return $a->{name} cmp $b->{name} || $a->{first} cmp $b->{first};
}

sub by_arg_name
{
    return $a->{first} cmp $b->{first} || $a->{name} cmp $b->{name};
}

my $sorter = $sort_by_arg? \&by_arg_name: \&by_name_arg;

# print just the signature
sub PrintSignature ($)
{
    my $e = shift;
    (my $anchor = $e->{signature}) =~ s/\W+/_/g;
    print "<a name='$anchor'>$e->{signature}</a>";
    print " <font color='#606060'>-&gt;</font> ";
    print "<font color='#c05000'>$e->{ret}</font>";
}

foreach my $e (sort $sorter @entries)
{
    print STDERR "$e->{name}\n" if $verbose;

    # print the fancy frame etc...
    print "<p>\n";
    print "<table border=0 cellspacing=0 cellpadding=1 width='100%' bgcolor='#f96500'><tr><td>"
	. "<table border=0 cellspacing=0 cellpadding=3 width='100%' bgcolor='#ffc080'><tr><td>"
	. "<font size='+1'><tt><b>";
    PrintSignature ($e);
    foreach my $sube (@{$e->{subentries}})
    {
	print "<br>\n";
	PrintSignature ($sube);
    }
    print "</b></tt></font>"
	. "</td></tr></table>"
	. "</td></tr></table>\n";
    # print the description
    print "<p>\n";
    print $e->{docs};
    print "\n\n";
}
