Subversion Repositories or1k

#!/usr/bin/perl
# (Works with both perl 4 and perl 5)
#
#  texi2www,v 1.12 2002/01/17 21:47:47 joel Exp
#

$version = 'Jan 2 1996';
$copyright = <<EOT;
texi2www - converts texinfo to HTML
Copyright (C) 1994, 1995, 1996 Tim Singletary

This program is freely distributable under the terms of the GNU 
GENERAL PUBLIC LICENSE.  In particular, modified versions of this 
program must retain this copyright notice and must remain freely
distributable.

EOT
$usage = <<EOT;
Usage: texi2www [option ...] texinfo_file
where options are:
  -dir directory    -- Specify output directory.  Default is `.'.
  -dirfile path     -- Specifies a replacement for ../dir.html
  -header path      -- Specifies the path to a file containing HTML;
                       this files gets inserted near the top of each
                       generated HTML file.
  -footer path      -- Specifies the path to a file containing HTML;
                       this files gets inserted near the bottom of each
                       generated HTML file.
  -I path           -- Append path to the directories being searched for
                       texi files.
  -icons path       -- Specifies the path, relative to the output directory,
                       to the arrow files.  Default is `..'.
  -base             -- Specify the base part fo the genrated short file names
  -uselongnames     -- Use long names for generated html files
  -verbose          -- Verbose output.

The complete user\'s is available at
http://sunland.gsfc.nasa.gov/info/texi2www/Top.html
EOT

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

%lookup = ();                      # clear the name mapping hash
$uselongnames=0;                   # default to using short names
$base = "a";                       # default short name base (BASEnnnnn.html)
$outcount = 0;                     # count for the nnnnn part of short names
$icons = "..";                     # where are the icons
$dir = ".";                        # where are the generated files to go
$dirfile = "../dir.html";          # "up" node pointer
@include_path = () ;               # list of include directories

while ($ARGV[0] =~ /^-/) {
    $_ = shift;
    if (/-base/) {$base = shift; next;}
    if (/-dirfile/) {$dirfile = shift; next;}
    if (/-dir/) {$_ = shift; s!/$!!; s!$!/!; $dir = $_; next;}
    if (/-footer/) {$footer = shift; next;}
    if (/-header/) {$header = shift; next;}
    if (/-icons/) {$_ = shift; s!\/$!!; $icons = $_; next;}
    if (/-uselongnames/) {$uselongnames = 1; next;}
    if (/-verbose/) {$verbose = 1; next;}
    if (/-I/) { push @include_path, shift; next;}
    die $usage;
}

print STDERR "include-path:@include_path\n" if $verbose ;
&initialize_tables();

#
# Read the texinfo input into @texinfo
#
&open_input_file($ARGV[0]);
&read_input(1,'/^\@bye/',"$texinfo_file[0] line 1");
$texinfo[$ntexinfo] = "\@bye\n";
$origin[$ntexinfo] = "$texinfo_file[0] line $.";

#
# Parse @texinfo
#
$texinfo_index = 0;
while ($texinfo_index < @texinfo) {
    &get_more_stuff_to_parse();
    if (/^\@bye/) {
        &terminate_node();
        print "Normal completion\n";
        exit;
    }
    &parse();
}

print "Huh? didn't parse the \@bye directive!\n";

########################################################################
sub canonical # (node_name)
{
    local ($n) = @_;

    $n =~ s/^\s+//; $n =~ s/\s+$//; # strip whitespace

    return "$dirfile" if ($n =~ /\(dir\)/i); # handle (dir)
    
    if ($n =~ /^\(([^\)]+)\)(.*)/) {
        $p = $1; $p =~ s/^\s+//; $p =~ s/\s+$//; $p .= "/";
        $n = $2; $n =~ s/^\s+//; $n =~ s/\s+$//;
    } else {
        $p = "";
    }


    $n =~ s/\$/\$\$/;           # `$' -> `$$'
    $n =~ s/_/\$_/g;            # `_' -> `$_'
    $n =~ s/\s+/_/g;            # whitespace -> `_'

                                # anything else that's funky get
                                # translated to `$xx' where `xx'
                                # are hex digits.
    while ($n =~ /(.*)([^-a-zA-Z0-9\$_.])(.*)/) {
        $n = $1 . sprintf("\$%02x",ord($2)) . $3;
    }

    if ($uselongnames) {
      return "$p$n.html" if ($n);
    } else {
      if ($n eq 'Top') {
        $lookup{"$p$n"}= "index.html"; 
        return $lookup{"$p$n"};
      } elsif ($n) {
        if (! $lookup{"$p$n"})  {
          $outcount = $outcount + 1;
          #$lookup{"$p$n"}= "$base$outcount.html"; 
          $lookup{"$p$n"} = sprintf "%s%05d.html", $base, $outcount;
        }
        return $lookup{"$p$n"};
      }
    }
    return "";
} # canonical

