#!/usr/bin/perl

## Copyright (c) 1998 Michael Zucchi, All Rights Reserved        ##
##                                                               ##
## This software falls under the GNU Public License. Please read ##
##              the COPYING file for more information            ##

## Poorly modified for Gaby documentation by Frederic Peters

#
# This will read a 'c' file and scan for embedded comments in the
# style of gnome comments (+minor extensions - see below).
#

# usage:
# gaby-doc C files > outputfile
#
#  C files - list of 'C' files to process
#
#  All output goes to stdout, with errors to stderr.

#
# format of comments.
# In the following table, (...)? signifies optional structure.
#                         (...)* signifies 0 or more structure elements
# /**
#  * function_name(:)? (- short description)?
# (* @parameterx: (description of parameter x)?)*
# (* a blank line)?
#  * (Description:)? (Description of function)?
#  * (section header: (section description)? )*
#  (*)?*/
#
# So .. the trivial example would be:
#
# /**
#  * my_function
#  **/
#
# If the Description: header tag is ommitted, then there must be a blank line
# after the last parameter specification.
# e.g.
# /**
#  * my_function - does my stuff
#  * @my_arg: its mine damnit
#  *
#  * Does my stuff explained. 
#  */
#
#  or, could also use:
# /**
#  * my_function - does my stuff
#  * @my_arg: its mine damnit
#  * Description: Does my stuff explained. 
#  */
# etc.
#
# All descriptions can be multiline, apart from the short function description.
#
# All descriptive text is further processed, scanning for the following special
# patterns, which are highlighted appropriately.
#
# 'funcname()' - function
# '$ENVVAR' - environmental variable
# '&struct_name' - name of a structure
# '@parameter' - name of a parameter
# '%CONST' - name of a constant.

# match expressions used to find embedded type information
$type_constant = "\\\%(\\w+)";
$type_func = "(\\w+\\(\\))";
$type_param = "\\\@(\\w+)";
$type_struct = "\\\&(\\w+)";
$type_env = "(\\\$\\w+)";


# Output conversion substitutions.
#  One for each output format

# sgml, docbook format
%highlights_sgml = ( $type_constant, "<replaceable class=\"option\">\$1</replaceable>",
		     $type_func, "<function>\$1</function>",
		     $type_struct, "<structname>\$1</structname>",
		     $type_env, "<envar>\$1</envar>",
		     $type_param, "<parameter>\$1</parameter>" );
$blankline_sgml = "</para><para>\n";

sub usage {
    print "Usage: $0 C file(s) > outputfile\n";
    exit 1;
}

# read arguments
if ($#ARGV==-1) {
    usage();
}

$verbose = 0;
$output_mode = "sgml";
%highlights = %highlights_sgml;
$blankline = $blankline_sgml;
$modulename = "Gaby Documentation";
$function_only = 0;
while ($ARGV[0] =~ m/^-(.*)/) {
    $cmd = shift @ARGV;
    $output_mode = "sgml";
    %highlights = %highlights_sgml;
    $blankline = $blankline_sgml;
}


# generate a sequence of code that will splice in highlighting information
# using the s// operator.
$dohighlight = "";
foreach $pattern (keys %highlights) {
#    print "scanning pattern $pattern ($highlights{$pattern})\n";
    $dohighlight .=  "\$contents =~ s:$pattern:$highlights{$pattern}:gs;\n";
}

##
# dumps section contents to arrays/hashes intended for that purpose.
#
sub dump_section {
    my $name = shift @_;
    my $contents = join "\n", @_;

    if ($name =~ m/$type_constant/) {
	$name = $1;
#	print STDERR "constant section '$1' = '$contents'\n";
	$constants{$name} = $contents;
    } elsif ($name =~ m/$type_param/) {
#	print STDERR "parameter def '$1' = '$contents'\n";
	$name = $1;
	$parameters{$name} = $contents;
    } else {
#	print STDERR "other section '$name' = '$contents'\n";
	$sections{$name} = $contents;
	push @sectionlist, $name;
    }
}

##
# output function
#
# parameters, a hash.
#  function => "function name"
#  parameterlist => @list of parameters
#  parameters => %parameter descriptions
#  sectionlist => @list of sections
#  sections => %descriont descriptions
#  

sub output_highlight {
    my $contents = join "\n", @_;
    my $line;

    eval $dohighlight;
    foreach $line (split "\n", $contents) {
	if ($line eq ""){
	    print $lineprefix, $blankline;
	} else {
	    print $lineprefix, $line;
	}
	print "\n";
    }
}

