#!/usr/bin/perl -w

#$example_indent = "    ";
$example_indent = "";

#$ex_color = "#179C4A";		# dark green -- too light
#$ex_color = "#14843F";		# dark green -- still too light
#$ex_color = "#056819";		# dark green -- "
$ex_color = "#82140F";		# dark red

$usage = "
texinfo2HTML [-h] [filename]

Convert texinfo doc to HTML format, through processing of 
texinfo comments as follows:

1. Pass single line to HTML but not to other forms of manual
------------------------------------------------------------

    \@c HTML some-stuff


2. Commented-out portions
-------------------------

    \@c HTML <!--
    This line won't appear in the html
    \@c HTML -->


3. Break file here
------------------

    \@c HTML <!-- newfile filename other_words_for_title -->
	    If it occurs on a line all by itself, causes 
	    this perlscript to chop files here.  The filename
	    will be as specified.  The other_words 
	    will be used as the title.  If neither the
	    filename nor the other_words are present, then
	    this script makes up filenames using numbers, e.g.,
	    gri1.html, gri2.html.  If the filename is \".\",
	    then this same naming scheme is used, but the titles
	    are used.

4. Insert latex command
-----------------------

    \@c HTML <!-- latex: some-stuff -->
	    Plants a comment to be stripped out as a latex-only command.

BUGS:
	Does not search for closing braces properly, so that lines like
		blah \@code{blah blah
		the end is here} and more blah
	will not get the \@code{} item converted correctly.
";
#require "ctime.pl";
use POSIX qw(ctime);
use Getopt::Std;
&getopts('h');
if ($opt_h) {
    print "$usage";
    exit 0;
}
$debug = 0;

#$date = &ctime(time);
$date = &ctime(time);
chop($date);

$CH   = 0;			# chapter 
$SEC1 = 1;			# section
$SEC2 = 1;			# subsection
$SEC3 = 1;			# subsubsection