########################################################################
sub deduce_node_links
#
# On entry, $_ is a node line and $start_index is the index (in @texinfo)
# the node line.
#
# &deduce_node_links() sets $next, $prev, and $up.
{
    local ($level,$i,$node,$j);

    # First, search down from this node to the next sectioning command.
    $level = &determine_node_level($start_index+1);

    # Next, look for the `next' node (i.e., the next node at the
    # same or a higher level).
    undef($next);
    for ($i=$start_index+1; $i < $ntexinfo; ++$i) {
        $_ = $texinfo[$i];
        next unless /^\@node +([^,]+).*\n/;
        $j = &determine_node_level($i+1);
        if ($j <= $level) {
            if ($j == $level) {$next = $1;}
            last;
        } 
    }

    # Look for the `prev' and `up' nodes
    undef($prev);
    undef($up);
    for ($i=$start_index-1; $i > 1; --$i) {
        $_ = $texinfo[$i];
        next unless /^\@node\s+([^,]+).*\n/;
        $j = &determine_node_level($i+1);
        if ($j == $level) {
            unless ($prev) {$prev = $1;}
        } elsif ($j < $level) {
            $up = $1;
            last;
        }
    }
    unless (defined($up)) {$up = "(dir)";}

    $xthis = $this;
    $xthis =~ s/\n//;

} # deduce_node_links

########################################################################
sub determine_node_level
{
    local ($i) = @_;
    local ($level);

    $level = 0;
    while ($i < $ntexinfo) {
        $_ = $texinfo[$i];
        ++$i;
        next if /^\s+$/;
        last if (/\@node/);
        last unless (/\@(\w+)/);
        if ($directive_section{$1}) {
            $level = $directive_section{$1};
            last;
        }
    }

    return $level;
} # determine_node_level


########################################################################
sub expand_xref
{
    local ($cmd,$arg) = @_;
    local ($node,$xrefname,$topic,$infofile,$manual,$url,$x);

    if ($cmd eq 'inforef') {
        ($node,$xrefname,$infofile) = split(/,/,$arg);
        $topic = $manual = '';
    } elsif ($cmd eq 'href') {
        ($xrefname,$node,$infofile,$url) = split(/,/,$arg);
    } elsif ($cmd eq 'email') {
        ($xrefname,$node,$infofile,$url) = split(/,/,$arg);
        $xrefname = "mailto:$xrefname";
        $url = $xrefname
    } elsif ($cmd eq 'uref') {
        ($url,$xrefname,$node,$infofile) = split(/,/,$arg);
    } else {
        ($node,$xrefname,$topic,$infofile,$manual) = split(/,/,$arg);
    }
    $xrefname =~ s/^\s+//; $infofile =~ s/^\s+//;
    $xrefname =~ s/\s+$//; $infofile =~ s/\s+$//;
    $xrefname =~ s/\s+/ /; $infofile =~ s/\s+/ /;
    $infofile =~ s/\.texi$//;
    $infofile =~ s/\.texinfo$//;

    if ($xrefname =~ /^$/) {$xrefname = $node;}

    $node = &canonical($node);
    unless ($url) {
        unless ($infofile =~ /^$/) {$url = "../$infofile/";}
        $url = $url . $node;
    }
    $x = "<A HREF=\"$url\">$xrefname</A>";
} # expand_xref

