eval '(exit $?0)' && eval 'exec perl -S "$0" ${1+"$@"}'
  & eval 'exec perl -S "$0" $argv:q'
    if 0;
# Generate documentation from source code.

## Copyright (c) 2002-2013 Simon Josefsson
##                    added -texinfo, -listfunc, -pkg-name
##                    man page revamp
##                    various improvements
## Copyright (c) 2001, 2002 Nikos Mavrogiannopoulos
##                    added -tex
## Copyright (c) 1998 Michael Zucchi

# 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 3 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, see <http://www.gnu.org/licenses/>.

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

# usage:
# gdoc [ -docbook | -html | -text | -man | -tex | -texinfo | -listfunc ]
#      [ -sourceversion verno ] [ -include file | -includefuncprefix ]
#      [ -bugsto address ] [ -pkg-name packagename ]
#      [ -seeinfo infonode ] [ -copyright notice ] [ -verbatimcopying ]
#      [ -function funcname [ -function funcname ...] ] c file(s)s > outputfile
#
#  Set output format using one of -docbook, -html, -text, -man, -tex,
#  -texinfo, or -listfunc.  Default is man.
#
#  -sourceversion
#       Version number for source code, e.g. '1.0.4'.  Used in 'man' headers.
#       Defaults to using current date.
#
#  -include FILE
#       For man pages, mention #include <FILE.h> in the synopsis.
#
#  -includefuncprefix
#       For man pages, mention a #include <FILE.h> in the synopsis.
#       The FILE derived from the function prefix.  For example, a
#       function gss_init_sec_context will generate an include
#       statement of #include <gss.h>.
#
#  -bugsto address
#       For man pages, include a section about reporting bugs and mention
#       the given e-mail address, e.g 'bug-libidn@gnu.org'.
#
#  -pkg-name packagename
#       For man pages when -bugsto is used, also include help URLs to the
#       the project's home page.  For example, "GNU Libidn".
#
#  -seeinfo infonode
#       For man pages, include a section that point to an info manual
#       for more information.
#
#  -copyright notice
#       For man pages, include a copyright section with the given
#       notice after a preamble.  Use, e.g., '2002, 2003 Simon Josefsson'.
#
#  -verbatimcopying
#       For man pages, and when the -copyright parameter is used,
#       add a licensing statement that say verbatim copying is permitted.
#
#  -function funcname
#	If set, then only generate documentation for the given function(s).  All
#	other functions are ignored.
#
#  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 omitted, 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 OBSOLETE (?)
# '#struct_name' - name of a structure
# '@parameter' - name of a parameter
# '%CONST' - name of a constant.

#
# Extensions for LaTeX:
#
# 1. the symbol '->' will be replaced with a rightarrow
# 2. x^y with ${x}^{y}$.
# 3. xxx\: with xxx:

use strict;
use warnings;

use Getopt::Long;
use Pod::Usage;

use POSIX qw(strftime);

# Global symbols.
my ($function_purpose, $lineprefix, $scanned_file) = ('', '', 'unknown');
my ($lineno, $section_default) = (0, 'Description');

# Symbols set by parser and used by rendering subroutines.
my %constants;
my %function_table;
my %parameters;
my %parametertypes;
my @parameterlist;
my %sections;
my @sectionlist;

# Variables used in options.
my ($function_only, $opt_dtd, $output_mode, $verbose) =
    (0, 0, undef, 0);
my ($bugsto, $copyright, $include, $includefuncprefix);
my ($modulename, $pkgname, $seeinfo, $sourceversion, $verbatimcopying);

# Matching expressions used to find embedded type information.
my $type_constant = '%(\w+)';
my $type_func	= '(\w+\(\))';
my $type_param	= '\B@(\w+|\.\.\.)';
my $type_addr	= '\b@\b';
my $type_struct	= '#(\w+)';
my $type_env	= '\$(\w+)';

# Output conversion substitutions.
#  One for each output format

my @known_modes = qw/ docbook html listfunc man sgml tex texinfo text /;

# these work fairly well
my %highlights_html = (
	$type_constant	=> '<i>$1</i>',
	$type_func	=> '<b>$1</b>',
	$type_struct	=> '<i>$1</i>',
	$type_param	=> '<tt><b>$1</b></tt>',
);

my %highlights_texinfo = (
	$type_addr	=> '@@',
	$type_constant	=> '@code{$1}',
	$type_env	=> '@env{$1}',
	$type_func	=> '@code{$1}',
	$type_param	=> '@var{$1}',
	$type_struct	=> '@code{$1}',
);

