#!/usr/bin/perl

#
# mp_doccer - Documentation generator
#
# Copyright (C) 2001/2008      Angel Ortega <angel@triptico.com>
#
# 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.
#
# http://www.triptico.com/software/mp_doccer.html
#

use strict;
use warnings;

$main::VERSION = '1.2.2';

use Getopt::Long;

# output format
my $format = 'html';

# output file or directory
my $output = '';

# documentation title
my $title = 'API';

# documentation abstract
my $abstract = '';

# man section
my $man_section = '3';

# function (and variable) documentation database
my @functions = ();

# function categories
my %categories = ();

# the style sheet
my $css = '';

# prefix for generated files
my $file_prefix = '';

# author's name and email
my $author = '';

# quiet flag
my $quiet = 0;

# show version
my $version = 0;

# show usage
my $usage = 0;

# parse options
if (!GetOptions('f|format=s'		=>	\$format,
		'o|output=s'		=>	\$output,
		'c|css=s'		=>	\$css,
		't|title=s'		=>	\$title,
		'v|version'		=>	\$version,
		'p|prefix=s'		=>	\$file_prefix,
		'm|man-section=s'	=>	\$man_section,
		'a|author=s'		=>	\$author,
		'b|abstract=s'		=>	\$abstract,
		'q|quiet'		=>	\$quiet,
		'h|help'		=>	\$usage)
	      or $usage) {
	usage();
}

if ($version) {
	print "$main::VERSION\n";
	exit(0);
}

# list of source code files
my @sources = sort(@ARGV) or usage();

extract_doc(@sources);

# create
if ($format eq 'html') {
	format_html();
}
elsif ($format eq 'man') {
	format_man();
}
elsif ($format eq 'localhelp') {
	format_sh();
}
elsif ($format eq 'html1') {
	format_html_1();
}
elsif ($format eq 'grutatxt') {
	format_grutatxt();
}
else {
	print "Invalid output format '$format'\n";
	print "Valid ones are: html man localhelp html1 grutatxt\n";
}


# ###################################################################


