"Fossies" - the Fresh Open Source Software Archive

Member "mp_doccer-1.2.2/mp_doccer" (4 Dec 2008, 18481 Bytes) of package /linux/privat/old/mp_doccer-1.2.2.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file.

    1 #!/usr/bin/perl
    2 
    3 #
    4 # mp_doccer - Documentation generator
    5 #
    6 # Copyright (C) 2001/2008      Angel Ortega <angel@triptico.com>
    7 #
    8 # This program is free software; you can redistribute it and/or modify
    9 # it under the terms of the GNU General Public License as published by
   10 # the Free Software Foundation; either version 2 of the License, or
   11 # (at your option) any later version.
   12 #
   13 # This program is distributed in the hope that it will be useful,
   14 # but WITHOUT ANY WARRANTY; without even the implied warranty of
   15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   16 # GNU General Public License for more details.
   17 #
   18 # You should have received a copy of the GNU General Public License
   19 # along with this program; if not, write to the Free Software
   20 # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
   21 #
   22 # http://www.triptico.com/software/mp_doccer.html
   23 #
   24 
   25 use strict;
   26 use warnings;
   27 
   28 $main::VERSION = '1.2.2';
   29 
   30 use Getopt::Long;
   31 
   32 # output format
   33 my $format = 'html';
   34 
   35 # output file or directory
   36 my $output = '';
   37 
   38 # documentation title
   39 my $title = 'API';
   40 
   41 # documentation abstract
   42 my $abstract = '';
   43 
   44 # man section
   45 my $man_section = '3';
   46 
   47 # function (and variable) documentation database
   48 my @functions = ();
   49 
   50 # function categories
   51 my %categories = ();
   52 
   53 # the style sheet
   54 my $css = '';
   55 
   56 # prefix for generated files
   57 my $file_prefix = '';
   58 
   59 # author's name and email
   60 my $author = '';
   61 
   62 # quiet flag
   63 my $quiet = 0;
   64 
   65 # show version
   66 my $version = 0;
   67 
   68 # show usage
   69 my $usage = 0;
   70 
   71 # parse options
   72 if (!GetOptions('f|format=s'        =>  \$format,
   73         'o|output=s'        =>  \$output,
   74         'c|css=s'       =>  \$css,
   75         't|title=s'     =>  \$title,
   76         'v|version'     =>  \$version,
   77         'p|prefix=s'        =>  \$file_prefix,
   78         'm|man-section=s'   =>  \$man_section,
   79         'a|author=s'        =>  \$author,
   80         'b|abstract=s'      =>  \$abstract,
   81         'q|quiet'       =>  \$quiet,
   82         'h|help'        =>  \$usage)
   83           or $usage) {
   84     usage();
   85 }
   86 
   87 if ($version) {
   88     print "$main::VERSION\n";
   89     exit(0);
   90 }
   91 
   92 # list of source code files
   93 my @sources = sort(@ARGV) or usage();
   94 
   95 extract_doc(@sources);
   96 
   97 # create
   98 if ($format eq 'html') {
   99     format_html();
  100 }
  101 elsif ($format eq 'man') {
  102     format_man();
  103 }
  104 elsif ($format eq 'localhelp') {
  105     format_sh();
  106 }
  107 elsif ($format eq 'html1') {
  108     format_html_1();
  109 }
  110 elsif ($format eq 'grutatxt') {
  111     format_grutatxt();
  112 }
  113 else {
  114     print "Invalid output format '$format'\n";
  115     print "Valid ones are: html man localhelp html1 grutatxt\n";
  116 }
  117 
  118 
  119 # ###################################################################
  120 
  121 
  122 sub extract_doc
  123 # extract the documentation from the source code files
  124 {
  125     my (@sources) = @_;
  126     my %func_idx;
  127 
  128     foreach my $f (@sources) {
  129         unless (open F, $f) {
  130             warn "Can't open $_";
  131             next;
  132         }
  133 
  134         # $f=$1 if $f =~ /\/([^\/]*)$/;
  135 
  136         print("Processing $f...\n");
  137 
  138         while (<F>) {
  139             my ($fname, $bdesc, @arg, @argdesc, $desc,
  140                 $syn, $altsyn, $uniq, @category);
  141 
  142             chop;
  143 
  144             unless (/^\s*\/\*\*$/) {
  145                 next;
  146             }
  147 
  148             chop($_ = <F>) or last;
  149 
  150             # extract function name and brief description
  151             ($fname, $bdesc) = /([\w_\.]*) - (.*)/;
  152 
  153             # possible arguments
  154             for (;;) {
  155                 chop($_ = <F>) or goto eof;
  156 
  157                 unless (/^\s+\*\s+\@([^:]*):\s+(.*)/) {
  158                     last;
  159                 }
  160 
  161                 push(@arg, $1);
  162                 push(@argdesc, $2);
  163             }
  164 
  165             if (/^\s+\*\//) {
  166                 goto skipdesc;
  167             }
  168 
  169             # rest of lines until */ are the description
  170             for (;;) {
  171                 chop($_ = <F>) or goto eof;
  172                 last if /^\s+\*\//;
  173 
  174                 # a line with only [text] is a category
  175                 if (/^\s+\*\s+\[(.*)\]$/) {
  176                     my $sec = $1;
  177 
  178                     my $s = $categories{$sec};
  179 
  180                     unless (grep /^$fname$/, @$s) {
  181                         push(@$s, $fname);
  182                         $categories{$sec} = $s;
  183                     }
  184 
  185                     push(@category, $sec);
  186 
  187                     next;
  188                 }
  189 
  190                 /^\s+\*\s*(.*)$/;
  191                 $desc .= $1 . "\n";
  192             }
  193 
  194             skipdesc:
  195 
  196             # rest of info until a { or ; is the synopsis
  197             for (;;) {
  198                 chop($_ = <F>) or goto eof;
  199 
  200                 if (/^\s*\/\*\*(.*)\*\//) {
  201                     $altsyn .= $1 . "\n";
  202                 }
  203                 elsif (/^([^{;]*)[{;]/) {
  204                     $syn .= $1 . "\n";
  205                     last;
  206                 }
  207                 elsif (/^\s\/\*\*$/) {
  208                     last;
  209                 }
  210                 else {
  211                     $syn .= $_ . "\n";
  212                 }
  213             }
  214 
  215             # fix synopsis to have a trailing ;
  216             $syn =~ s/^(\s*)//;
  217             $syn =~ s/(\s*)$//;
  218             $syn .= ";";
  219 
  220             # delete (posible) leading 'sub'
  221             $syn =~ s/^\s*sub\s+//;
  222 
  223             # calculate a unique name
  224             # (to avoid collisions in file names)
  225             if ($func_idx{$fname}) {
  226                 $uniq = $fname . $func_idx{$fname}++;
  227             }
  228             else {
  229                 $uniq = $fname;
  230                 $func_idx{$fname} = 1;
  231             }
  232 
  233             my $func = {};
  234 
  235             # store
  236             $func->{'file'} = $f;
  237             $func->{'func'} = $fname;
  238             $func->{'bdesc'} = $bdesc;
  239             $func->{'desc'} = $desc;
  240             $func->{'syn'} = $syn;
  241             $func->{'uniq'} = $uniq;
  242 
  243             if (@arg) {
  244                 $func->{'arg'} = \@arg;
  245             }
  246 
  247             if (@argdesc) {
  248                 $func->{'argdesc'} = \@argdesc;
  249             }
  250 
  251             if ($altsyn) {
  252                 $func->{'altsyn'} = $altsyn;
  253             }
  254 
  255             if (@category) {
  256                 $func->{'category'} = \@category;
  257             }
  258 
  259             push(@functions, $func);
  260         }
  261 
  262         eof:
  263 
  264         close F;
  265     }
  266 
  267     # iterate now the functions, creating the 'prev' and 'next' fields
  268     my $prev = undef;
  269     foreach my $f (sort { $a->{'func'} cmp $b->{'func'} } @functions) {
  270         if ($prev) {
  271             $prev->{'next'} = $f->{'func'};
  272             $f->{'prev'} = $prev->{'func'};
  273         }
  274 
  275         $prev = $f;
  276     }
  277 }
  278 
  279 
  280 sub usage
  281 {
  282     print << "EOF";
  283 mp_doccer $main::VERSION - C Source Code Documentation Generator
  284 Copyright (C) 2001/2008 Angel Ortega <angel\@triptico.com>
  285 This software is covered by the GPL license. NO WARRANTY.
  286 
  287 Usage: mp_doccer [options] c_code_files...
  288 
  289 Options:
  290 
  291     -o|--output=dest    Directory or file where the
  292                 documentation is generated.
  293     -t|--title="title"  Title for the documentation.
  294     -c|--css="css URL"  URL to a Cascade Style Sheet
  295                 to include in all HTML files.
  296     -f|--format="format"    Format for the generated
  297                 documentation.
  298                 Valid ones are:
  299                 html man localhelp html1 grutatxt
  300     -p|--prefix="prefix"    Prefix for the name of the
  301                 generated files. Main index
  302                 file will also have this name.
  303     -a|--author="author"    Sets author info (as name and email)
  304                 to be included in the documentation.
  305     -b|--abstract="text"    Abstract for the documentation.
  306     -m|--man-section="sect" Section number for the generated
  307                 man pages.
  308     -v|--version        Shows version.
  309     -q|--quiet      Suppress 'built with...' info.
  310     -h|--help       This help.
  311 
  312 The mp_doccer Home Page:
  313 http://triptico.com/software/mp_doccer.html
  314 
  315 EOF
  316     exit(0);
  317 }
  318 
  319 
  320 #######################################################
  321 
  322 sub format_sh
  323 # create a help shell script
  324 {
  325     my ($o, $h);
  326 
  327     unless ($output) {
  328         $output = 'localhelp.sh';
  329     }
  330 
  331     open F, ">$output" or die "Error: $!";
  332 
  333     # build the header
  334 
  335     print F "#!/bin/sh\n\n";
  336     printf F "# Help program generated by mp_doccer $main::VERSION on %s\n",scalar(localtime());
  337     print F "# mp_doccer is part of the Minimum Profit Text Editor\n";
  338     print F "# http://www.triptico.com/software/mp.html\n\n";
  339 
  340     print F "case \"\$1\" in\n";
  341 
  342     for (my $n = 0; $n < scalar(@functions); $n++) {
  343         my ($f,$syn);
  344 
  345         $f = $functions[$n];
  346 
  347         print F "$f->{'func'})\n";
  348 
  349         print F "cat << EOF\n";
  350 
  351         print F "$title\n\n";
  352 
  353         print F "NAME\n\n";
  354         print F "$f->{'func'} - $f->{'bdesc'}\n\n";
  355 
  356         print F "SYNOPSIS\n\n";
  357 
  358         $syn = defined($f->{'altsyn'}) ? $f->{'altsyn'} : $f->{'syn'};
  359         $syn =~ s/\@([\w]+)/$1/g;
  360         $syn =~ s/\%([\w]+)/$1/g;
  361 
  362         chomp($syn);
  363         print F "$syn\n\n";
  364 
  365         if ($f->{'arg'}) {
  366             my ($a, $d);
  367 
  368             $a = $f->{'arg'};
  369             $d = $f->{'argdesc'};
  370 
  371             print F "ARGUMENTS\n\n";
  372 
  373             for (my $n = 0; $n < scalar(@$a); $n++) {
  374                 print F "$$a[$n] - $$d[$n]\n";
  375             }
  376 
  377             print F "\n";
  378         }
  379 
  380         if ($f->{'desc'}) {
  381             print F "DESCRIPTION\n\n";
  382 
  383             my ($desc) = $f->{'desc'};
  384             $desc =~ s/\@([\w]+)/$1/g;
  385             $desc =~ s/\%([\w]+)/$1/g;
  386 
  387             print F "$desc\n";
  388 
  389             if ($f->{'category'}) {
  390                 my $s = $f->{'category'};
  391 
  392                 print F "CATEGORIES\n\n";
  393 
  394                 for (my $n = 0; $n < scalar(@$s); $n++) {
  395                     print F ", " if $n;
  396                     print F "$$s[$n]";
  397                 }
  398 
  399                 print F "\n";
  400             }
  401         }
  402 
  403         if ($author) {
  404             print F "AUTHOR\n\n";
  405             print F "$author\n";
  406         }
  407 
  408         print F "EOF\n";
  409         print F "\t;;\n";
  410     }
  411 
  412     print F "\"\")\n";
  413     print F "\techo \"Usage: \$0 {keyword}\"\n";
  414     print F "\t;;\n";
  415 
  416     print F "*)\n";
  417     print F "\techo \"No help for \$1\"\n";
  418     print F "\texit 1";
  419     print F "\t;;\n";
  420 
  421     print F "esac\n";
  422     print F "exit 0\n";
  423 
  424     close F;
  425 
  426     chmod 0755, $output;
  427 }
  428 
  429 
  430 sub format_man
  431 # create man pages
  432 {
  433     my ($o, $h);
  434     my ($pf);
  435 
  436     unless ($output) {
  437         $output = '.';
  438     }
  439 
  440     $output =~ s/\/$//;
  441 
  442     unless (-d $output) {
  443         print "$output must be a directory; aborting\n";
  444         exit(1);
  445     }
  446 
  447     if ($file_prefix) {
  448         $pf = $file_prefix . '_';
  449     }
  450 
  451     for(my $n = 0; $n < scalar(@functions); $n++) {
  452         my ($f, $syn);
  453 
  454         $f = $functions[$n];
  455 
  456         # write the file
  457         open F, ">$output/${pf}$f->{'func'}.$man_section" or die "Error: $!";
  458 
  459         print F ".TH $f->{'func'} $man_section \"\" \"$title\"\n";
  460         print F ".SH NAME\n";
  461         print F "$f->{'func'} \\- $f->{'bdesc'}\n";
  462         print F ".SH SYNOPSIS\n";
  463         print F ".nf\n";
  464 
  465         $syn = defined($f->{'altsyn'}) ? $f->{'altsyn'} : $f->{'syn'};
  466         print F ".B $syn\n";
  467         print F ".fi\n";
  468 
  469         if ($f->{'arg'}) {
  470             my ($a, $d);
  471 
  472             $a = $f->{'arg'};
  473             $d = $f->{'argdesc'};
  474 
  475             print F ".SH ARGUMENTS\n";
  476 
  477             for (my $n = 0; $n < scalar(@$a); $n++) {
  478                 print F ".B $$a[$n] \\-\n";
  479                 print F "$$d[$n]\n";
  480                 print F ".sp\n";
  481             }
  482         }
  483 
  484         if ($f->{'desc'}) {
  485             print F ".SH DESCRIPTION\n";
  486 
  487             # take the description
  488             my ($desc) = $f->{'desc'};
  489             $desc =~ s/\@//g;
  490             $desc =~ s/\%//g;
  491 
  492             chomp($desc);
  493             print F "$desc\n";
  494 
  495             if ($f->{'category'}) {
  496                 my ($s) = $f->{'category'};
  497 
  498                 print F ".SH CATEGORIES\n";
  499 
  500                 for (my $n = 0; $n < scalar(@$s); $n++) {
  501                     print F ", " if $n;
  502                     print F "$$s[$n]";
  503                 }
  504 
  505                 print F "\n";
  506             }
  507         }
  508 
  509         if ($author) {
  510             print F ".SH AUTHOR\n";
  511             print F "$author\n";
  512         }
  513 
  514         close F;
  515     }
  516 }
  517 
  518 
  519 # HTML
  520 
  521 sub html_header
  522 {
  523     my $title = shift;
  524     my $ret = '';
  525 
  526     $ret .= "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.0 Transitional//EN\"\n";
  527     $ret .= "\"http://www.w3.org/TR/REC-html40/loose.dtd\">\n";
  528     $ret .= "<head><title>$title</title>\n";
  529     $ret .= "<link rel = 'StyleSheet' href = '$css' type = 'text/css'>\n" if $css;
  530     $ret .= "<meta name = 'generator' content = 'mp_doccer $main::VERSION'>\n";
  531     $ret .= "<meta name = 'date' content = '" . scalar(localtime()) . "'>\n";
  532     $ret .= "<meta name = 'author' content = '$author'>\n" if $author;
  533     $ret .= "</head>\n<body>\n";
  534 
  535     return $ret;
  536 }
  537 
  538 
  539 sub html_footer
  540 {
  541     my $ret = "<div class = 'footer'>\n";
  542 
  543     if ($author) {
  544         $ret .= "<span class = 'author'>$author</span>";
  545     }
  546 
  547     if (!$quiet) {
  548         $ret .= " - <em class = 'built_with'>Built with <a href = 'http://www.triptico.com/software/mp_doccer.html'>mp_doccer $main::VERSION</a></em>";
  549     }
  550 
  551     $ret .= "\n</div>\n</body>\n</html>\n";
  552 
  553     return $ret;
  554 }
  555 
  556 
  557 sub html_toc
  558 {
  559     my $func_link = shift;
  560     my $ret = '';
  561 
  562     $ret .= "<a name = '_TOP_'></a><h1>$title</h1>\n";
  563 
  564     $ret .= "<p>$abstract</p>\n" if $abstract;
  565 
  566     $ret .= "<div class = 'toc'>\n";
  567 
  568     if (scalar(keys(%categories))) {
  569         $ret .= "<h2>By Category</h2>\n";
  570 
  571         foreach my $sn (sort keys %categories) {
  572             $ret .= "<a name = '$sn'></a>\n";
  573             $ret .= "<h3 class = 'category'>$sn</h3>\n";
  574 
  575             $ret .= "<ul class = 'by_category'>\n";
  576 
  577             $ret .= join('',
  578                 map { "  <li><a href = '" . $func_link->($_) . "'>$_</a></li>\n" }
  579                     sort(@{$categories{$sn}})
  580                 );
  581 
  582             $ret .= "</ul>\n";
  583         }
  584     }
  585 
  586     $ret .= "<h2>By Source</h2>\n";
  587 
  588     foreach my $s (@sources) {
  589         my @f = grep { $_->{'file'} eq $s } @functions;
  590 
  591         unless (@f) {
  592             next;
  593         }
  594 
  595         $ret .= "<h3 class = 'source_file'>$s</h3>\n";
  596 
  597         $ret .= "<ul class = 'by_source'>\n";
  598 
  599         $ret .= join('',
  600             map { "  <li><a href = '" . $func_link->($_) . "'>$_</a></li>\n" }
  601                 sort(map { $_->{'func'} } @f)
  602             );
  603 
  604         $ret .= "</ul>\n";
  605     }
  606 
  607     $ret .= "<h2>Alphabetical</h2>\n";
  608     $ret .= "<ul class = 'alphabetical'>\n";
  609 
  610     foreach my $f (sort { $a->{'func'} cmp $b->{'func'} } @functions) {
  611         $ret .= "  <li><a href = '" . $func_link->($f->{'func'}) .
  612             "'>$f->{'func'}</a> - $f->{'bdesc'}</li>\n";
  613     }
  614 
  615     $ret .= "</ul></div>\n";
  616 
  617     return $ret;
  618 }
  619 
  620 
  621 sub html_func
  622 {
  623     my $f = shift;
  624     my $ret = '';
  625     my $syn;
  626 
  627     $ret .= "\n<div class = 'func' style = 'margin-left: 1em;'>\n";
  628 
  629     $ret .= "<h3>Name</h3>\n";
  630     $ret .= "<strong class = 'funcname'>$f->{'func'}</strong> - $f->{'bdesc'}\n";
  631 
  632     $ret .= "<h3>Synopsis</h3>\n";
  633 
  634     $syn = defined($f->{'altsyn'}) ? $f->{'altsyn'} : $f->{'syn'};
  635 
  636     # synopsis decoration
  637     $syn =~ s/\b$f->{'func'}\b/\<strong class = 'funcname'>$f->{'func'}\<\/strong>/g;
  638 
  639     $syn =~ s/@([\w]+)/<em class = 'funcarg'>$1<\/em>/g;
  640     $syn =~ s/\%([\w]+)/<em class = 'funcret'>$1<\/em>/g;
  641 
  642     if ($f->{'arg'}) {
  643         foreach my $a (@{$f->{'arg'}}) {
  644             $syn =~ s/\b$a\b/\<em class = 'funcarg'>$a\<\/em>/g;
  645         }
  646     }
  647 
  648     $ret .= "<pre class = 'funcsyn'>\n$syn</pre>\n";
  649 
  650     if ($f->{'arg'}) {
  651         my @a = @{$f->{'arg'}};
  652         my @d = @{$f->{'argdesc'}};
  653 
  654         $ret .= "<h3>Arguments</h3>\n";
  655         $ret .= "<dl class = 'arguments'>\n";
  656 
  657         while (@a) {
  658             $ret .= "  <dt><em class = 'funcarg'>" . shift(@a) . "</em></dt>";
  659             $ret .= "<dd>" . shift(@d) . "</dd>\n";
  660         }
  661 
  662         $ret .= "</dl>\n";
  663     }
  664 
  665     if ($f->{'desc'}) {
  666         $ret .= "<h3>Description</h3>\n";
  667 
  668         # take the description
  669         my ($desc) = $f->{'desc'};
  670 
  671         # decorate function names
  672         $desc =~ s/([\w_]+\(\))/<code class = 'funcname'>$1<\/code>/g;
  673 
  674         # decorate function arguments
  675         $desc =~ s/@([\w_]+)/<em class = 'funcarg'>$1<\/em>/g;
  676 
  677         # decorate return values
  678         $desc =~ s/\%([\w_]+)/<em class = 'funcret'>$1<\/em>/g;
  679 
  680         # replace blank lines
  681         $desc =~ s/\n\n/\n<p>\n/gs;
  682 
  683         $ret .= "<p class = 'description'>$desc</p>\n";
  684 
  685         if ($f->{category}) {
  686             $ret .= "<h3>Categories</h3>\n";
  687 
  688             $ret .= "<ul class = 'categories'>\n" .
  689                 join('', map { "  <li><a href = '#$_'>$_</a></li>\n" } @{$f->{'category'}}) .
  690                 "</ul>\n";
  691         }
  692     }
  693 
  694     $ret .= "</div>\n";
  695 }
  696 
  697 
  698 sub format_html_1
  699 # create 1 html page
  700 {
  701     my (%f);
  702 
  703     if ($file_prefix) {
  704         $file_prefix = '_' . $file_prefix;
  705     }
  706 
  707     # create the file
  708     my $fn = $output . $file_prefix . '.html';
  709 
  710     open F, ">$fn" or die "Error create $fn: $!";
  711 
  712     print F html_header($title);
  713 
  714     print F html_toc( sub { "#" . shift } );
  715 
  716     # the functions themselves
  717     foreach my $f (sort { $a->{'func'} cmp $b->{'func'} } @functions) {
  718         # avoid duplicate function names
  719         if ($f{$f->{'func'}}) {
  720             next;
  721         }
  722 
  723         $f{$f->{'func'}}++;
  724 
  725         print F "\n<div class = 'func_container'>\n";
  726         print F "<a name = '$f->{'func'}'></a>\n";
  727         print F "<h2 style = 'border-bottom: solid 2px;'>$f->{'func'}</h2>\n";
  728 
  729         print F html_func($f);
  730 
  731         print F "</div>\n";
  732     }
  733 
  734     print F html_footer();
  735 
  736     close F;
  737 }
  738 
  739 
  740 sub format_html
  741 # create multipage html documents
  742 {
  743     $output = "." unless $output;
  744     $output =~ s/\/$//;
  745 
  746     unless (-d $output) {
  747         print "$output must be a directory; aborting\n";
  748         exit(1);
  749     }
  750 
  751     my $pf = $file_prefix ? $file_prefix . '_' : '';
  752 
  753     # create the table of contents
  754     my $top = $file_prefix || 'index';
  755 
  756     open TOC, ">$output/${top}.html"
  757         or die "Error: $!";
  758 
  759     print TOC html_header($title);
  760 
  761     print TOC html_toc( sub { $pf . shift() . ".html" } );
  762 
  763     print TOC html_footer();
  764 
  765     close TOC;
  766 
  767     # the functions themselves
  768     foreach my $f (sort { $a->{'func'} cmp $b->{'func'} } @functions) {
  769         # write the file
  770         open F, ">$output/" . $pf . "$f->{'func'}.html"
  771             or die "Error: $!";
  772 
  773         print F html_header($f->{'func'});
  774 
  775         print F "<div class = 'topnav'>\n";
  776 
  777         print F '  ', $f->{'prev'} ? "<a href = '${pf}$f->{'prev'}.html'>Prev</a>" : "Prev",
  778             " |\n",
  779             "  <a href = '${top}.html'><b>$title</b></a>",
  780             " |\n",
  781             '  ', $f->{'next'} ? "<a href = '${pf}$f->{'next'}.html'>Next</a>" : "Next",
  782             "\n";
  783 
  784         print F "</div>\n";
  785 
  786         print F "<h2 style = 'border-bottom: solid 2px;'>$f->{'func'}</h2>\n";
  787 
  788         print F html_func($f);
  789 
  790         print F html_footer();
  791 
  792         close F;
  793     }
  794 }
  795 
  796 
  797 sub _grutatxt_header
  798 {
  799     my $t = shift;
  800     my $m = shift;
  801 
  802     my $s = $t;
  803     $s =~ s/./$m/g;
  804 
  805     return $t . "\n" . $s . "\n\n";
  806 }
  807 
  808 
  809 sub _gl
  810 {
  811     my $s = shift;
  812 
  813     $s = lc($s);
  814     $s =~ s/\s/_/g;
  815 
  816     return $s;
  817 }
  818 
  819 
  820 sub format_grutatxt
  821 # create a grutatxt document
  822 {
  823     my (%f);
  824 
  825     if ($file_prefix) {
  826         $file_prefix = '_' . $file_prefix;
  827     }
  828 
  829     # create the file
  830     my $fn = $output . $file_prefix . '.txt';
  831 
  832     open F, ">$fn" or die "Error create $fn: $!";
  833 
  834     print F _grutatxt_header($title, "=");
  835 
  836     print F "$abstract\n\n" if $abstract;
  837 
  838     if (scalar(keys(%categories))) {
  839 
  840         print F _grutatxt_header('By Category', '-');
  841 
  842         foreach my $sn (sort keys %categories) {
  843 
  844             print F _grutatxt_header($sn, '~');
  845 
  846             print F join("\n",
  847                 map { ' * ./#' . _gl($_) . ' (' . $_ . ')' }
  848                     sort(@{$categories{$sn}})
  849                 );
  850 
  851             print F "\n\n";
  852         }
  853     }
  854 
  855     print F _grutatxt_header('By Source', '-');
  856 
  857     foreach my $s (@sources) {
  858         my @f = grep { $_->{'file'} eq $s } @functions;
  859 
  860         unless (@f) {
  861             next;
  862         }
  863 
  864         print F _grutatxt_header($s, '~');
  865 
  866         print F join("\n",
  867             map { ' * ./#' . _gl($_) . ' (' . $_ . ')' }
  868                 sort(map { $_->{'func'} } @f)
  869             );
  870 
  871         print F "\n\n";
  872     }
  873 
  874     print F _grutatxt_header('Alphabetical', '-');
  875 
  876     foreach my $f (sort { $a->{'func'} cmp $b->{'func'} } @functions) {
  877         print F ' * ./#',
  878             _gl($f->{'func'}),
  879             ' (',
  880             $f->{func},
  881             ') - ',
  882             $f->{bdesc},
  883             "\n";
  884     }
  885 
  886     print F "\n\n";
  887 
  888     # the functions themselves
  889     foreach my $f (sort { $a->{'func'} cmp $b->{'func'} } @functions) {
  890         # avoid duplicate function names
  891         if ($f{$f->{'func'}}) {
  892             next;
  893         }
  894 
  895         $f{$f->{'func'}}++;
  896 
  897         print F _grutatxt_header($f->{func}, '-');
  898 
  899         print F _grutatxt_header('Name', '~');
  900 
  901         print F '*' . $f->{func} . '* - ' . $f->{bdesc} . "\n";
  902 
  903         print F "\n";
  904 
  905         print F _grutatxt_header('Synopsis', '~');
  906 
  907         my $syn = $f->{'altsyn'} || (' ' . $f->{'syn'});
  908 
  909         # strip arg and return value marks
  910         $syn =~ s/[@%]([\w]+)/$1/g;
  911 
  912         print F $syn . "\n\n";
  913 
  914         if ($f->{'arg'}) {
  915             my @a = @{$f->{'arg'}};
  916             my @d = @{$f->{'argdesc'}};
  917 
  918             print F _grutatxt_header('Arguments', '~');
  919 
  920             while (@a) {
  921                 print F ' * ' . shift(@a) . ': ' . shift(@d) . "\n";
  922             }
  923 
  924             print F "\n";
  925         }
  926 
  927         if ($f->{'desc'}) {
  928             print F _grutatxt_header('Description', '~');
  929 
  930             # take the description
  931             my $desc = $f->{'desc'};
  932 
  933             # decorate function arguments
  934             $desc =~ s/@([\w_]+)/_$1_/g;
  935 
  936             # decorate return values
  937             $desc =~ s/\%([\w_]+)/_$1_/g;
  938 
  939             print F $desc, "\n";
  940 
  941             if ($f->{category}) {
  942                 print F _grutatxt_header('Categories', '~');
  943 
  944                 print F join("\n",
  945                     map { ' * ./#' . _gl($_) . ' (' . $_ . ')' }
  946                         @{$f->{'category'}});
  947 
  948                 print F "\n";
  949             }
  950         }
  951 
  952         print F "\n";
  953     }
  954 
  955     if ($author) {
  956         print F "----\n$author ";
  957     }
  958 
  959     if (!$quiet) {
  960         print F "- Built with http://triptico.com/software/mp_doccer.html (mp_doccer $main::VERSION)";
  961     }
  962 
  963     print F "\n";
  964     close F;
  965 }