my %highlights_tex = (
	$type_constant	=> '{\\it $1}',
	$type_func	=> '{\\bf $1}',
	$type_struct	=> '{\\it $1}',
	$type_param	=> '{\\bf $1}',
);

# sgml, docbook format
my %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>',
);

# these are pretty rough
my %highlights_man = (
	$type_constant	=> '\\fB$1\\fP',
	$type_func	=> '\\fB$1\\fP',
	$type_struct	=> '\\fB$1\\fP',
	$type_param	=> '\\fI$1\\fP',
);

# text-mode
my %highlights_text = (
	$type_constant	=> '$1',
	$type_func	=> '$1',
	$type_struct	=> '$1',
	$type_param	=> '$1',
);

my %highlights_master = (
	docbook	=> \%highlights_sgml,
	html	=> \%highlights_html,
	man	=> \%highlights_man,
	sgml	=> \%highlights_sgml,
	tex	=> \%highlights_tex,
	texinfo	=> \%highlights_texinfo,
	text	=> \%highlights_text,
);

my %blankline = (
	docbook	=> '</para><para>',
	html	=> '</p><p>',
	man	=> '',
	sgml	=> '</para><para>',
	tex	=> '\newline',
	texinfo	=> '',
	text	=> '',
);

sub usage {
    print "Usage: $0 [ -v ] [ -docbook | -html | -text | -man | -tex | -texinfo  -listfunc ]\n";
    print "         [ -sourceversion verno ] [ -include file | -includefuncprefix ]\n";
    print "         [ -bugsto address ] [ -seeinfo infonode ] [ -copyright notice]\n";
    print "         [ -verbatimcopying ] [ -pkg-name packagename ]\n";
    print "         [ -function funcname [ -function funcname ...] ]\n";
    print "         c source file(s) > outputfile\n";
    exit 1;
}

$output_mode = "man";

my %highlights = %{$highlights_master{'man'}};
my $blankline = $blankline{'man'};

$modulename = "API Documentation";
$sourceversion = strftime "%Y-%m-%d", localtime;

##
# Option handling and helpers.
#
sub set_output_mode {
    my ($name, $mode) = @_;

    $mode = $name	if grep m/^$name$/, @known_modes;

    $mode = "sgml"	if $mode eq "docbook";

    # Pass the selected mode to state parameters.
    $output_mode = $mode;
    %highlights = %{$highlights_master{$output_mode}}
	if defined $highlights_master{$output_mode};
    $blankline = $blankline{$mode};
}

my %opts = ( # Output modes
	"docbook|sgml"	=> \&set_output_mode,
	"listfunc"	=> sub { $output_mode = "listfunc" },
	"html"		=> \&set_output_mode,
	"man"		=> \&set_output_mode,
	"mode=s"	=> \&set_output_mode,
	"tex"		=> \&set_output_mode,
	"texinfo"	=> \&set_output_mode,
	"text"		=> \&set_output_mode,
	# Parameter settings
	"bugsto=s"	=> \$bugsto,
	"copyright=s"	=> \$copyright,
	"dtd+"		=> \$opt_dtd,
	"function=s"	=> sub { $function_only = 1;
				 $function_table{$_[1]} = 1;
			       },
	"include=s"	=> \$include,
	"includefuncprefix+" => \$includefuncprefix,
	"module=s"	=> \$modulename,
	"pkg-name=s"	=> \$pkgname,
	"seeinfo=s"	=> \$seeinfo,
	"sourceversion=s" => \$sourceversion,
	"verbatimcopying+" => \$verbatimcopying,
	"verbose|v+"	=> \$verbose,
	# Help and usage.
	# Legacy response to '-h' was like the present '-usage'.
	"usage|h"	=> sub { pod2usage( -exitval => 0,
					    -verbose => 0 ) },
	"help|?"	=> sub { pod2usage( -exitval => 0,
					    -verbose => 1 ) },
    );

##
# 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
#  arraylength => %brackets of parameter
#  sectionlist => @list of sections
#  sections => %section descriptions
#  

sub repstr {
    my ($pattern, $repl, $match1, $match2, $match3, $match4) = @_;
    my ($output);

    $output = $repl;
    $output =~ s,\$1,$match1,g;
    $output =~ s,\$2,$match2,g;
    $output =~ s,\$3,$match3,g;
    $output =~ s,\$4,$match4,g;

    if ($verbose > 1) {
	print STDERR "Pattern $pattern matched with \$1='$match1' \$2='$match2' \$3='$match3' \$4='$match4'\n",
		"\tReplacement $repl produces $output\n";
    }

    return $output;
}