# output in sgml DocBook
sub output {
    my %args = %{$_[0]};
    my ($parameter, $section);
    my $count;
    my $id;

    $id = $args{'module'}."-".$args{'function'};
    $id =~ s/[^A-Za-z0-9]/-/g;

#    print "<refentry>\n";
#    print "<refmeta>\n";
#    print "<refentrytitle><phrase id=\"$id\">".$args{'function'}."</phrase></refentrytitle>\n";
#    print "</refmeta>\n";
#    print "<refnamediv>\n";
#    print " <refname>".$args{'function'}."</refname>\n";
#    print " <refpurpose>\n";
#    print "  ".$args{'purpose'}."\n";
#    print " </refpurpose>\n";
#    print "</refnamediv>\n";

    print "<simplesect><title><function>".$args{'function'}."</function></title>\n\n";
    print "<funcsynopsis>\n";
    print "<funcdef>".$args{'functiontype'}." ";
    print "<function>".$args{'function'}." ";
    print "</function></funcdef>\n";

    $count = 0;
    if ($#{$args{'parameterlist'}} >= 0) {
	foreach $parameter (@{$args{'parameterlist'}}) {
	    print "   <paramdef>".$args{'parametertypes'}{$parameter};
	    print " <parameter>$parameter</parameter></paramdef>\n";
	}
    } else {
	print "  <void>\n";
    }
    print "</funcsynopsis>\n";
#    print "</refsect1>\n";

    # print out each section
    $lineprefix="   ";
    foreach $section (@{$args{'sectionlist'}}) {
        print "\n<para>\n";
	if ($section =~ m/Returns/i) {
	    print "Returns: ";
	}
#	print "<refsect1>\n <title>$section</title>\n <para>\n";
#	print "<para>\n$section\n";
	if ($section =~ m/EXAMPLE/i) {
	    print "<example><para>\n";
	}
	output_highlight($args{'sections'}{$section});
#	print "</para>";
	if ($section =~ m/EXAMPLE/i) {
	    print "</para></example>\n";
	}
	print "\n</para>\n";
    }

    print "</simplesect>\n";
    
    # print parameters
#    print "<refsect1>\n <title>Arguments</title>\n";
#    print "<para>\nArguments\n";
#    if ($#{$args{'parameterlist'}} >= 0) {
#	print " <variablelist>\n";
#	foreach $parameter (@{$args{'parameterlist'}}) {
#	    print "  <varlistentry>\n   <term><parameter>$parameter</parameter></term>\n";
#	    print "   <listitem>\n    <para>\n";
#	    $lineprefix="     ";
#	    output_highlight($args{'parameters'}{$parameter});
#	    print "    </para>\n   </listitem>\n  </varlistentry>\n";
#	}
#	print " </variablelist>\n";
#   } else {
#	print " <para>\n  None\n </para>\n";
#    }
#    print "</refsect1>\n";


    print "\n\n";
}

##
# generic output function - calls the right one based
# on current output mode.
sub output_function {
#    output_html(@_);
    output(@_);
}


##
# takes a function prototype and spits out all the details
# stored in the global arrays/hsahes.
sub dump_function {
    my $prototype = shift @_;

    if ($prototype =~ m/^()([a-zA-Z0-9_~:]+)\s*\(([^\)]*)\)/ ||
	$prototype =~ m/^(\w+)\s+([a-zA-Z0-9_~:]+)\s*\(([^\)]*)\)/ ||
	$prototype =~ m/^(\w+\s*\*)\s*([a-zA-Z0-9_~:]+)\s*\(([^\)]*)\)/ ||
	$prototype =~ m/^(\w+\s+\w+)\s+([a-zA-Z0-9_~:]+)\s*\(([^\)]*)\)/ ||
	$prototype =~ m/^(\w+\s+\w+\s*\*)\s*([a-zA-Z0-9_~:]+)\s*\(([^\)]*)\)/)  {
	$return_type = $1;
	$function_name = $2;
	$args = $3;

#	print STDERR "ARGS = '$args'\n";

	foreach $arg (split ',', $args) {
	    # strip leading/trailing spaces
	    $arg =~ s/^\s*//;
	    $arg =~ s/\s*$//;
#	    print STDERR "SCAN ARG: '$arg'\n";
	    @args = split('\s', $arg);

#	    print STDERR " -> @args\n";
	    $param = pop @args;
#	    print STDERR " -> @args\n";
	    if ($param =~ m/^(\*+)(.*)/) {
		$param = $2;
		push @args, $1;
	    }
	    $type = join " ", @args;

	    if ($parameters{$param} eq "") {
		$parameters{$param} = "-- undescribed --";
		print STDERR "Warning($lineno): Function parameter '$param' not described in '$function_name'\n";
	    }

	    push @parameterlist, $param;
	    $parametertypes{$param} = $type;

#	    print STDERR "param = '$param', type = '$type'\n";
	}
    } else {
	print STDERR "Error($lineno): cannot understand prototype: '$prototype'\n";
	return;
    }

    if ($function_only==0 || defined($function_table{$function_name})) {
	output_function({'function' => $function_name,
			 'module' => $modulename,
			 'functiontype' => $return_type,
			 'parameterlist' => \@parameterlist,
			 'parameters' => \%parameters,
			 'parametertypes' => \%parametertypes,
			 'sectionlist' => \@sectionlist,
			 'sections' => \%sections,
			 'purpose' => $function_purpose
			 });
    }
}

