Updated TODO (Closes: #1006, #1008).

[mp_doccer.git] / mp_doccer

#!/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-dev';

use Getopt::Long;

# output format
my $format = 'html';

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

# documentation title
my $title = 'API';

# 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,
                '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
        -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.
        -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://www.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<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, "=");

        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;
}