sub just_highlight {
    my $contents = join "\n", @_;
    my $ret = "";

    # Must begin with $type_param since all types insert '@' when
    # in texinfo mode. These insertions must not trigger new
    # replacements by $type_param.
    #
    # The ordering of hash keys cannot be guaranteed!

    my @patterns = grep { $_ ne $type_param; } keys %highlights;

    unshift @patterns, $type_param
	if defined $highlights{$type_param};

    foreach my $pattern (@patterns) {
	if ($verbose > 1) {
	    print "Scanning pattern $pattern -> $highlights{$pattern}\n";
	}

	$contents =~ s:$pattern:repstr($pattern, $highlights{$pattern}, $1, $2, $3, $4):gse;
    }

    foreach my $line (split "\n", $contents) {
	# Never add a blank line without previous content.
	next	if not $line and not $ret;

	if ($line eq ""){
	    $ret = $ret . $lineprefix . $blankline;
	} else {
	    $ret = $ret . $lineprefix . $line;
	}
	$ret = $ret . "\n";
    }

    return $ret;
}

sub output_highlight {
    print (just_highlight (@_));
}

# output in texinfo
sub output_texinfo {
    my %args = %{$_[0]};
    my $count;

    print "\@subheading ".$args{'function'}."\n";
    print "\@anchor{".$args{'function'}."}\n";
    print "\@deftypefun {" . $args{'functiontype'} . "} ";
    print "{".$args{'function'}."} ";
    print "(";
    $count = 0;

    foreach my $parameter (@{$args{'parameterlist'}}) {
	# Encapsulate parameter as non-breakable phrase.
	print '@w{';

	# Variadic arguments carry no type.
	print $args{'parametertypes'}{$parameter}, " "
	    if $args{'parametertypes'}{$parameter};

	print '@var{', $parameter, '}';
	print $args{'arraylength'}{$parameter}
	    if $args{'arraylength'}{$parameter};

	print '}';	# Close the protected phrase.

	if ($count != $#{$args{'parameterlist'}}) {
	    $count++;
	    print ", ";
	}
    }
    print ")\n";

    # Insert line breaks only between arguments, not after, not before.
    my $interbreak = 0;

    foreach my $parameter (@{$args{'parameterlist'}}) {
	print '@*'	if $interbreak;
	$interbreak++;

	if ($args{'parameters'}{$parameter}) {
	    print '@var{', $parameter, '}: ';

	    output_highlight($args{'parameters'}{$parameter});
	}
    }

    foreach my $section (@{$args{'sectionlist'}}) {
	print "\n\@strong{$section:} ";
	$args{'sections'}{$section} =~ s:([{}]):\@$1:gs;
	output_highlight($args{'sections'}{$section});
    }
    print "\@end deftypefun\n\n";
}

# output in html
sub output_html {
    my %args = %{$_[0]};
    my $count;

    print "\n", '<a name="', $args{'function'}, '">&nbsp;</a>', "\n",
	  '<h2>Function</h2>', "\n";

    print '<i>', $args{'functiontype'}, '</i> ';
    print "<b>".$args{'function'}."</b>\n";
    print "(";
    $count = 0;

    foreach my $parameter (@{$args{'parameterlist'}}) {
	# Variadic arguments carry no type.
	print '<i>', $args{'parametertypes'}{$parameter}, '</i> '
	    if $args{'parametertypes'}{$parameter};

	print '<b>', $parameter, '</b>';

	print $args{'arraylength'}{$parameter}
	    if $args{'arraylength'}{$parameter};

	if ($count != $#{$args{'parameterlist'}}) {
	    $count++;
	    print ",\n";
	}
    }
    print ")\n";

    print "<h3>Arguments</h3>\n";
    print "<dl>\n";

    if ($#{$args{'parameterlist'}} >= 0) {
	foreach my $parameter (@{$args{'parameterlist'}}) {
	    print '<dt>';
	    # Variadic arguments carry no type.
	    print "<i>" . $args{'parametertypes'}{$parameter} . "</i> "
		if $args{'parametertypes'}{$parameter};

	    print '<b>', $parameter, '</b>';

	    print $args{'arraylength'}{$parameter}
		if $args{'arraylength'}{$parameter};

	    print "</dt>\n<dd><p>";

	    output_highlight($args{'parameters'}{$parameter});
	    print "</p></dd>\n";
	}
    } else {
	print "<dt>None</dt>\n";
    }
    print "</dl>\n";

    foreach my $section (@{$args{'sectionlist'}}) {
	print "<h3>$section</h3>\n";
	print "<p>\n";

	# Escape all ampersands before displaying.
	my $text = just_highlight($args{'sections'}{$section});
	$text =~ s|&|\&amp;|g;
	print "$text";
	print "</p>\n";
    }
    print "<hr />\n";
}