sub extract_doc
# extract the documentation from the source code files
{
	my (@sources) = @_;
	my %func_idx;

	foreach my $f (@sources) {
		unless (open F, $f) {
			warn "Can't open $_";
			next;
		}

		# $f=$1 if $f =~ /\/([^\/]*)$/;

		print("Processing $f...\n");

		while (<F>) {
			my ($fname, $bdesc, @arg, @argdesc, $desc,
			    $syn, $altsyn, $uniq, @category);

			chop;

			unless (/^\s*\/\*\*$/) {
				next;
			}

			chop($_ = <F>) or last;

			# extract function name and brief description
			($fname, $bdesc) = /([\w_\.]*) - (.*)/;

			# possible arguments
			for (;;) {
				chop($_ = <F>) or goto eof;

				unless (/^\s+\*\s+\@([^:]*):\s+(.*)/) {
					last;
				}

				push(@arg, $1);
				push(@argdesc, $2);
			}

			if (/^\s+\*\//) {
				goto skipdesc;
			}

			# rest of lines until */ are the description
			for (;;) {
				chop($_ = <F>) or goto eof;
				last if /^\s+\*\//;

				# a line with only [text] is a category
				if (/^\s+\*\s+\[(.*)\]$/) {
					my $sec = $1;

					my $s = $categories{$sec};

					unless (grep /^$fname$/, @$s) {
						push(@$s, $fname);
						$categories{$sec} = $s;
					}

					push(@category, $sec);

					next;
				}

				/^\s+\*\s*(.*)$/;
				$desc .= $1 . "\n";
			}

			skipdesc:

			# rest of info until a { or ; is the synopsis
			for (;;) {
				chop($_ = <F>) or goto eof;

				if (/^\s*\/\*\*(.*)\*\//) {
					$altsyn .= $1 . "\n";
				}
				elsif (/^([^{;]*)[{;]/) {
					$syn .= $1 . "\n";
					last;
				}
				elsif (/^\s\/\*\*$/) {
					last;
				}
				else {
					$syn .= $_ . "\n";
				}
			}

			# fix synopsis to have a trailing ;
			$syn =~ s/^(\s*)//;
			$syn =~ s/(\s*)$//;
			$syn .= ";";

			# delete (posible) leading 'sub'
			$syn =~ s/^\s*sub\s+//;

			# calculate a unique name
			# (to avoid collisions in file names)
			if ($func_idx{$fname}) {
				$uniq = $fname . $func_idx{$fname}++;
			}
			else {
				$uniq = $fname;
				$func_idx{$fname} = 1;
			}

			my $func = {};

			# store
			$func->{'file'} = $f;
			$func->{'func'} = $fname;
			$func->{'bdesc'} = $bdesc;
			$func->{'desc'} = $desc;
			$func->{'syn'} = $syn;
			$func->{'uniq'} = $uniq;

			if (@arg) {
				$func->{'arg'} = \@arg;
			}

			if (@argdesc) {
				$func->{'argdesc'} = \@argdesc;
			}

			if ($altsyn) {
				$func->{'altsyn'} = $altsyn;
			}

			if (@category) {
				$func->{'category'} = \@category;
			}

			push(@functions, $func);
		}

		eof:

		close F;
	}

	# iterate now the functions, creating the 'prev' and 'next' fields
	my $prev = undef;
	foreach my $f (sort { $a->{'func'} cmp $b->{'func'} } @functions) {
		if ($prev) {
			$prev->{'next'} = $f->{'func'};
			$f->{'prev'} = $prev->{'func'};
		}

		$prev = $f;
	}
}


sub usage
{
	print << "EOF";
mp_doccer $main::VERSION - C Source Code Documentation Generator
Copyright (C) 2001/2008 Angel Ortega <angel\@triptico.com>
This software is covered by the GPL license. NO WARRANTY.

Usage: mp_doccer [options] c_code_files...

Options:

	-o|--output=dest	Directory or file where the
				documentation is generated.
	-t|--title="title"	Title for the documentation.
	-c|--css="css URL"	URL to a Cascade Style Sheet
				to include in all HTML files.
	-f|--format="format"	Format for the generated
				documentation.
				Valid ones are:
				html man localhelp html1 grutatxt
	-p|--prefix="prefix"	Prefix for the name of the
				generated files. Main index
				file will also have this name.
	-a|--author="author"	Sets author info (as name and email)
				to be included in the documentation.
	-b|--abstract="text"	Abstract for the documentation.
	-m|--man-section="sect" Section number for the generated
				man pages.
	-v|--version		Shows version.
	-q|--quiet		Suppress 'built with...' info.
	-h|--help		This help.

The mp_doccer Home Page:
http://triptico.com/software/mp_doccer.html

EOF
	exit(0);
}


#######################################################

sub format_sh
# create a help shell script
{
	my ($o, $h);

	unless ($output) {
		$output = 'localhelp.sh';
	}

	open F, ">$output" or die "Error: $!";

	# build the header

	print F "#!/bin/sh\n\n";
	printf F "# Help program generated by mp_doccer $main::VERSION on %s\n",scalar(localtime());
	print F "# mp_doccer is part of the Minimum Profit Text Editor\n";
	print F "# http://www.triptico.com/software/mp.html\n\n";

	print F "case \"\$1\" in\n";

	for (my $n = 0; $n < scalar(@functions); $n++) {
		my ($f,$syn);

		$f = $functions[$n];

		print F "$f->{'func'})\n";

		print F "cat << EOF\n";

		print F "$title\n\n";

		print F "NAME\n\n";
		print F "$f->{'func'} - $f->{'bdesc'}\n\n";

		print F "SYNOPSIS\n\n";

		$syn = defined($f->{'altsyn'}) ? $f->{'altsyn'} : $f->{'syn'};
		$syn =~ s/\@([\w]+)/$1/g;
		$syn =~ s/\%([\w]+)/$1/g;

		chomp($syn);
		print F "$syn\n\n";

		if ($f->{'arg'}) {
			my ($a, $d);

			$a = $f->{'arg'};
			$d = $f->{'argdesc'};

			print F "ARGUMENTS\n\n";

			for (my $n = 0; $n < scalar(@$a); $n++) {
				print F "$$a[$n] - $$d[$n]\n";
			}

			print F "\n";
		}

		if ($f->{'desc'}) {
			print F "DESCRIPTION\n\n";

			my ($desc) = $f->{'desc'};
			$desc =~ s/\@([\w]+)/$1/g;
			$desc =~ s/\%([\w]+)/$1/g;

			print F "$desc\n";

			if ($f->{'category'}) {
				my $s = $f->{'category'};

				print F "CATEGORIES\n\n";

				for (my $n = 0; $n < scalar(@$s); $n++) {
					print F ", " if $n;
					print F "$$s[$n]";
				}

				print F "\n";
			}
		}

		if ($author) {
			print F "AUTHOR\n\n";
			print F "$author\n";
		}

		print F "EOF\n";
		print F "\t;;\n";
	}

	print F "\"\")\n";
	print F "\techo \"Usage: \$0 {keyword}\"\n";
	print F "\t;;\n";

	print F "*)\n";
	print F "\techo \"No help for \$1\"\n";
	print F "\texit 1";
	print F "\t;;\n";

	print F "esac\n";
	print F "exit 0\n";

	close F;

	chmod 0755, $output;
}


sub format_man
# create man pages
{
	my ($o, $h);
	my ($pf);

	unless ($output) {
		$output = '.';
	}

	$output =~ s/\/$//;

	unless (-d $output) {
		print "$output must be a directory; aborting\n";
		exit(1);
	}

	if ($file_prefix) {
		$pf = $file_prefix . '_';
	}

	for(my $n = 0; $n < scalar(@functions); $n++) {
		my ($f, $syn);

		$f = $functions[$n];

		# write the file
		open F, ">$output/${pf}$f->{'func'}.$man_section" or die "Error: $!";

		print F ".TH $f->{'func'} $man_section \"\" \"$title\"\n";
		print F ".SH NAME\n";
		print F "$f->{'func'} \\- $f->{'bdesc'}\n";
		print F ".SH SYNOPSIS\n";
		print F ".nf\n";

		$syn = defined($f->{'altsyn'}) ? $f->{'altsyn'} : $f->{'syn'};
		print F ".B $syn\n";
		print F ".fi\n";

		if ($f->{'arg'}) {
			my ($a, $d);

			$a = $f->{'arg'};
			$d = $f->{'argdesc'};

			print F ".SH ARGUMENTS\n";

			for (my $n = 0; $n < scalar(@$a); $n++) {
				print F ".B $$a[$n] \\-\n";
				print F "$$d[$n]\n";
				print F ".sp\n";
			}
		}

		if ($f->{'desc'}) {
			print F ".SH DESCRIPTION\n";

			# take the description
			my ($desc) = $f->{'desc'};
			$desc =~ s/\@//g;
			$desc =~ s/\%//g;

			chomp($desc);
			print F "$desc\n";

			if ($f->{'category'}) {
				my ($s) = $f->{'category'};

				print F ".SH CATEGORIES\n";

				for (my $n = 0; $n < scalar(@$s); $n++) {
					print F ", " if $n;
					print F "$$s[$n]";
				}

				print F "\n";
			}
		}

		if ($author) {
			print F ".SH AUTHOR\n";
			print F "$author\n";
		}

		close F;
	}
}


# HTML

sub html_header
{
	my $title = shift;
	my $ret = '';

	$ret .= "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.0 Transitional//EN\"\n";
	$ret .= "\"http://www.w3.org/TR/REC-html40/loose.dtd\">\n";
	$ret .= "<head><title>$title</title>\n";
	$ret .= "<link rel = 'StyleSheet' href = '$css' type = 'text/css'>\n" if $css;
	$ret .= "<meta name = 'generator' content = 'mp_doccer $main::VERSION'>\n";
	$ret .= "<meta name = 'date' content = '" . scalar(localtime()) . "'>\n";
	$ret .= "<meta name = 'author' content = '$author'>\n" if $author;
	$ret .= "</head>\n<body>\n";

	return $ret;
}


sub html_footer
{
	my $ret = "<div class = 'footer'>\n";

	if ($author) {
		$ret .= "<span class = 'author'>$author</span>";
	}

	if (!$quiet) {
		$ret .= " - <em class = 'built_with'>Built with <a href = 'http://www.triptico.com/software/mp_doccer.html'>mp_doccer $main::VERSION</a></em>";
	}

	$ret .= "\n</div>\n</body>\n</html>\n";

	return $ret;
}


sub html_toc
{
	my $func_link = shift;
	my $ret = '';

	$ret .= "<a name = '_TOP_'></a><h1>$title</h1>\n";

	$ret .= "<p>$abstract</p>\n" if $abstract;

	$ret .= "<div class = 'toc'>\n";

	if (scalar(keys(%categories))) {
		$ret .= "<h2>By Category</h2>\n";

		foreach my $sn (sort keys %categories) {
			$ret .= "<a name = '$sn'></a>\n";
			$ret .= "<h3 class = 'category'>$sn</h3>\n";

			$ret .= "<ul class = 'by_category'>\n";

			$ret .= join('',
				map { "  <li><a href = '" . $func_link->($_) . "'>$_</a></li>\n" }
					sort(@{$categories{$sn}})
				);

			$ret .= "</ul>\n";
		}
	}

	$ret .= "<h2>By Source</h2>\n";

	foreach my $s (@sources) {
		my @f = grep { $_->{'file'} eq $s } @functions;

		unless (@f) {
			next;
		}

		$ret .= "<h3 class = 'source_file'>$s</h3>\n";

		$ret .= "<ul class = 'by_source'>\n";

		$ret .= join('',
			map { "  <li><a href = '" . $func_link->($_) . "'>$_</a></li>\n" }
				sort(map { $_->{'func'} } @f)
			);

		$ret .= "</ul>\n";
	}

	$ret .= "<h2>Alphabetical</h2>\n";
	$ret .= "<ul class = 'alphabetical'>\n";

	foreach my $f (sort { $a->{'func'} cmp $b->{'func'} } @functions) {
		$ret .= "  <li><a href = '" . $func_link->($f->{'func'}) .
			"'>$f->{'func'}</a> - $f->{'bdesc'}</li>\n";
	}

	$ret .= "</ul></div>\n";

	return $ret;
}


sub html_func
{
	my $f = shift;
	my $ret = '';
	my $syn;

	$ret .= "\n<div class = 'func' style = 'margin-left: 1em;'>\n";

	$ret .= "<h3>Name</h3>\n";
	$ret .= "<strong class = 'funcname'>$f->{'func'}</strong> - $f->{'bdesc'}\n";

	$ret .= "<h3>Synopsis</h3>\n";

	$syn = defined($f->{'altsyn'}) ? $f->{'altsyn'} : $f->{'syn'};

	# synopsis decoration
	$syn =~ s/\b$f->{'func'}\b/\<strong class = 'funcname'>$f->{'func'}\<\/strong>/g;

	$syn =~ s/@([\w]+)/<em class = 'funcarg'>$1<\/em>/g;
	$syn =~ s/\%([\w]+)/<em class = 'funcret'>$1<\/em>/g;

	if ($f->{'arg'}) {
		foreach my $a (@{$f->{'arg'}}) {
			$syn =~ s/\b$a\b/\<em class = 'funcarg'>$a\<\/em>/g;
		}
	}

	$ret .= "<pre class = 'funcsyn'>\n$syn</pre>\n";

	if ($f->{'arg'}) {
		my @a = @{$f->{'arg'}};
		my @d = @{$f->{'argdesc'}};

		$ret .= "<h3>Arguments</h3>\n";
		$ret .= "<dl class = 'arguments'>\n";

		while (@a) {
			$ret .= "  <dt><em class = 'funcarg'>" . shift(@a) . "</em></dt>";
			$ret .= "<dd>" . shift(@d) . "</dd>\n";
		}

		$ret .= "</dl>\n";
	}

	if ($f->{'desc'}) {
		$ret .= "<h3>Description</h3>\n";

		# take the description
		my ($desc) = $f->{'desc'};

		# decorate function names
		$desc =~ s/([\w_]+\(\))/<code class = 'funcname'>$1<\/code>/g;

		# decorate function arguments
		$desc =~ s/@([\w_]+)/<em class = 'funcarg'>$1<\/em>/g;

		# decorate return values
		$desc =~ s/\%([\w_]+)/<em class = 'funcret'>$1<\/em>/g;

		# replace blank lines
		$desc =~ s/\n\n/\n<p>\n/gs;

		$ret .= "<p class = 'description'>$desc</p>\n";

		if ($f->{category}) {
			$ret .= "<h3>Categories</h3>\n";

			$ret .= "<ul class = 'categories'>\n" .
				join('', map { "  <li><a href = '#$_'>$_</a></li>\n" } @{$f->{'category'}}) .
				"</ul>\n";
		}
	}

	$ret .= "</div>\n";
}


sub format_html_1
# create 1 html page
{
	my (%f);

	if ($file_prefix) {
		$file_prefix = '_' . $file_prefix;
	}

	# create the file
	my $fn = $output . $file_prefix . '.html';

	open F, ">$fn" or die "Error create $fn: $!";

	print F html_header($title);

	print F html_toc( sub { "#" . shift } );

	# the functions themselves
	foreach my $f (sort { $a->{'func'} cmp $b->{'func'} } @functions) {
		# avoid duplicate function names
		if ($f{$f->{'func'}}) {
			next;
		}

		$f{$f->{'func'}}++;

		print F "\n<div class = 'func_container'>\n";
		print F "<a name = '$f->{'func'}'></a>\n";
		print F "<h2 style = 'border-bottom: solid 2px;'>$f->{'func'}</h2>\n";

		print F html_func($f);

		print F "</div>\n";
	}

	print F html_footer();

	close F;
}


sub format_html
# create multipage html documents
{
	$output = "." unless $output;
	$output =~ s/\/$//;

	unless (-d $output) {
		print "$output must be a directory; aborting\n";
		exit(1);
	}

	my $pf = $file_prefix ? $file_prefix . '_' : '';

	# create the table of contents
	my $top = $file_prefix || 'index';

	open TOC, ">$output/${top}.html"
		or die "Error: $!";

	print TOC html_header($title);

	print TOC html_toc( sub { $pf . shift() . ".html" } );

	print TOC html_footer();

	close TOC;

	# the functions themselves
	foreach my $f (sort { $a->{'func'} cmp $b->{'func'} } @functions) {
		# write the file
		open F, ">$output/" . $pf . "$f->{'func'}.html"
			or die "Error: $!";

		print F html_header($f->{'func'});

		print F "<div class = 'topnav'>\n";

		print F '  ', $f->{'prev'} ? "<a href = '${pf}$f->{'prev'}.html'>Prev</a>" : "Prev",
			" |\n",
			"  <a href = '${top}.html'><b>$title</b></a>",
			" |\n",
			'  ', $f->{'next'} ? "<a href = '${pf}$f->{'next'}.html'>Next</a>" : "Next",
			"\n";

		print F "</div>\n";

		print F "<h2 style = 'border-bottom: solid 2px;'>$f->{'func'}</h2>\n";

		print F html_func($f);

		print F html_footer();

		close F;
	}
}


sub _grutatxt_header
{
	my $t = shift;
	my $m = shift;

	my $s = $t;
	$s =~ s/./$m/g;

	return $t . "\n" . $s . "\n\n";
}


sub _gl
{
	my $s = shift;

	$s = lc($s);
	$s =~ s/\s/_/g;

	return $s;
}


sub format_grutatxt
# create a grutatxt document
{
	my (%f);

	if ($file_prefix) {
		$file_prefix = '_' . $file_prefix;
	}

	# create the file
	my $fn = $output . $file_prefix . '.txt';

	open F, ">$fn" or die "Error create $fn: $!";

	print F _grutatxt_header($title, "=");

	print F "$abstract\n\n" if $abstract;

	if (scalar(keys(%categories))) {

		print F _grutatxt_header('By Category', '-');

		foreach my $sn (sort keys %categories) {

			print F _grutatxt_header($sn, '~');

			print F join("\n",
				map { ' * ./#' . _gl($_) . ' (' . $_ . ')' }
					sort(@{$categories{$sn}})
				);

			print F "\n\n";
		}
	}

	print F _grutatxt_header('By Source', '-');

	foreach my $s (@sources) {
		my @f = grep { $_->{'file'} eq $s } @functions;

		unless (@f) {
			next;
		}

		print F _grutatxt_header($s, '~');

		print F join("\n",
			map { ' * ./#' . _gl($_) . ' (' . $_ . ')' }
				sort(map { $_->{'func'} } @f)
			);

		print F "\n\n";
	}

	print F _grutatxt_header('Alphabetical', '-');

	foreach my $f (sort { $a->{'func'} cmp $b->{'func'} } @functions) {
		print F ' * ./#',
			_gl($f->{'func'}),
			' (',
			$f->{func},
			') - ',
			$f->{bdesc},
			"\n";
	}

	print F "\n\n";

	# the functions themselves
	foreach my $f (sort { $a->{'func'} cmp $b->{'func'} } @functions) {
		# avoid duplicate function names
		if ($f{$f->{'func'}}) {
			next;
		}

		$f{$f->{'func'}}++;

		print F _grutatxt_header($f->{func}, '-');

		print F _grutatxt_header('Name', '~');

		print F '*' . $f->{func} . '* - ' . $f->{bdesc} . "\n";

		print F "\n";

		print F _grutatxt_header('Synopsis', '~');

		my $syn = $f->{'altsyn'} || (' ' . $f->{'syn'});

		# strip arg and return value marks
		$syn =~ s/[@%]([\w]+)/$1/g;

		print F $syn . "\n\n";

		if ($f->{'arg'}) {
			my @a = @{$f->{'arg'}};
			my @d = @{$f->{'argdesc'}};

			print F _grutatxt_header('Arguments', '~');

			while (@a) {
				print F ' * ' . shift(@a) . ': ' . shift(@d) . "\n";
			}

			print F "\n";
		}

		if ($f->{'desc'}) {
			print F _grutatxt_header('Description', '~');

			# take the description
			my $desc = $f->{'desc'};

			# decorate function arguments
			$desc =~ s/@([\w_]+)/_$1_/g;

			# decorate return values
			$desc =~ s/\%([\w_]+)/_$1_/g;

			print F $desc, "\n";

			if ($f->{category}) {
				print F _grutatxt_header('Categories', '~');

				print F join("\n",
					map { ' * ./#' . _gl($_) . ' (' . $_ . ')' }
						@{$f->{'category'}});

				print F "\n";
			}
		}

		print F "\n";
	}

	if ($author) {
		print F "----\n$author ";
	}

	if (!$quiet) {
		print F "- Built with http://triptico.com/software/mp_doccer.html (mp_doccer $main::VERSION)";
	}

	print F "\n";
	close F;
}