########################################################################
sub get_more_stuff_to_parse
{
    $start_index = $texinfo_index;

    $_ = '';
    do {
        if ($texinfo_index >= @texinfo) {
            print "Unclosed \@x{y} in chunk beginning at "
                . "$origin[$start_index]\n";
            return;
        }
        s/\n$/ /;
        $more = $texinfo[$texinfo_index++];
        $more =~ s/\@\*/<BR>\n/g;
        $more =~ s/\@\./\./g;
        $more =~ s/\@\://g;
        $more =~ s/\@refill//g;

        $_ .= $more;

        # Expand all @a{b} in line
        while (/\@(\w+)\{([^{}]*)\}/) {
            $atcmd = $1;
            $atarg = $2;

            if ($z = $atxy_2_zyz{$atcmd}) {
                if ($z =~ /(.+),(.+),(.+)/) {
                    $left = $1; $z = $2; $right = $3;
                } else {
                    $left = ''; $right = '';
                }
                if ($z =~ s/^\^//) {$atarg =~ tr/a-z/A-Z/;}
                $x = "$left<$z>$atarg</$z>$right";
            } elsif ($atxy_2_y{$atcmd}) {
                $x = $atarg;
            } elsif ($z = $atxy_2_z{$atcmd}) {
                $x = $z;
            } elsif ($z = $atxy_2_ref{$atcmd}) {
                $x = $z . &expand_xref($atcmd,$atarg);
                $x =~ s/^X//; # works because $z must start with 'X'!
            } elsif ($atcmd eq 'value') {
                $x = $texinfo_variable{$atarg};
            } elsif ($atcmd eq 'today') {
                $x = &today();
            } elsif ($atcmd eq 'footnote') {
                $footnote[$nfootnotes++] = $atarg;
                $x = "\[$nfootnotes\]";
            } elsif ($atcmd eq 'gif') {
                $atarg =~ s/,.*//;
                &copy_to_destdir($atarg);
                $atarg =~ s|.*/||;
                $x = "<IMG SRC=\"$atarg\">";
            } else {
                print "**WARNING** Don't know how to expand "
                    . "\@$atcmd\{$atarg\}\n";
                $debug = 1;
                $x = "?$atcmd\?$atarg\?";
            }
            
            print "$origin[$start_index]: \@$atcmd\{$atarg\} => $x\n"
                                                   if $debug{expansions};

            s/\@\w+\{[^{}]*\}/$x/;          
        }
    } while (/\@\w+\{[^}]*$/);
    print "$origin[$start_index]: $_" if $debug{chunks};
} # get_more_stuff_to_parse

########################################################################
sub parse
# On entry:
#    $_ -- the line(s) to parse.
#    $start_index -- where, in $texinfo, $_ begins.
{
    local ($x);

    if (/^\@(\w+)/) {
        if ($x=$directive_block{$1}) { # @example, @quotation, etc.
            &parse_block($1,$x);
        } elsif ($directive_section{$1}) { # @chapter, @subsection, etc.
            &process_section();
        } elsif ($1 eq 'bye') {
            if ($nfootnotes > 0) {
                &printHTML("<P><HR>\n");
                for ($n=0; $n < $nfootnotes; ++$n) {
                    &printHTML("<P>\[" . ($n+1) . "\] $footnote[$n]</P>\n");
                }
            }
            &printHTML("<P><HR>\n");
            &print_arrows;
            &printHTML("</P>\n");
            &print_footer if $footer;
            &printHTML("</BODY></HTML>\n");
            close (HTML);
            return;
        } elsif ($1 eq 'center') {
            /^\@center\s+(.*)/;
            &printHTML("$paragraph_end") if $in_paragraph;
            &printHTML("<P ALIGN=CENTER>$1</P>\n");
            $in_paragraph = 0;
        } elsif ($1 eq 'clear') {
            /^\@clear\s+(\S+)/;
            undef($texinfo_variable{$1});
        } elsif ($1 =~ /^def(code)?index/) {
            /^\@(def|defcode)index\s+(\w+)/;
            $index_name{$2} = $2 . "index";
            $index_style{$2} = 'CODE' if ($1 eq "defcode");
        } elsif ($1 =~ /^(def.*)/) { # @defn, @defun, ... @deftp
            &parse_def($1);
        } elsif ($1 eq 'enumerate') {
            &parse_enumerate();
        } elsif ($1 eq 'exdent') {
            /^\@exdent\s+(.*)/;
            &printHTML("$paragraph_end") if $in_paragraph;
            # A bug -- doesn't exdent the line!
            &printHTML("<P>$1</P>\n");
            $in_paragraph = 0;
        } elsif ($1 eq 'flushleft' || $1 eq 'flushright') {
            &parse_flush();
        } elsif ($1 eq 'html') {
            while ($texinfo_index < @texinfo) {
                &get_more_stuff_to_parse();
                last if (/^\@end\s+html/);
                s/\&quot;/\"/g; s/\&gt;/\>/g; s/\&lt;/\</g; s/\&amp;/\&/g;
                &printHTML("$_");
            }
        } elsif ($1 eq 'itemize') {
            &parse_itemize();
        } elsif ($1 eq 'menu') {
            &parse_menu();
        } elsif ($1 eq 'node') {
            $node=$_;
            &process_node();
        } elsif ($1 eq 'printindex') {
            /^\@printindex\s+([a-z]+)/;
            &print_index($1);
        } elsif ($1 eq 'settitle') {
            /^\@settitle\s+(.*)/;
            unless ($title) {$title = $1;}
        } elsif ($1 eq 'set') {
            if (/^\@set\s+(\S+)\s+(.+)$/) {
                $texinfo_variable{$1} = $2;
            } else {
                /^\@set\s+(\S+)/;
                $texinfo_variable{$1} = 1;
            }
        } elsif ($1 eq 'syncodeindex') {
            &process_synindex(1);
        } elsif ($1 eq 'synindex') {
            &process_synindex(0);
        } elsif ($1 =~ /^.?table/) { # @table, @vtable, @ftable
            unless (/^\@(.?table)\s*\@(\w*)/
                           && ($2 eq 'asis' || ($tbltype=$atxy_2_zyz{$2}))) {
                print "**WARNING** $origin[$start_index]: assuming "
                    . "\@table \@asis\n";
                $tbltype = '';
            }
            &parse_table($1,$tbltype);
        } elsif ($1 =~ /..?index/) { # @cindex, @findex, .. @auindex, etc.
            &process_index();
        } else {
            print "**WARNING** $origin[$start_index]: ignoring $_";
        }
    } else {
        if (/^\s*$/) {
            if ($in_paragraph) {
                &printHTML("$paragraph_end");
            } elsif ($in_preformatted) {
                &printHTML("\n");
            }
            $in_paragraph = 0;
        } else {
            unless ($in_preformatted) {
                unless ($in_paragraph) {
                    &printHTML("<P>\n");
                    $in_paragraph = 1;
                    $paragraph_end = "</P>\n";
                }
            }
            &printHTML("$_");
        }
    }
} # parse

########################################################################
sub parse_block
#
# Handles @example, @display, etc.
#
#    > @example            > <PRE>
#    > a + b = c     ==>   > a + b = c
#    > @end example        > </PRE>
{
    local ($block,$pre) = @_;
    local ($started_at);

    $started_at = $start_index;

    &printHTML("$paragraph_end") if $in_paragraph;
    $in_paragraph = 0;

    if ($pre eq '>PRE') {
        &printHTML("<DL><DT><DD>\n<PRE>\n");
    } else {
        &printHTML("<$pre>\n") unless ($pre eq '-');
    }
    $in_preformatted = $block;
    while ($texinfo_index < @texinfo) {
        &get_more_stuff_to_parse();
        if (/^\@end\s+$block/) {
            if ($pre eq 'HR') {
                &printHTML("</HR>\n");
            } elsif ($pre eq '>PRE') {
                &printHTML("</PRE>\n</DL>\n");
            } else {
                &printHTML("</$pre>\n") unless ($pre eq '-');
            }
            $in_preformatted = 0;
            return;
        }
        &parse();
    }
    print "**ERROR** reached EOF while searching for end of the \@$block "
        . "block that started on $origin[$started_at]\n";
} # parse_block

########################################################################
sub parse_def
# $_ contains a @def* command
{
    local ($def) = @_;
    local ($started_at,$in_dd);

    $started_at = $start_index;
        
    &printHTML("$paragraph_end") if $in_paragraph;
    $in_paragraph = 0;
    
    &printHTML("<DL>\n");

    &printdef();

    while ($texinfo_index < @texinfo) {
        &get_more_stuff_to_parse();
        if (/^\@end\s+$def/) {
            &printHTML("</DL>\n");
            $in_paragraph = 0;
            return;
        }
        if (s/^(\@def\w+)x\s/$1 /) {&printdef();}
        else {
            unless ($in_dd) {
                &printHTML("<DD>\n");
                ++$in_dd;
                $in_paragraph = 1;
                $paragraph_end = "\n";
            }
            &parse();
        }
    }
    print "**ERROR** reached EOF while searching for end of the $def "
        . "definition that started on $origin[$started_at]\n";

} # parse_def
sub printdef
{

    s/\@defun(x?)\s/\@deffn Function / 
        || s/\@defmac(x?)\s/\@deffn Macro /
        || s/\@defspec(x?)\s/\@deffn \{Special Form\} /
        || s/\@defvar(x?)\s/\@defvr Variable /
        || s/\@defopt(x?)\s/\@defvr \{User Option\} /
        || s/\@deftypefun(x?)\s/\@deftypefn Function /
        || s/\@deftypevar(x?)\s/\@deftypefn Variable /
        || s/\@defivar(x?)\s/\@defcv \{Instance Variable\} /
        || s/\@defmethod(x?)\s/\@defop Method /;
    s/(\@\w+)x\s/$1 /;

    @words = split;

    $i = 1;
    $category = $words[$i++];
    while ($i < @words && $category =~ /^\{[^}]*$/) {
        $category .= ' ' . $words[$i++];
    }
    if ($i>=@words) {
        print "def error at $origin{$started_at}\n";
    }
    $category =~ s/^\{//;
    $category =~ s/\}$//;

    &printHTML("<DT>$category: ");

    if ($words[0] eq '@deftypefn' || $words[0] eq '@deftypevr'
        || $words[0] eq '@defcv' || $words[0] eq '@defop') {
        if ($words[$i] =~ s/^\{//) {
            &printHTML("<VAR>");
            until ($words[$i] =~ s/\}$//) {&printHTML("$words[$i++]");}
            &printHTML("$words[$i++]</VAR> ");
        } else {
            &printHTML("<VAR>$words[$i++]</VAR> ");
        }
        $words[0] =~ /.*([a-z][a-z])/;
        $_ = "\@" . $1 . "index " . $words[$i];
        &process_index;
    }
    &printHTML("<STRONG>$words[$i++]</STRONG>\n<VAR>");

    while ($i < @words) {&printHTML(" $words[$i++]");}
    &printHTML("</VAR>\n");

} # printdef

########################################################################
sub parse_enumerate
# $_ is `@enumerate'.  Note that @enumerate with an arg (`@enumerate 3',
# for example) is kinda funky due to HTML limitations.
{
    local ($count,$started_at);
    
    $started_at = $start_index;

    &printHTML("$paragraph_end") if $in_paragraph;
    $in_paragraph = 0;

    if (/^\@enumerate\s*(\S+)/) {$count = $1;}

    &printHTML("<" . ($count ? "UL" : "OL") . ">\n");

    while ($texinfo_index < @texinfo) {
        &get_more_stuff_to_parse();
        if (/^\@end\s+enumerate/) {
            &printHTML("</" . ($count ? "UL" : "OL") . ">\n");
            return;
        }
        if (/^\@item\s+(.*)/ || /^\@item()$/) {
            if ($count) {
                &printHTML("<LI>$count: $1\n");
                ++$count;
            } else {
                &printHTML("<LI>$1\n");
            }
            $in_paragraph = 1;
            $paragraph_end = "\n";
        } else {
            &parse();
        }
    }
    print "**ERROR** reached EOF while searching for end of the \@enumerate "
        . "that started on $origin[$started_at]\n";
} # parse_enumerate

########################################################################
sub parse_flush
{
    local ($started_at,$flush);

    /^\@(\w+)\s/;
    $flush = $1;
    $started_at = $start_index;

    &printHTML("$paragraph_end") if $in_paragraph;
    $in_paragraph = 0;

    while ($texinfo_index < @texinfo) {
        &get_more_stuff_to_parse();
        if (/^\@end\s+$flush/) {
            return;
        }
        &parse();
    }
    print "**ERROR** reached EOF while searching for end of the $flush "
        . "that started on $origin[$started_at]\n";


} # parse_flush

########################################################################
sub parse_itemize
# $_ is `@itemize'.  Due to HTML limitation, `@itemize @bullet' comes
# out the same as `@itemize @minus'.
{
    local ($started_at);

    $started_at = $start_index;

    &printHTML("$paragraph_end") if $in_paragraph;
    $in_paragraph = 0;

    &printHTML("<UL>\n");
    

    while ($texinfo_index < @texinfo) {
        &get_more_stuff_to_parse();
        if (/^\@end\s+itemize/) {
            &printHTML("</UL>\n");
            return;
        }
        if (/^\@item\s+(.*)/ || /^\@item()$/) {
            &printHTML("<LI>$1\n");
            $in_paragraph = 1;
            $paragraph_end = "\n";
        } else {
            &parse();
        }
    }
    print "**ERROR** reached EOF while searching for end of the itemize "
        . "that started on $origin[$started_at]\n";
} # parse_itemize

########################################################################
sub parse_menu
{
    local ($started_at);

    $started_at = $start_index;

    &printHTML("$paragraph_end") if $in_paragraph;
    $in_paragraph = 0;

    &printHTML("<MENU>\n");

    while ($texinfo_index < @texinfo) {
        &get_more_stuff_to_parse();
        if (/^\@end\s+menu/) {
            &printHTML("</MENU>\n");
            return;
        }

        # Like ` * menu-item:: description of item'
        if (/^\s*\*\s*([^:]*)\s*::\s*(.*)$/) {
            &printHTML("$paragraph_end") if $in_paragraph;
            $in_paragraph = 0;
            $node = &canonical($1);     
            &printHTML("<LI><A HREF=\"$node\">$1</A>\n");
            &printHTML("$2\n") if $2;
        # Like ` * menu-item: cross-reference. description of item'
        } elsif (/^\s*\*\s*([^:]*)\s*:([^.]*)\.\s*(.*)$/) {
            &printHTML("$paragraph_end") if $in_paragraph;
            $in_paragraph = 0;
            $node = &canonical($2);
            &printHTML("<LI><A HREF=\"$node\">$1</A>\n");
            &printHTML("$3\n");
        } elsif (/^\@/) {
            print "**WARNING** Don\'t know how to process \`$_\' inside "
                . "a menu!\n";
        } else {
            if (/^\s*$/ && !$in_paragraph) {
                &printHTML("<P>");
                $in_paragraph = "1";
                $paragraph_end = "</P>\n";
            }
            &printHTML("$_");
        }
    }
    print "**ERROR** reached EOF while searching for end of the menu "
        . "that started on $origin[$started_at]\n";
} # parse_menu

########################################################################
sub parse_table
# $_ is `@itemize'.  Due to HTML limitation, `@itemize @bullet' comes
# out the same as `@itemize @minus'.
{
    local ($table,$ttype,$after_DT,$started_at,$first_para);
    ($table,$ttype) = @_;

    $started_at = $start_index;

    &printHTML("$paragraph_end") if $in_paragraph;
    $in_paragraph = 0;

    &printHTML("<DL>\n");

    while ($texinfo_index < @texinfo) {
        &get_more_stuff_to_parse();    
        if (/^\@end\s+$table/) {
            &printHTML("</DL>\n");
            return;
        }
        if (/^\@item(x?)\s+(.*)/ || /^\@item(x?)()$/) {
            $atarg = $2;
            if ($ttype) {
                if ($ttype =~ /(.+),(.+),(.+)/) {
                    $left = $1; $z = $2; $right = $3;
                } else {
                    $left = ''; $z = $ttype; $right = '';
                }
                if ($z =~ s/^\^//) {$atarg =~ tr/a-z/A-Z/;}
                &printHTML("<DT>$left<$z>$atarg</$z>$right\n");
            } else {
                &printHTML("<DT>$2\n");
            }
            $item = $2;
            if ($item && $table =~ /([fv])table/) {
                $_ = "\@" . $1 . "index " . $item;
                &process_index;
            }
            $after_DT = 1;
        } else {
            if ($after_DT) {
                &printHTML("<DD>\n");
                $in_paragraph = 1;
                $paragraph_end = "\n";
                $after_DT = 0;
                $first_para = 1;
            }
            unless ($first_para && /^\s*$/) {
                $first_para = 0;
                &parse();
            }
        }
    }
    print "**ERROR** reached EOF while searching for end of the table "
        . "that started on $origin[$started_at]\n";
} # parse_table

########################################################################
sub print_index
{
    local ($index) = @_;
    $index = $index_name{$index};

    eval "\@keys = keys \%$index";

    &printHTML("<MENU>\n");
    foreach $item (sort texinfo_sort @keys) {
        eval "\$val = \$$index\{\$item\}";
        &printHTML("<LI>$val\n");
    }
    &printHTML("</MENU>\n");
} # print_index

sub texinfo_sort
{
    $x = $a; $x =~ s/<[^>]*>//g; $x =~ tr/A-Z/a-z/;
    $y = $b; $y =~ s/<[^>]*>//g; $y =~ tr/A-Z/a-z/;
    $x cmp $y;
} # texinfo_sort

########################################################################
sub process_index
#
# For example, `@cindex whatever' generates an entry in %cpindex
#
{
    s/\@cindex/\@cpindex/ || s/\@findex/\@fnindex/
        || s/\@vindex/\@vrindex/ || s/\@kindex/\@kyindex/
        || s/\@pindex/\@pgindex/ || s/\@tindex/\@tpindex/;

    /\@(..)index\s+(.*)/;

    if ($x=$index_style{$1}) {
        $entry = "<A HREF=\"$cthis\"><$x>$2</$x></A>";
    } else {
        $entry = "<A HREF=\"$cthis\">$2</A>";
    }

    print "*** \$$index_name{$1}\{$2\} = $entry\n" if $debug{'index'};
    eval "\$$index_name{$1}\{\$2\} = \$entry";
} # process_index

########################################################################
sub print_arrows
{
    &printHTML("<LINK REL=\"Precedes\" HREF=\"$cnext\">\n") if $next;
    &printHTML("<LINK REV=\"Precedes\" HREF=\"$cprev\">\n") if $prev;
    &printHTML("<LINK REV=\"Subdocument\" HREF=\"$cup\">\n") if $up;
    &printHTML("<LINK REV=\"Library\" HREF=\"$dirfile\">\n") if $dirfile;
    &printHTML("</HEAD><BODY><P>\n");
    if ($cprev) {
        &printHTML("<A HREF=\"$cprev\"><IMG ALIGN=MIDDLE "
                   . "SRC=\"$icons/prev-arrow.gif\" ALT=\"PREV\"></A>\n");
    } else {
        &printHTML("<A><IMG ALIGN=MIDDLE "
                   . "SRC=\"$icons/missing-arrow.gif\" ALT=\"prev\"></A>\n");
    }
    if ($cup) {
        &printHTML("<A HREF=\"$cup\"> <IMG ALIGN=MIDDLE "
                   . "SRC=\"$icons/up-arrow.gif\" ALT=\"UP\"></A>\n");
    } else {
        &printHTML("<A><IMG ALIGN=MIDDLE "
                   . "SRC=\"$icons/missing-arrow.gif\" ALT=\"up\"></A>\n");
    }
    if ($cnext) {
        &printHTML("<A HREF=\"$cnext\"><IMG ALIGN=MIDDLE "
                   . "SRC=\"$icons/next-arrow.gif\" ALT=\"NEXT\"></A>\n");
    } else {
        &printHTML("<A><IMG ALIGN=MIDDLE "
                   . "SRC=\"$icons/missing-arrow.gif\" ALT=\"next\"></A>\n");
    }
    if ($dirfile) {
# XXX need new graphic for this one
        &printHTML("<A HREF=\"$dirfile\"> <IMG ALIGN=MIDDLE "
                   . "SRC=\"$icons/dir-arrow.gif\" ALT=\"Bookshelf\"></A>\n");
    } else {
        &printHTML("<A><IMG ALIGN=MIDDLE "
                   . "SRC=\"$icons/missing-arrow.gif\" ALT=\"Bookshelf\"></A>\n");
    }
    &printHTML("<CITE>$title</CITE>") if $title;
}

########################################################################
sub process_node
# On entry, $_ is an @node line.
{
    s/^\@node\s+//;
    ($this,$next,$prev,$up) = split(/,/);

    &deduce_node_links() unless ($next || $prev || $up);

    &terminate_node();

    $cthis = &canonical($this);
    $cnext = &canonical($next);
    $cprev = &canonical($prev);
    $cup = &canonical($up);

    print "... opening $dir$cthis ...\n" if $debug{nodes};
    open(HTML,">$dir/$cthis") || die "Couldn't open $dir$cthis -- $!\n";
    
    $nfootnotes = 0;

    &printHTML("<HTML>\n");
    &printHTML("<!-- created $today from " .
               $origin[$start_index] . " via texi2www -->\n");
    &print_header if $header;
    &printHTML("<HEAD>\n<TITLE>$this</TITLE>\n");
    &print_arrows;
    &printHTML("</P>\n");
        
} # process_node

sub terminate_node
{
    if ($nfootnotes) {
        &printHTML("<P><HR>\n");
        for ($n=0; $n < $nfootnotes; ++$n) {
            &printHTML("<P>\[" . ($n+1) . "\] $footnote[$n]</P>\n");
        }
    }

    
    &printHTML("<P><HR>\n");
    &print_arrows;
    &printHTML("</P>\n");
    &print_footer if $footer;
    &printHTML("</BODY></HTML>\n");
    close (HTML);
}

########################################################################
sub process_section
#
# On entry:
#     $_ is the section command (I.e. `@chapter Overview')
#     $i is the index to $_ in @lines
{
    &printHTML("$paragraph_end") if $in_paragraph;
    $in_paragraph = 0;

    /^\@(\w+)\s+(.*)/;

    $section_number = '';
    if ($1 eq 'chapter') {
        ++$chapter; $section=$subsection=$subsubsection=0;
        $section_number = "Chapter $chapter: ";
    } elsif ($1 eq 'section') {
        ++$section; $subsection=$subsubsection=0;
        $section_number = "$chapter.$section: ";
    } elsif ($1 eq 'subsection') {
        ++$subsection; $subsubsection=0;
        $section_number = "$chapter.$section.$subsection: ";
    } elsif ($1 eq 'subsubsection') {
        ++$subsubsection;
        $section_number = "$chapter.$section.$subsection.$subsubsection: ";
    } elsif ($1 eq 'appendix') {
        ++$appendix; $section=$subsection=$subsubsection=0;
        $x = ('A'..'Z')[$appendix-1];
        $section_number = "Appendix $x: ";
    } elsif ($1 eq 'appendixsec') {
        ++$section; $subsection=$subsubsection=0;
        $x = ('A'..'Z')[$appendix-1];
        $section_number = "$x.$section: ";
    } elsif ($1 eq 'appendixsubsec') {
        ++$subsection; $subsubsection=0;
        $x = ('A'..'Z')[$appendix-1];
        $section_number = "$x.$section.$subsection: ";
    } elsif ($1 eq 'appendixsubsubsec') {
        ++$subsubsection;
        $x = ('A'..'Z')[$appendix-1];
        $section_number = "$x.$section.$subsection.$subsubsection: ";
    }

    $x = $directive_section{$1};
    &printHTML("<H$x>$section_number$2</H$x>\n");
} # process_section

########################################################################
sub process_synindex
#
# There's perhaps a bug here -- this presumes the @synindex comes before
# any @?index directives; anything already in <from> doesn't get merged
# into <to>!
#
{
    local ($code) = @_;         # Either 0 or 1; 1 means @syncodeindex

    /\@syn\w*index\s+(\w+)\s+(\w+)/;

    print "*** synindex $1 $2\n" if $debug{'index'};

    $index_name{$1} = $2 . "index";
    $index_style{$1} = 'CODE' if $code;
} # process_synindex

########################################################################
sub printHTML
{
    local ($line) = @_;
    $line =~ s/\$R/\}/g;
    $line =~ s/\$L/\{/g;
    $line =~ s/\$A/\@/g;
    $line =~ s/\$D/\$/g;
    if ($debug{printHTML}) {
        print $line;
    } else {
        print HTML $line;
    }
} # printHTML

########################################################################
sub print_header
{
    unless (open(HEADER,$header)) {
        print "WARNING -- couldn't open header file \"$header\" -- $!\n";
        $header = 0;
        return;
    }
    while (<HEADER>) {
        &printHTML($_);
    }
    close(HEADER);
}

########################################################################
sub print_footer
{
    unless (open(FOOTER,$footer)) {
        print "WARNING -- couldn't open footer file \"$footer\" -- $!\n";
        $footer = 0;
        return;
    }
    while (<FOOTER>) {
        &printHTML($_);
    }
    close(FOOTER);
}

########################################################################
sub read_input
#
# Read the texinfo source into @texinfo.  Don't copy comments or the
# `@ifxxx' and `@end ifxxx' surrounding [or the contents of] conditional
# blocks.  Read `@include' files.
{
    local ($echo,$terminator_re,$started_at) = @_;

    while (&texinfo_read()) {

        next if (/^\@c$/ || /^\@c\s/ || /^\@comment/);

        if (/^\@ifinfo/) {
            &read_input($echo,'/^\@end\s+ifinfo/',
                                              "$texinfo_file[0] line $.");
            next;
        }
        if (/^\@ifhtml/) {
            &read_input($echo,'/^\@end\s+ifhtml/',
                                              "$texinfo_file[0] line $.");
            next;
        }
        if (/^\@iftex/)  {
            &read_input(0,'/^\@end\s+iftex/',
                                              "$texinfo_file[0] line $.");
            next;
        }
        if (/^\@tex/)  {
            &read_input(0,'/^\@end\s+tex/',
                                              "$texinfo_file[0] line $.");
            next;
        }
        if (/^\@ignore/) {
            # @ignore doesn't nest
            $ignore_from = "$texinfo_file[0] line $.";
            while (&texinfo_read()) {
                last if (/^\@end\s+ignore/);
            }
            unless (/^\@end\s+ignore/) {
                print "Unexpected EOF while searching from $ignore_from "
                    . "for \'\@end ignore\'\n";
            }
            next;
        }
        if (/^\@titlepage/) {
            &read_input(0,'/^\@end\s+titlepage/',"$texinfo_file[0] line $.");
            next;
        }

        if (/^\@ifclear\s+(\S+)/) {
            &read_input($echo&&(!defined($set{$1})),'/^\@end\s+ifclear/',
                                                  "$texinfo_file[0] line $.");
            next;
        }
        if (/^\@ifset\s+(\S+)/) {
            &read_input($echo&&defined($set{$1}),'/^\@end\s+ifset/',
                                                  "$texinfo_file[0] line $.");
            next;
        }
        
        return if eval "$terminator_re";

        if (/^\@include\s+(\S+)/) {
            &open_input_file($1);
            next;
        }

        if (/^\@(set|clear)\s+(\S+)/) {
            if ($1 eq "set") {
                $set{$2} = 1;
            } else {
                undef($set{$2});
            }
        }

        next unless $echo;

        if (/^\@(\w+)/) {next if $ignore_these_directives{$1};}
        
        # Hide @@, @{, and @} so later on it'll be easier to process
        # stuff like `@code{@@TeX@{@}}'.
        s/\$/\$D/g; s/\@\@/\$A/g; s/\@{/\$L/g; s/\@}/\$R/g;

        # Convert the HTML special characters
        s/\&/\&amp;/g; s/\</\&lt;/g; s/\>/\&gt;/g; s/\"/\&quot;/g;
        
        $texinfo[$ntexinfo] = $_;
        $origin[$ntexinfo] =  "$texinfo_file[0] line $.";
        ++$ntexinfo;
    }

    print "Unexpected EOF while searching from $started_at "
        . "for $terminator_re\n";
} # read_input

########################################################################
sub initialize_tables
{
    # Lists which `@x{y}' get expanded into `y'.
    %atxy_2_y = (
        'asis', 1,
         'r', 1,
         'w', 1,
    );

    # Describes which `@x{y}' get expanded into `<z>y</z>' and what `z'
    # is in those expansions!  (If the expansion matches
    # ``/(.*),(.*),(.*)/'' then y actually expands to ``$1<$2>y</$2>$3'';
    # if z (or $2) begins with ^ then uppercase y before doing the
    # expansion). 
    %atxy_2_zyz= (
        'b',         'STRONG',
        'cite',      'CITE',
        'code',      "CODE",
        'dfn',       'EM',
        'dmn',       'EM',
        'emph',      'EM',
        'file',      "`,CODE,'",
        'i',         'EM',
        'kbd',       'KBD',
        'key',       '^CODE',
        'math',      'CODE',
        'samp',      "`,CODE,'",
        'sc',        '^EM',
        'strong',    'STRONG',
        't',         'CODE',
        'titlefont', 'CITE',
        'var',       'VAR',
    );

    # Describes which `@x{y}' can be expanded into `z' and what `z' is in
    # those expansions!
    %atxy_2_z = (
        'TeX',       '<i>T</i>e<i>X</i>',
        'bullet',    '*',
        'copyright', '(C)',
        'dots',      '...',
        'equiv',     '==',
        'error',     'error-->',
        'expansion', '==>',
        'minus',     '-',
        'point',     '-!-',
        'print',     '-|',
        'result',    '=>',
        'today',     &today(),
    );

    # Lists the '@x{y}' cross reference commands, and describes how they get
    # expanded.  Note the 'X' beginning each expansion -- it's there so 'ref'
    # doesn't get expanded to ''!
    %atxy_2_ref = (
        'xref',     'XSee ',
        'ref',      'X',
        'pxref',    'Xsee ',
        'href',     'X',
        'uref',     'X',
        'email',    'X',
        'inforef',  'XSee ',
    );

    %ignore_these_directives = (
        'author', 1,
        'break', 1,
        'contents', 1,
        'evenfooting', 1,
        'everyfooting', 1,
        'everyheading', 1,
        'finalout', 1,
        'footnotestyle', 1,
        'headings', 1,
        'need', 1,
        'noindent', 1,
        'oddfooting', 1,
        'page', 1,
        'paragraphindent', 1,
        'setchapternewpage', 1,
        'setcontentsaftertitlepage', 1,
        'setfilename', 1,
        'shortcontents', 1,
        'shorttitlepage', 1,
        'smallbook', 1,
        'sp', 1,
        'subtitle', 1,
        'summarycontents', 1,
        'top', 1,
        'vskip', 1,                         
    );

    # List the section directives and indicate what heading level 
    # each one gets.
    %directive_section = (
        'chapter', 1,
        'section', 2,
        'subsection', 3,
        'subsubsection',4,
        'appendix', 1,
        'appendixsec', 2,
        'appendixsubsec', 3,
        'appendixsubsubsec', 4,
        'chapheading', 1,
        'majorheading', 1,
        'heading', 2,
        'subheading', 3,
        'subsubheading', 4,
        'unnumbered', 1,
        'unnumberedsec', 2,
        'unnumberedsubsec', 3,
        'unnumberedsubsubsec', 4,
    );

    # These @ directives begin a block of preformatted text
    # (">PRE" means indented inside <PRE>...</PRE>)
    %directive_block = (
        'cartouche',   'HR',
        'display',     '>PRE',
        'example',     '>PRE',
        'format',      'PRE',
        'group',       '-',
        'lisp',        '>PRE',
        'quotation',   'BLOCKQUOTE',
        'smallexample','>PRE',
    );

    %index_name = (
        'cp', 'cpindex',
        'fn', 'fnindex',
        'ky', 'kyindex',
        'pg', 'pgindex',
        'tp', 'tpindex',
        'vr', 'vrindex',
    );
    %index_style = (
        'fn', 'CODE',
        'ky', 'CODE',
        'pg', 'CODE',
        'tp', 'CODE',
        'vr', 'CODE',
    );
} # initialize_tables

########################################################################
sub open_input_file
{
    my $file = "$_[0]" ;
    if ( not -f "$file" )
    {
      foreach $i ( @include_path )
      {
        if ( -f "$i/$_[0]" ) { $file = "$i/$_[0]"; last ; }
      }
    }
    unshift(@texinfo_file,$file);
    print "opening $file ...\n" if $debug{open_input_file};
    open($texinfo_file[0],$file) || die "Couldn't open $file: $!\n";
} # open_input_file

########################################################################
sub texinfo_read
# Reads the next line of texinfo input into $_.
{
    do {
        $fd = $texinfo_file[0];
        $_ = <$fd>;
    } while ($_ eq '' && shift @texinfo_file);
    return $_;
} # texinfo_read

########################################################################
sub today
{
    $today = `date`;
    $today =~ s/\w+ (\w+ +[0-9]+) [0-9]+:[0-9]+:[0-9]+ \w+ ([0-9]+)\n/$1 $2/;
    $today =~ s/ +/ /g;
    return $today;
} # today

########################################################################
sub copy_to_destdir
{
    ($copy_from) = @_;

    if ($copy_from =~ m|(.*)/([^/]*)|) {
        $copy_from_dir = $1;
        $copy_from_file = $2;
    } else {
        $copy_from_dir = ".";
        $copy_from_file = $copy_from;
    }

    if ($copy_from_dir ne $dir && !-e "$dir/$copy_from_file") {
        system("cp $copy_from $dir")
            && die "Couldn\'t \`cp $copy_from $dir\'\n";
    }
}