# output in tex
sub output_tex {
    my %args = %{$_[0]};
    my ($count, $check, $type);
    my $func = $args{'function'};

    $func =~ s/_/\\_/g;

    print "\n", '\subsection*{', $func, "}\n",
	  '\label{', $args{'function'}, "}\n";

    $type = $args{'functiontype'};
    $type =~ s/_/\\_/g;

    print "{\\it ".$type."}\n";
    print "{\\bf ".$func."}\n";
    print "(";
    $count = 0;

    foreach my $parameter (@{$args{'parameterlist'}}) {
	my $param = $args{'parametertypes'}{$parameter};
	my $param2 = $parameter;
	my $param3 = $args{'arraylength'}{$parameter};

	$param =~ s/_/\\_/g;
	$param2 =~ s/_/\\_/g;
#	$param3 =~ s,([][]),\\$1,g;

	# Variadic arguments carry no type.
	print '{\it ', $param, '} '	if $param;

	print '{\bf ', $param2, '}';

	print '{\it ', $param3, '}'	if $param3;

	if ($count != $#{$args{'parameterlist'}}) {
	    $count++;
	    print ", ";
	}
    }
    print ")\n\n";

    print '\subsection*{Arguments}', "\n";

    print "\\begin{itemize}\n";
    $check=0;

    foreach my $parameter (@{$args{'parameterlist'}}) {
	my $param1 = $args{'parametertypes'}{$parameter};
	my $param2 = $parameter;
	my $param4 = $args{'arraylength'}{$parameter};

	$param1 =~ s/_/\\_/g;
	$param2 =~ s/_/\\_/g;
#	$param4 =~ s,([][]),\\$1,g;

	$check = 1;

	# Variadic arguments carry no type: insert a place holder.
	print '\item ',
	      $param1 ? '{\it ' . $param1 . '} ' : '',
	      '{\bf ', $param2, '}',
	      $param4 ? '{\it ' . $param4 . '}' : '',
	      '\hspace{0.3ex}:', "\n";	# Small space for readability.

	my $param3 = $args{'parameters'}{$parameter};
	$param3 =~ s/#([a-zA-Z\_]+)/{\\it $1}/g;

	my $out = just_highlight($param3);
	$out =~ s/_/\\_/g;
	print $out;
    }
    if ($check==0) {
	print "\\item void\n";
    }
    print "\\end{itemize}\n";

    foreach my $section (@{$args{'sectionlist'}}) {
	my $sec = $section;
	$sec =~ s/_/\\_/g;
	$sec =~ s/#([a-zA-Z\_]+)/{\\it $1}/g;

	print "\n", '\subsection*{', $sec, '}', "\n";
	print "\\begin{rmfamily}\n";

	$sec = $args{'sections'}{$section};
	$sec =~ s/\\:/:/g;
	$sec =~ s/#([a-zA-Z\_]+)/{\\it $1}/g;

	my $out = just_highlight($sec);
	$out =~ s/_/\\_/g;

	# Ampersands may appear in embedded code samples, and are
	# at the same time tokens in TeX source, so we escape them.
	$out =~ s/&/\\&/g;

	# The dollar sign starts math mode in TeX and must there-
	# fore be escaped.  Furthermore, the rewrite rules for
	# '->' and '#^#' must be delayed until that protection
	# is in place.
	$out =~ s/\$/\\\$/g;
	$out =~ s/->/\$\\rightarrow\$/g;
	$out =~ s/([0-9]+)\^([0-9]+)/\$\{$1\}\^\{$2\}\$/g;

	print $out;
	print "\\end{rmfamily}\n";
    }
    print '\pagebreak[2]', "\n";
}