######################################################################
# main
# states
# 0 - normal code
# 1 - looking for function name
# 2 - scanning field start.
# 3 - scanning prototype.
$state = 0;
$section = "";

$doc_special = "\@\%\$\&";

$doc_start = "^/\\*\\*\$";
$doc_end = "\\*/";
$doc_com = "\\s*\\*\\s*";
$doc_func = $doc_com."(\\w+):?";
$doc_sect = $doc_com."([".$doc_special."]?[\\w ]+):(.*)";
$doc_content = $doc_com."(.*)";

%constants = ();
%parameters = ();
@parameterlist = ();
%sections = ();
@sectionlist = ();

$contents = "";
$section_default = "Description";	# default section
$section = $section_default;

$lineno = 0;
foreach $file (@ARGV) {
    if (!open(IN,"<$file")) {
	print STDERR "Error: Cannot open file $file\n";
	next;
    }
    while (<IN>) {
	$lineno++;

	if ($state == 0) {
	    if (/$doc_start/o) {
		$state = 1;		# next line is always the function name
	    }
	} elsif ($state == 1) {	# this line is the function name (always)
	    if (/$doc_func/o) {
		$function = $1;
		$state = 2;
		if (/-(.*)/) {
		    $function_purpose = $1;
		} else {
		    $function_purpose = "";
		}
		if ($verbose) {
		    print STDERR "Info($lineno): Scanning doc for $function\n";
		}
	    } else {
		print STDERR "WARN($lineno): Cannot understand $_ on line $lineno",
		" - I thought it was a doc line\n";
		$state = 0;
	    }
	} elsif ($state == 2) {	# look for head: lines, and include content
	    if (/$doc_sect/o) {
		$newsection = $1;
		$newcontents = $2;

		if ($contents ne "") {
		    dump_section($section, $contents);
		    $section = $section_default;
		}

		$contents = $newcontents;
		if ($contents ne "") {
		    $contents .= "\n";
		}
		$section = $newsection;
	    } elsif (/$doc_end/) {

		if ($contents ne "") {
		    dump_section($section, $contents);
		    $section = $section_default;
		    $contents = "";
		}

#	    print STDERR "end of doc comment, looking for prototype\n";
		$prototype = "";
		$state = 3;
	    } elsif (/$doc_content/) {
		# miguel-style comment kludge, look for blank lines after
		# @parameter line to signify start of description
		if ($1 eq "" && $section =~ m/^@/) {
		    dump_section($section, $contents);
		    $section = $section_default;
		    $contents = "";
		} else {
		    $contents .= $1."\n";
		}
	    } else {
		# i dont know - bad line?  ignore.
		print STDERR "WARNING($lineno): bad line: $_"; 
	    }
	} elsif ($state == 3) {	# scanning for function { (end of prototype)
	    if (m#\s*/\*\s+MACDOC\s*#io) {
	      # do nothing
	    }
	    elsif (/([^\{]*)/) {
		$prototype .= $1;
	    }
	    if (/\{/) {
		$prototype =~ s@/\*.*?\*/@@gos;	# strip comments.
		$prototype =~ s@[\r\n]+@ @gos; # strip newlines/cr's.
		$prototype =~ s@^ +@@gos; # strip leading spaces
		dump_function($prototype);

		$function = "";
		%constants = ();
		%parameters = ();
		%parametertypes = ();
		@parameterlist = ();
		%sections = ();
		@sectionlist = ();
		$prototype = "";

		$state = 0;
	    }
	}
    }
}