$allow_P = 0;
$in_example = 0;
$last_was_node = 0;
print "<!-- Created automatically from texinfo source -->\n";
print "<!-- $date -->\n";
sub get_a_line() {
    if ($_=<>) {
	s/\@noindent//;
	if (/^\@c\s*HTML\s*<!--\s*$/) {
	    while(<>) {
		#print STDERR "SKIPPING $_";
		if (/^\@c\s*HTML\s*-->\s*$/) {
		    $_ = <>;
		    return $_;
		}
	    }
	}
	return $_;
    } else {
	return "";
    }
}
while(get_a_line()) {
    $line++ if $debug;
    print STDERR "$0 at line: $line\n" if ($debug && ($line == 2000 * int($line / 2000)));
    next if /\@cindex/;
    # Prevent unclosed braces
    if (!$in_example) {
	while (/{[^}]*$/o) {
	    $a = $_;
	    $a =~ s/\n/ /o;
	    $_ = get_a_line();
	    $_ = $a . $_;
	}
    } else {
	$_ = "$example_indent$_";
    }
    # Handle HTML inserts
    if (/^\@c HTML (.*)/o) {
	$_ = "$1 \n";
	&sub_refs;
	s,\@value\{(.*)\},$value{$1},g; # set/value pair
	print;
	next;
    }
    # Process image commands (NOT...it's there already) 
    if (/\@image\{(.*)\}/) {
	#print "<img src=\"$1.gif\" border=\"1\">\n";
	next;
    }
    next if /^\@top\s/;
    next if /^\@include\s*/;
    # Ignore all other comments
    next if /^\@c\s/;
    next if /^\@comment\s*/;
    # Ignore unnumbered, since special case (see Makefile)
    next if /\@unnumbered/;
    # Ignore special-cases text
    next if /^Copyright/;
    # Ignore texinfo command to input files
    next if /\\input/;
    # Ignore some tex-type commands
    next if /\@summarycontents/;
    next if /\@contents/;
    next if /\@bye/;
    next if /\@message/;
    next if /\@global/;
    next if /\@setfilename/;
    next if /\@setchapternewpage/;
    next if /\@settitle/;
    next if /\@page/;
    next if /\@space/;
    next if /\@sp/;
    next if /\@defindex/;
    next if /\@vskip/;
    s/\@noindent//;
    # Pass contents of ifhtml blocks
    next if /\@ifhtml/;
    next if /\@end ifhtml/;
    # Pass contents of ifinfo blocks
    next if /\@ifinfo/;
    next if /\@end ifinfo/;
    # Pass contents of ifnotinfo blocks
    next if /\@ifnotinfo/;
    next if /\@end ifnotinfo/;
    # Ignore contents of @dircategory and @direntry block
    next if /\@dircategory/;
    if (/^\@direntry/o) {
	while(get_a_line()) {
	    if (/^\@end direntry/o) {
		$_ = "";
		last;
	    }
	}
    }
    # Ignore contents of tex and iftex blocks
    if (/^\@tex/o) {
	while(get_a_line()) {
	    if (/^\@end tex/o) {
		$_ = "";
		last;
	    }
	}
    }
    if (/^\@iftex/o) {
	while(get_a_line()) {
	    if (/^\@end iftex/o) {
		$_ = "";
		last;
	    }
	}
    }
    # Ignore indices (for now)
    next if /\@defindex/;
    if (/\@[cfv]index\s*(.*)/o) {
	print "<!-- latex: \\index{$1} -->\n";
	next;
    }
    next if /\@EGindex/;
    next if /\@printindex/;
    #
    # Save set/value pair.
    if (/\@set\s*(\S*)\s*(\S*)/o) {
	$value{$1} = $2;
	next;
    }
    s,\@value\{([^}]*)\},$value{$1},g; # Substitute set/value pair
    #
    # Fix some texinfo escapes
    s,&,&amp;,og;
    s,>,&gt;,og;
    s,<,&lt;,og;
    # Special tweak to make 'Gri' look cooler.
	#    s, Gri , G<FONT SIZE=-1>RI</FONT> ,og;
    s,\@code\{\@\@\},\@code{TEXINFO2HTML-AT-AT},og;
    s,\@},TEXINFO2HTML-CLOSE-BRACE,og; # retain inside e.g. @code{}
    s,\@\@,TEXINFO2HTML-AT-AT,og;
    s,\@\{,{,og;
    s,\@TeX\{\},TeX,og;
    s,\@dots\{\},...,og;
    # Put in place-holders for some accents.  I should check for all
    # of them, but for now, I'm just kludging in a couple, 
    # to solve an immediate problem and to serve as a place-holder
    # for better coding.  A good reference on accents is
    #    http://www.w3.org/MarkUp/html-spec/html-spec_13.html
    # which I found on 2002-feb-24.
    s,\@'a,TEXINFO2HTML-ACCENT-ACUTE-a,og;
    s,\@'e,TEXINFO2HTML-ACCENT-ACUTE-e,og;
    s,\@'o,TEXINFO2HTML-ACCENT-ACUTE-o,og;
    if (/^\@titlepage/o) {
	while(get_a_line()) {
	    s,\@value\{(.*)\},$value{$1},g; # set/value pair
	    if (/\@author\s*(.*)/o) {
		$author = $1;
	        $author =~ s/\@\@/\@/;
	    } else {
		if (/^\@end titlepage/o) {
		    last;
		}
	    }
	}
	next;
    }
    while (/\@url\{([^}]*)\}/) {
	$the_url = $1;
        s:\@url\{[^}]*\}:<a href="$the_url">\@code{$the_url}</a>:;
    }
    while (/\@uref\{([^}]*)\}/) {
	@items = split(/,/, $1);
        if ($#items == 0) {
            s:\@uref\{[^}]*\}:<a href="$items[0]">$items[0]</a>:;
        } elsif ($#items == 1) {
            s:\@uref\{[^}]*\}:<a href="$items[0]">$items[1]</a>:;
        } elsif ($#items == 2) {
            s:\@uref\{[^}]*\}:\@code{$items[2]}:;
        } else {
            die "Cannot have more than 3 items in a 'uref' at \"$_\"";
        }
    }
    #
    # Convert cross-references
    if (/^\@node\s*([^,]*), ([^,]*), ([^,]*), ([^\n]*)/o) {
	$next_node = $2;
	$previous_node = $3;
	$parent_node = $4;
        # Start anchor, and set flag so end put after next heading.
	# Need this flag because xmosaic 1.0 does not accept
	# <A NAME="foo"></a>; it requires <A NAME="foo"><h1>heading</h1></a>
	# or it will not properly search the reference.  I think this
	# is a bug, and reported it to the author in an email:
	#   From kelley Wed Jun 30 16:31:13 1993
	#   To: marca\@ncsa.uiuc.edu
	chop;	print "<!-- $_ -->\n";
	print "<a name=\"$1\" ></a>\n";
	$last_was_node = 1;
	next;
    }
    &sub_refs;
    #
    # Convert headings; put the end anchor if needed
    if (/\@chapter/o
	|| /\@section/o
	|| /\@subsection/o
	|| /\@subsubsection/o
	|| /\@subsubsubsection/o
	|| /\@appendixsubsec/o
	|| /\@unnumbered/o
	|| /\@appendixsubsec/o
	|| /\@appendixsec/o
	|| /\@appendix/o) {
        &sub_headings;
	&sub_emphasis;
	print;
	#
	# Last was a node, so put the end anchor in
	if ($last_was_node) {
	    print "\n<b>Navigation</b>:\n<a href=\"#$next_node\">next</a>,\n<a href=\"#$previous_node\">previous</a>,\n<a href=\"#$parent_node\">parent</a>.\n";
	    $last_was_node = 0;
	}
	# 
	# Done with this line
	next;
    }
    &sub_emphasis;
    #
    # Convert quotations
    s,\@quotation,<BLOCKQUOTE>,;
    s,\@end quotation,</BLOCKQUOTE>,;
    &process_examples();
    # Convert Menus to UL (was DL before)
    if (/\@menu/o) {
	print "<UL>\n";
	while(get_a_line()) {
	    if (/^\@end menu/o) {
		$_ = "";
		last;
	    }
	    &sub_headings;
	    &sub_emphasis;
	    if (/\*\s([^:]*)::\s*(.*)/o) {
		print "<LI><a href=\"#$1\">$1</a>: $2\n";
	    } 
	}
	print "</UL>\n";
    }
    if (/\@table\s*(.*)/o) {
	if ($1 eq "\@code") {
	    $start_item = "<tt>"; $end_item = "</tt>"
	}
	if ($1 eq "\@emph") {
	    $start_item = "<i>"; $end_item = "</i>"
	}
	print "<dl>\n";
	while(get_a_line()) {
	    next if /\@sp/;
	    next if /\@cindex/;
            s|\@anchor\{([^}]*)\}|<a name=\"$1\"></a>|g;
	    &process_examples();
	    # Handle HTML inserts
	    if (/^\@c HTML (.*)/o) {
		$_ = "$1 \n";
		&sub_refs;
		s,\@value\{(.*)\},$value{$1},g; # set/value pair
		print;
		next;
	    }
	    if (/^\s*\@end\s*table/o) {
		$_ = "";
		last;
	    }
	    if (/\s*\@item\s*(.*)/o) {
                $the_item = $1;
		$the_item =~ s:\@\{:{:og;
		$the_item =~ s:\@\}:}:og;
		$the_item =~ s:\@\@:\@:og;
		$the_item =~ s:\@code\{([^}]*)\}:`<font color="$ex_color"><code>$1</code></font>':og;
		print "<dt> $start_item$the_item$end_item\n<dd>";
	    } else {
		print "<p>" if (/^$/o);
	        &sub_refs;
	        &sub_headings;
		&sub_emphasis;
		print;
            }
	}
	print "</dl>\n";
    }
    #
    # Convert lists
    s,\@itemize.*,<ul>,;
    s,\@end\s*itemize,</ul>,;
    s,\@enumerate,<ol>,;
    s,\@end\s*enumerate,</ol>,;
    s,\@itemx,<li>,;
    s,\@item,<li>,;
    s,\@bullet,,;		# HTML does not use
    #
    # Multiple blanks lines are paragraph separators in texinfo
    if (/^$/o) {
	if ($allow_P) {
	    print "<p>";
	}
    	$allow_P = 0;
    } elsif (/<H/o) {
    	$allow_P = 0;
    } else {
    	$allow_P = 1;
    }
    #
    # Finally, print modified line
    print;
} 
#print "____________________________________________________________________\n";
#print "<ADDRESS> $title / $author </ADDRESS>\n";

print "</BODY>\n";
print "</HTML>\n";

sub process_examples() {
    if (/\@example/o) {
	s,\s*\@example,<TABLE SUMMARY="Example" BORDER="0" BGCOLOR="#efefef" WIDTH="100%">\n<TR>\n<TD>\n<PRE>\n<font color="$ex_color">,;
	$in_example = 1;
    } elsif (/^\s*\@end example/o) {
	s,\s*\@end example,</font></PRE>\n</TD>\n</TR>\n</TABLE>,;
	$in_example = 0;
    } else {
        s,\@value\{([^}]*)\},$value{$1},g; # Substitute set/value pair
        s,\@},},og;
        s,\@\{,{,og;
    }
}


sub sub_refs {
    die "line $. of file: cannot have multiple refs on one line" if (/\@[px]*ref\{(.*)\}(.*)\@[px]*ref\{(.*)\}/);
    # anchors
    s|\@anchor\{([^}]*)\}|<a name=\"$1\"></a>|g;
    # Change e.g. 
    #     @xref{Viewing}
    # into
    #     <a href="#Viewing">see Viewing</a>

    #if (/\@ref/){print "AAA[$_]AAA\n";
    s|\@ref\{([^}]*)\}|see <a href="#$1">$1</a>|g;
    #print "BBB[$_]BBB\n";}

    s|\@xref\{([^}]*)\}|see <a href="#$1">$1</a>|g;
    s|\@pxref\{([^}]*)\}|see <a href="#$1">$1.</a>|g;
    while (/\@url\{([^}]*)\}/) {
	$the_url = $1;
        s:\@url\{[^}]*\}:<a href="$the_url">\@code{$the_url}</a>:;
    }
    while (/\@uref\{([^}]*)\}/) {
	@items = split(/,/, $1);
        if ($#items == 0) {
            s:\@uref\{[^}]*\}:<a href="$items[0]">$items[0]</a>:;
        } elsif ($#items == 1) {
            s:\@uref\{[^}]*\}:<a href="$items[0]">$items[1]</a>:;
        } elsif ($#items == 2) {
            s:\@uref\{[^}]*\}:\@code{$items[2]}:;
        } else {
            die "Cannot have more than 3 items in a 'uref' at \"$_\"";
        }
    }
}

sub sub_headings {
    if (/\@chapter/) {
	$CH++;
	$SEC1 = 0;
	s,\@chapter\s*(.*),<h1>$CH: $1</h1>,;
    } elsif (/\@unnumbered/) {
	$CH++;
	$SEC1 = 0;
	s,\@unnumbered\s*(.*),<h1>$CH: $1</h1>,;
    } elsif (/\@section/) {
	$SEC1++;
	$SEC2 = 0;
	s,\@section\s*(.*),<h2>$CH.$SEC1: $1</h2>,;
    } elsif (/\@subsection/) {
	$SEC2++;
	$SEC3 = 0;
	s,\@subsection\s*(.*),<h3>$CH.$SEC1.$SEC2: $1</h3>,;
    } elsif (/\@subsubsection/) { 
	$SEC3++;
	s,\@subsubsection\s*(.*),<h4>$CH.$SEC1.$SEC2.$SEC3: $1</h4>,;
    }
}

sub sub_emphasis {
    s,<<,&lt&lt,g;
    s,>>,&gt&gt,g;
    s,\@emph\{([^}]*)\},<em>$1</em>,g;
    s,\@strong\{([^}]*)\},<b>$1</b>,g;
    s,\@footnote\{([^}]*)\}, [$1],g;
    s,\@b\{([^}]*)\},<b>$1</b>,g;

    s,\@code\{([^}]*)\},`<font color="$ex_color"><code>$1</code></font>',g;
    s,\@\@,\@,g;
    s,\@samp\{([^}]*)\},`<font color="$ex_color"><samp>$1</samp></font>',g;
    s,\@key\{([^}]*)\},`<font color="$ex_color"><kbd>$1</kbd></font>',g;
    s,\@kbd\{([^}]*)\},`<font color="$ex_color"><kbd>$1</kbd></font>',g;
    s,\@file\{([^}]*)\},`<font color="$ex_color"><samp>$1</samp></font>',g;
    s,TEXINFO2HTML-CLOSE-BRACE,},g;
    s,TEXINFO2HTML-AT-AT,\@,g;
    s,TEXINFO2HTML-ACCENT-ACUTE-a,&#225,g;
    s,TEXINFO2HTML-ACCENT-ACUTE-e,&#233,g;
    s,TEXINFO2HTML-ACCENT-ACUTE-o,&#243,g;
}