# output in sgml DocBook
sub output_sgml {
    my %args = %{$_[0]};
    my $count;
    my $id;
    my $base_element = "refentry";

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

    if ($opt_dtd) {
	print '<!DOCTYPE ', $base_element, ' ',
	      'PUBLIC "-//OASIS/DTD DocBook XML V4.4//EN"',
	      "\n\t  ",
	      '"http://www.oasis-open.org/docbook/xml/4.4/docbookx.dtd">',
	      "\n";
	$opt_dtd = 0;	# Insert the DTD only once!
    }

    print "<!--\n\t Generated by gdoc from $scanned_file.\n-->\n";

    print "<refentry>\n";

    print "<refmeta>\n",
	  " <refentrytitle>\n",
	  "  <phrase id=\"$id\">", $args{'function'}, "</phrase>\n",
	  " </refentrytitle>\n",
	  " <manvolnum>3</manvolnum>\n",
	  " <refmiscinfo class=\"source\">", $args{'module'}, "</refmiscinfo>\n",
	  " <refmiscinfo class=\"version\">", $args{'sourceversion'}, "</refmiscinfo>\n",
	  "</refmeta>\n";

    print "<refnamediv>\n",
	  " <refname>", $args{'function'}, "</refname>\n",
	  " <refpurpose>",
	  $args{'purpose'} ? $args{'purpose'} : 'API Function',
	  "</refpurpose>\n",
	  "</refnamediv>\n";

    print "<refsynopsisdiv>\n",
	  " <title>Synopsis</title>\n";

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

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

    $count = 0;
    if ($#{$args{'parameterlist'}} >= 0) {
	foreach my $parameter (@{$args{'parameterlist'}}) {
	    print '   <paramdef>';

	    # A variadic parameter has no type.
	    print $args{'parametertypes'}{$parameter}, ' '
		if  $args{'parametertypes'}{$parameter};

	    print '<parameter>', $parameter, '</parameter>';

	    print $args{'arraylength'}{$parameter}
	        if $args{'arraylength'}{$parameter};

	    print '</paramdef>', "\n";
	}
    } else {
	print "   <void />\n";
    }

    print "  </funcprototype>\n",
	  " </funcsynopsis>\n";

    print "</refsynopsisdiv>\n";

#    print "</refsect1>\n";

    # print parameters
    print "<refsect1>\n <title>Arguments</title>\n";
#    print "<para>\nArguments\n";
    if ($#{$args{'parameterlist'}} >= 0) {
	print " <variablelist>\n";
	foreach my $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 out each section
    $lineprefix="   ";

    foreach my $section (@{$args{'sectionlist'}}) {
	print "<refsect1>\n <title>$section</title>\n <para>\n";
#	print "<para>\n$section\n";
	if ($section =~ m/EXAMPLE/i) {
	    print "<example><para>\n";
	}
	# Escape all ampersands.
	my $text = just_highlight($args{'sections'}{$section});
	$text =~ s|&|\&amp;|g;
	print "$text";
#	print "</para>";
	if ($section =~ m/EXAMPLE/i) {
	    print "</para></example>\n";
	}
	print " </para>\n</refsect1>\n";
    }

    print "</refentry>\n\n";
}

##
# output in man
sub output_man {
    my %args = %{$_[0]};
    my $count;

    print ".\\\" DO NOT MODIFY THIS FILE!  It was generated by gdoc.\n";
    print ".TH \"$args{'function'}\" 3 \"$args{'sourceversion'}\" \"". $args{'module'} . "\" \"". $args{'module'} . "\"\n";

    print ".SH NAME\n";

    print $args{'function'};
    if ($args{'purpose'}) {
	print " \\- " . $args{'purpose'} . "\n";
    } else {
	print " \\- API function\n";
    }

    print ".SH SYNOPSIS\n";
    print ".B #include <". $args{'include'} . ">\n"
	if $args{'include'};
    print ".B #include <". lc((split /_/, $args{'function'})[0]) . ".h>\n"
	if $args{'includefuncprefix'};
    print ".sp\n";
    print ".BI \"".$args{'functiontype'}." ".$args{'function'}."(";
    $count = 0;

    foreach my $parameter (@{$args{'parameterlist'}}) {
	print $args{'parametertypes'}{$parameter}, ' '
	    if $args{'parametertypes'}{$parameter};

	print '" ', $parameter, ' "';

	print $args{'arraylength'}{$parameter}
	    if $args{'arraylength'}{$parameter};

	if ($count != $#{$args{'parameterlist'}}) {
	    $count++;
	    print ", ";
	}
    }
    print ");\"\n";

    if (@{$args{'parameterlist'}}) {
	print ".SH ARGUMENTS\n";
	foreach my $parameter (@{$args{'parameterlist'}}) {
	    print '.IP "';

	    # Variadic arguments carry no type.
	    print $args{'parametertypes'}{$parameter}, ' '
		if $args{'parametertypes'}{$parameter};

	    print $parameter;

	    print $args{'arraylength'}{$parameter}
		if $args{'arraylength'}{$parameter};

	    print '" 12', "\n";

	    my $param = $args{'parameters'}{$parameter};
	    $param =~ s/-/\\-/g;

	    output_highlight($param);
	}
    }

    foreach my $section (@{$args{'sectionlist'}}) {
	my $sec = $args{'sections'}{$section};
	$sec =~ s/-/\\-/g;

	print '.SH "', uc($section), "\"\n";
	output_highlight($sec);
    }

    if ($args{'bugsto'}) {
	print ".SH \"REPORTING BUGS\"\n";
	print "Report bugs to <". $args{'bugsto'} . ">.\n";
	if ($args{'pkgname'}) {
	    print $args{'pkgname'} . " home page: " .
		"http://www.gnu.org/software/" . $args{'module'} . "/\n";
	}
	print "General help using GNU software: http://www.gnu.org/gethelp/\n";
    }

    if ($args{'copyright'}) {
	print ".SH COPYRIGHT\n";
	print "Copyright \\(co ". $args{'copyright'} . ".\n";
	if ($args{'verbatimcopying'}) {
	    print ".br\n";
	    print "Copying and distribution of this file, with or without modification,\n";
	    print "are permitted in any medium without royalty provided the copyright\n";
	    print "notice and this notice are preserved.\n";
	}
    }

    if ($args{'seeinfo'}) {
	print ".SH \"SEE ALSO\"\n";
	print "The full documentation for\n";
	print ".B " . $args{'module'} . "\n";
	print "is maintained as a Texinfo manual.  If the\n";
	print ".B info\n";
	print "and\n";
	print ".B " . $args{'module'} . "\n";
	print "programs are properly installed at your site, the command\n";
	print ".IP\n";
	print ".B info " . $args{'seeinfo'} . "\n";
	print ".PP\n";
	print "should give you access to the complete manual.\n";
    }
}

sub output_listfunc {
    my %args = %{$_[0]};
    print $args{'function'} . "\n";
}

##
# output in text
sub output_text {
    my %args = %{$_[0]};

    print "Function = ".$args{'function'}."\n";
    print "  return type: ".$args{'functiontype'}."\n\n";

    foreach my $parameter (@{$args{'parameterlist'}}) {
	# Variadic arguments carry no type.
	print ' ', $args{'parametertypes'}{$parameter}
	    if $args{'parametertypes'}{$parameter};

	print ' ', $parameter;

	print $args{'arraylength'}{$parameter}
	    if $args{'arraylength'}{$parameter};

	print "\n    -> ";

	output_highlight($args{'parameters'}{$parameter});
    }

    print "\n"	if scalar @{$args{'parameterlist'}};

    foreach my $section (@{$args{'sectionlist'}}) {
	print " $section:\n";

	# Minimal indentation inside section name.
	my $visual = just_highlight($args{'sections'}{$section});
	$visual =~ s|^(.+)|  $1|mg;

	#print '    ->';
	print $visual, "\n";
    }
}

##
# generic output function - calls the right one based
# on current output mode.
sub output_function {
    eval 'output_' . $output_mode . '(@_);';
}

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

    my ($return_type, $function_name);
    my %arraylength;

    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;
	my $args = $3;

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

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

	    # Ignore any isolated 'void'.
	    next	if ($arg eq 'void');

	    my @args = split('\s', $arg);

#	    print STDERR " -> @args\n";
	    my $param = pop @args;

	    # Push leading asterisques into the type list.
	    if ($param =~ m/^(\*+)(.*)/) {
		$param = $2;
		push @args, $1;
	    }

	    # Extract closing array lengths for separate bookkeeping.
	    if ($param =~ m/^(.*)(\[\d*\])$/) {
		$param = $1;
		$arraylength{$param} = $2;
	    }

#	    print STDERR " :> @args\n";
	    my $type = join " ", @args;

	    if ($param ne "void" and not $parameters{$param}) {
		$parameters{$param} = "-- undescribed --";
		print STDERR "Warning($scanned_file:", $lineno - 1, '): ',
			     'Function parameter "', $param, '" ',
			     'is not described by "', $docname, '".',
			     "\n"
		    if $output_mode ne 'listfunc';
	    }

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

#	    print STDERR "param = '$param', type = '$type'\n";
	}
    } else {
	print STDERR "Warning($scanned_file:", $lineno - 1, '): ',
		     'Cannot understand prototype: ',
		     "'$prototype'.\n";
	return;
    }

    print STDERR "Warning($scanned_file:", $lineno - 1, '): ',
		 'Defines "', $function_name, '"',
		 ', but "', $docname, '" was documented.', "\n"
	if $output_mode ne 'listfunc' and $docname ne $function_name;

    if ($function_only==0 || defined($function_table{$function_name})) {
	output_function({'function' => $function_name,
			 'module' => $modulename,
			 'sourceversion' => $sourceversion,
			 'include' => $include,
			 'includefuncprefix' => $includefuncprefix,
			 'bugsto' => $bugsto,
			 'pkgname' => $pkgname,
			 'copyright' => $copyright,
			 'verbatimcopying' => $verbatimcopying,
			 'seeinfo' => $seeinfo,
			 'functiontype' => $return_type,
			 'arraylength' => \%arraylength,
			 '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.

GetOptions(%opts)
    or pod2usage( -exitval => 1, -verbose => 0, -output => \*STDERR);

if ($output_mode eq '?' or $output_mode eq 'help') {
    print "@known_modes\n";
    exit 0;
}

if (not grep m/^$output_mode$/, @known_modes) {
    print STDERR 'Not a supported mode: ', "$output_mode\n",
		 'Available modes: ', "@known_modes\n";
    exit 1;
}

# read arguments
if ($#ARGV==-1) {
    pod2usage( -message => 'No file argument was specified.' . "\n",
	       -exitval => 1, -verbose => 0, -output => \*STDERR);
}

my $doc_start = "^/\\*\\*\$";
my $doc_end = "\\*/";
my $doc_com = "\\s*\\*\\s*";
my $doc_func = $doc_com."(\\w+):?";

# $doc_special = '@%$#';

# $doc_sect = $doc_com."([".$doc_special."[:upper:]][\\w ]+):\\s*(.*)";

# Sections commence with either of
#
#   \u\w\w+:
#   @\w+:
#   @\.\.\.:
#
# The latter is a variadic placeholder used in a parameter section.

my $doc_sect = $doc_com . '([@[:upper:]][\w ]+|@\.\.\.):\s*(.*)';

my $doc_content = $doc_com."(.*)";

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

foreach my $file (@ARGV) {
    my ($contents, $function, $prototype, $section) =
	('', '', '', $section_default);

    if (!open(IN, '<', $file)) {
	print STDERR "Error: Cannot open file $file\n";
	next;
    }

    $scanned_file = $file;
    $lineno = 0;

    my $state = 0;	# State of parser automata.

    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 (/-\s*(.*)/) {
		    $function_purpose = $1;
		} else {
		    $function_purpose = "";
		}
		if ($verbose) {
		    print STDERR "Info($scanned_file:$lineno): ",
				 "Scanning docs for func '$function'.\n";
		}
	    } else {
		print STDERR "Warning($scanned_file:$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) {
		my $newsection = $1;
		my $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($scanned_file:$lineno): ",
			     "Bad line: $_\n";
	    }
	} 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($function, $prototype);

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

		$state = 0;
	    }
	}
    }
}

__END__

=pod

=head1 NAME

gdoc - Generate documentation from source code.

=head1 SYNOPSIS

 gdoc { -docbook | -html | -listfunc | -sgml | -tex |
        -texinfo | -text | -mode MODE }
      [ -v | -verbose ] [ -dtd ]
      [ -function NAME [ -function NAME ...] ]
      [ -module NAME ] [ -sourceversion VERSION ]
      file ...  >  outputfile

 gdoc [ -v | -verbose ] [ -man ] [ -module NAME ]
      [ -include FILE | -includefuncprefix ]
      [ -seeinfo NODE ] [ -sourceversion VERSION ]
      [ -copyright TEXT ] [ -verbatimcopying ]
      [ -bugsto ADDRESS ] [ -pkg-name NAME ]
      [ -function NAME [ -function NAME ...] ]
      file ...  >  outputfile

 gdoc [ -h | --usage ] [ -? | --help ]

=head1 DESCRIPTION

Read one or more C source code files and scan for embedded comments
in the style of Gnome comments.
The output format can be set to a handful modes, but the default
is the standard Unix man page.

Package specific information can be inserted, and output may be
limited to a subset of the available function within a particular
set of files.

When multiple functions are being documented, the output text is a
simple concatenation of the text for each individual function.
This must be taken into account with the more complex output modes.

All expected output goes to F<stdout>, while errors go
to F<stderr>.

=head1 OPTIONS

An option name can be shortened at the end as long as it
remains unique, or if it is explicitly mentioned below.
A switch can be written with a single dash, or with double dashes,
both forms are valid.
Option taking arguments, can separate the switch from the argument
either with an equal sign, or just white space.

=over 8

=item B<-dtd>

Include a I<DTD> in Docbook mode.

=item B<-function> I<NAME>

If set, then generate documentation only for the given function.
Other functions are ignored.

Multiple use is allowed, thus making extraction of function
subsets feasible, at least by scripting.

=item B<-module> I<NAME>

Provide a name for this software module.
The default is I<API Documentation>.

=item B<-sourceversion> I<STRING>

Version number of source code, e.g. '1.0.4'.
This is put in the man page header, defaulting
to the current date when not made explicit.

=item B<-v>, B<-verbose>

Print some internal messages for tracking.

=back

The next few options are output mode selectors.

=over 8

=item B<-docbook>, B<-sgml>

Two synonyms for Docbook formatted output, producing one
I<refentry> block for each selected function.
Some tweeking may be needed in corner cases.

=item B<-html>

A fragment containing the full function description.
Editing is recommended for use with multiple functions.

=item B<-listfunc>

A pseudo format intended as a tool:
On separate lines, the names of each function being documented
in each source file, are listed.

=item B<-man>

Produce a man page.
This is the default format when no selection is indicated at all.

=item B<-mode> I<MODE>

Select any mode among the explicit alternatives described here.
When I<MODE> is either of '?' or "help", the supported modes
are printed in a simple listing.

=item B<-tex>

Output is written in the typesetting language LaTeX.

=item B<-texinfo>

The Texinfo format of the GNU Project.

=item B<-text>

Plain text formatting.

=back

Finally, a set of options relevant in man page mode only.

=over 8

=item B<-bugsto> I<ADDRESS>

Include a section about bug reporting and mention
the given e-mail address as the desired recipient, e.g,
'help-shishi@gnu.org'.

=item B<-copyright> I<TEXT>

Add a copyright section with the stated text inserted
after a standard preamble.
A typical notice could be '2003 Barac Uda'.

=item B<-include> I<FILE>

Mention C<#include E<lt>FILE.hE<gt>> within the synopsis.

=item B<-includefuncprefix>

Mention an include directive of F<FILE.h> in the synopsis.
Now I<FILE> is derived from the function prefix.
As an example, a function I<gss_init_sec_context> will generate
an include statement C<#include E<lt>gss.hE<gt>>.

=item B<-pkg-name> I<NAME>

As a refinement when also B<-bugsto> is in use, include a URL
to the the project's home page, and prepend I<NAME>.
As an example, "GNU Shishi".

=item B<-seeinfo> I<INFO-NODE>

Include, in the man page, a section that points to
a Tex info manual at I<INFO-NODE> for further information.

=item B<-verbatimcopying>

Used in addition to B<-copyright>, a licensing statement is added,
stating that I<verbatim copying> is a permitted use of the
formatted text.

=back

=head1 FORMATTING OF COMMENTS

The comments in source code must obey a preset structure
in order to be detected by B<gdoc>.
Their elements are somewhat tersely conveyed here.

A comment block commences with C</**> and ends with C<**/>,
or with the normal C<*/> as is standard in B<C> source.
The following template displays all elements, and will be
complemented by examples in the next section.

In the following template, the notation C<(...)?> denotes
an optional construct (to be placed in the ellipse).
In contrast, C<(...)*> denotes a construct present zero
or more times.
Both are standard notions in most kinds of regular expressions.

   /**
    * function_name(:)? (- short description)?
   (* @parameterx: (description of parameter x)?)*
   (* a blank line)?
    * (Description:)? (Description of function)?
    * (Section header: (section description)? )*
    (*)?*/

Descriptions are allowed to be multiline, the only exception
being the I<short description>.

In addition to separating the comment into functional parts,
the descriptive text is processed further by a scanner,
which is looking for the following special patterns.

   funcname()    -- name of a function,
   #struct_name  -- name of a structure,
   @parameter    -- name of a parameter,
   %CONST        -- name of a constant,
   $ENVVAR       -- environmental variable (OBSOLETE!).

The lexical tokens thus identified are then highlighted
as is appropriate for the chosen output mode.

=head1 EXAMPLE OF COMMENTS

The minimal comment is obvious:

   /**
    * my_function
    **/

A more useful form names one argument and a description:

   /**
    * my_function - does my stuff
    * @my_arg: it is mine for sure
    * Description: My stuff explained.
    */

Should the header tag I<Description:> be omitted, then a blank
line is mandatory after the last parameter specification:

   /**
    * my_function - does my stuff
    * @my_arg: it is still mine
    *
    * My stuff explained.
    */

=head1 CAVEATS

Most of the output modes produce a usable and conformant document
for a single function only, since multiple functions lead to simple
concatenation of the individual documents.

=head1 AUTHORS

Michael Zucchi wrote the first implementation.
Nikos Mavrogiannopoulos added the LaTex mode.
Simon Josefsson added Tex info mode, I<listfunc> mode,
and improved the man page formatter.
Mats Erik Andersson wrote POD and went bug hunting.

=head1 COPYRIGHT

Copyright (c) 1998 Michael Zucchi
              2001, 2002 Nikos Mavrogiannopoulos
              2002-2013 Simon Josefsson

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 3 of the License, or
(at your option) any later version.

=cut
