#!/usr/local/bin/perl
'di ';
'ig 00 ';
#+##############################################################################
# #
# File: texi2html #
# #
# Description: Program to transform most Texinfo documents to HTML #
# #
#-##############################################################################
$THISPROG = "texi2html 1.52"; # program name and version
# This version of texi2html is currently maintained at
# ftp://ftp.cs.umb.edu/pub/tex/texi2html by kb@cs.umb.edu.
# w schelter: made minor changes to allow the @anchor construct. so
# you can do "See @ref{FACTOR} and @ref{GFACTOR}." if you put in
# @anchor{FACTOR} just before the definition of FACTOR.. the new
# texi2html by olaf does @anchor, but it uses tables so heavily that
# netmath cannot view its output properly. Also I like the way the
# index is done here as one file, and several other features.
# The man page for this program is included at the end of this file and can be
# viewed using the command 'nroff -man texi2html'.
# Please read the copyright at the end of the man page.
# Fixme:
# deal with @macro @unmacro @shorttitlepage @detailmenu @image
# [plus more fixmes below]
# Use ',
);
#
# texinfo "things" (@foo{}) to HTML ones
#
%things_map = (
'TeX', 'TeX',
'br', '', # paragraph break. Gone from texinfo 3.9
'bullet', '*',
'copyright', '©',
'dots', '...',
'enddots', '....',
'equiv', '==',
'error', 'error-->',
'expansion', '==>',
'minus', '-',
'point', '-!-',
'print', '-|',
'result', '=>',
'today', $TODAY,
# fixme: output these Latin1 characters as such rather
# than as entities?
'pounds', '£',
'questiondown', '¿',
'ss', 'ß',
'exclamdown', '¡',
'AA', 'Å',
'AE', 'Æ',
'aa', 'å',
'ae', 'æ',
'O', 'Ø',
'o', 'ø',
# follow info rendering:
'L', 'L\/',
'l', 'l\/',
'OE', 'OE',
'oe', 'oe',
);
#
# texinfo styles (@foo{bar}) to HTML ones
#
%style_map = (
'asis', '', # ??
'b', 'B',
'cite', 'CITE',
'code', 'CODE',
'ctrl', '&do_ctrl', # special case (obsolete)
'dfn', 'STRONG', # DFN tag is illegal in the standard
'dmn', '', # useless
'emph', 'EM',
'email', '&do_email', # new special case
'file', '"TT', # will put quotes, cf. &apply_style
'i', 'I',
'kbd', 'KBD',
'key', 'KBD', # fixme: probably not ; possibly
# enclose in angles like makeinfo now does
'r', '', # unsupported
'samp', '"SAMP', # will put quotes, cf. &apply_style
'sc', '&do_sc', # special case
'strong', 'STRONG',
't', 'TT',
'titlefont', 'B', # make it distinctive, at least
'uref', '&do_url', # new special case
'url', 'CODE', # new special case
'var', 'VAR',
'w', '', # unsupported
# 'math', 'I', # not very useful, but at least italicize
'math', '', # don't want italic numbers
);
#
# texinfo format (@foo/@end foo) to HTML ones
#
%format_map = (
'display', 'PRE',
'example', 'PRE',
'format', 'PRE', # fixme: shouldn't use tt, but can't avoid?
'lisp', 'PRE',
'quotation', 'BLOCKQUOTE',
'smallexample', 'PRE',
'smalllisp', 'PRE',
# lists
'itemize', 'UL',
'enumerate', 'OL',
# poorly supported
'flushleft', 'PRE',
'flushright', 'PRE',
);
#
# texinfo definition shortcuts to real ones
#
%def_map = (
# basic commands
'deffn', 0,
'defvr', 0,
'deftypefn', 0,
'deftypevr', 0,
'defcv', 0,
'defop', 0,
'deftp', 0,
# basic x commands
'deffnx', 0,
'defvrx', 0,
'deftypefnx', 0,
'deftypevrx', 0,
'defcvx', 0,
'defopx', 0,
'deftpx', 0,
# shortcuts
'defun', 'deffn Function',
'defmac', 'deffn Macro',
'defspec', 'deffn {Special Form}',
'defvar', 'defvr Variable',
'defopt', 'defvr {User Option}',
'deftypefun', 'deftypefn Function',
'deftypevar', 'deftypevr Variable',
'defivar', 'defcv {Instance Variable}',
'defmethod', 'defop Method',
# x shortcuts
'defunx', 'deffnx Function',
'defmacx', 'deffnx Macro',
'defspecx', 'deffnx {Special Form}',
'defvarx', 'defvrx Variable',
'defoptx', 'defvrx {User Option}',
'deftypefunx', 'deftypefnx Function',
'deftypevarx', 'deftypevrx Variable',
'defivarx', 'defcvx {Instance Variable}',
'defmethodx', 'defopx Method',
);
#
# things to skip
#
%to_skip = (
# comments
'c', 1,
'comment', 1,
# useless
'contents', 1,
'shortcontents', 1,
'summarycontents', 1,
'footnotestyle', 1,
'end ifclear', 1,
'end ifset', 1,
'titlepage', 1,
'end titlepage', 1,
'dircategory', 1,
# unsupported commands (formatting)
'afourpaper', 1,
'cropmarks', 1,
'finalout', 1,
'headings', 1,
'need', 1,
'page', 1,
'setchapternewpage', 1,
'everyheading', 1,
'everyfooting', 1,
'evenheading', 1,
'evenfooting', 1,
'oddheading', 1,
'oddfooting', 1,
'smallbook', 1,
'vskip', 1,
'filbreak', 1,
'centerchap', 1,
'setchapterstyle', 1,
'hyphenation', 1,
# unsupported formats
'cartouche', 1,
'end cartouche', 1,
'group', 1,
'end group', 1,
);
#+++############################################################################
# #
# Argument parsing, initialisation #
# #
#---############################################################################
$use_bibliography = 1;
$use_acc = 0;
$debug = 0;
$doctype = '';
$check = 0;
$expandinfo = 0;
$use_glossary = 0;
$invisible_mark = '';
$use_iso = 0;
@include_dirs = ();
$show_menu = 0;
$number_sections = 0;
$split_node = 0;
$split_chapter = 0;
$monolithic = 0;
$verbose = 0;
$usage = <= 0 && $ARGV[0] =~ /^-/) {
$_ = shift(@ARGV);
if (/^-acc$/) { $use_acc = 1; next; }
if (/^-d(ebug)?(\d+)?$/) { $debug = $2 || shift(@ARGV); next; }
if (/^-doctype$/) { $doctype = shift(@ARGV); next; }
if (/^-c(heck)?$/) { $check = 1; next; }
if (/^-e(xpandinfo)?$/) { $expandinfo = 1; next; }
if (/^-g(lossary)?$/) { $use_glossary = 1; next; }
if (/^-i(nvisible)?$/) { $invisible_mark = shift(@ARGV); next; }
if (/^-iso$/) { $use_iso = 1; next; }
if (/^-I(.+)?$/) { push(@include_dirs, $1 || shift(@ARGV)); next; }
if (/^-m(enu)?$/) { $show_menu = 1; next; }
if (/^-mono(lithic)?$/) { $monolithic = 1; next; }
if (/^-n(umber)?$/) { $number_sections = 1; next; }
if (/^-s(plit)?_?(n(ode)?|c(hapter)?)?$/) {
if ($2 =~ /^n/) {
$split_node = 1;
} else {
$split_chapter = 1;
}
next;
}
if (/^-v(erbose)?$/) { $verbose = 1; next; }
die $usage;
}
if ($check) {
die $usage unless @ARGV > 0;
✓
exit;
}
if (($split_node || $split_chapter) && $monolithic) {
warn "Can't use -monolithic with -split, -monolithic ignored.\n";
$monolithic = 0;
}
if ($expandinfo) {
$to_skip{'ifinfo'}++;
$to_skip{'end ifinfo'}++;
} else {
$to_skip{'iftex'}++;
$to_skip{'end iftex'}++;
}
$invisible_mark = '\n", __LINE__));
&html_push_if('DL');
push(@lines, &html_debug("\n", __LINE__));
} elsif (/^\@multitable\s+/) {
# Note descent to HTML 3.2 necessary for multitable.
$in_table = ' ';
unshift(@tables, join($;, $table_type, $in_table));
push(@lines, &debug("\n", __LINE__));
&html_push_if('TABLE');
push(@lines, &html_debug("\n", __LINE__));
} else {
warn "$ERROR Bad table line: $_";
}
next;
} elsif ($tag eq 'synindex' || $tag eq 'syncodeindex') {
if (/^\@$tag\s+(\w)\w\s+(\w)\w\s*$/) {
eval("*${1}index = *${2}index");
} else {
warn "$ERROR Bad syn*index line: $_";
}
next;
} elsif ($tag eq 'sp') {
push(@lines, &debug("\n", __LINE__));
next;
} elsif ($tag eq 'anchor') {
if (/^\@$tag\s*{($NODERE)}\s*$/) {
$anchor = $1;
push(@lines,&debug("
", __LINE__);
} else {
$_ = &debug(" \n", __LINE__);
}
if ($tag eq 'deffn' || $tag eq 'defvr' || $tag eq 'deftp') {
$_ .= "$type $name ";
$_ .= " @args " if @args;
} elsif ($tag eq 'deftypefn' || $tag eq 'deftypevr'
|| $tag eq 'defcv' || $tag eq 'defop') {
$ftype = $name;
$name = shift(@args);
$name =~ s/^\{(.*)\}$/$1/;
$_ .= "$type $ftype $name ";
$_ .= " @args " if @args;
} else {
warn "$ERROR Unknown definition type: $tag\n";
$_ .= "$type $name ";
$_ .= " @args " if @args;
}
$_ .= &debug("\n ", __LINE__);
$name = &unprotect_html($name);
if ($tag eq 'deffn' || $tag eq 'deftypefn') {
unshift(@input_spool, "\@findex $name\n");
} elsif ($tag eq 'defop') {
unshift(@input_spool, "\@findex $name on $ftype\n");
} elsif ($tag eq 'defvr' || $tag eq 'deftypevr' || $tag eq 'defcv') {
unshift(@input_spool, "\@vindex $name\n");
} else {
unshift(@input_spool, "\@tindex $name\n");
}
$dont_html = 1;
}
} elsif ($end_tag) {
if ($format_map{$end_tag}) {
$in_pre = 0 if $format_map{$end_tag} eq 'PRE';
$in_list-- if $format_map{$end_tag} eq 'UL' || $format_map{$end_tag} eq 'OL' ;
&html_pop_if('LI', 'P');
&html_pop_if();
push(@lines, &debug("\n", __LINE__));
push(@lines, &html_debug("\n", __LINE__));
} elsif ($end_tag eq 'table' ||
$end_tag eq 'ftable' ||
$end_tag eq 'vtable' ||
$end_tag eq 'multitable') {
shift(@tables);
if (@tables) {
($table_type, $in_table) = split($;, $tables[0]);
} else {
$in_table = 0;
}
if ($end_tag eq 'multitable') {
push(@lines, "
\n");
&html_pop_if('TABLE');
} else {
push(@lines, " \n");
&html_pop_if('DD');
}
&html_pop_if();
} elsif (defined($def_map{$end_tag})) {
push(@lines, &debug("\n", __LINE__));
} elsif ($end_tag eq 'menu') {
&html_pop_if();
push(@lines, $_); # must keep it for pass 2
}
next;
}
#
# misc things
#
# protect texi and HTML things
&protect_texi;
$_ = &protect_html($_) unless $dont_html;
$dont_html = 0;
# substitution (unsupported things)
s/^\@center\s+//g; # fixme: use or ?
s/^\@exdent\s+//g;
s/\@noindent\s+//g;
s/\@refill\s+//g;
# other substitutions
&simple_substitutions;
s/\@value{($VARRE)}/$value{$1}/eg;
s/\@footnote\{/\@footnote$docu_doc\{/g; # mark footnotes, cf. pass 4
s/\@image\{([^,\}]+)[^\}]*\}/\
/g;
#
# analyze the tag again
#
if ($tag) {
if (defined($sec2level{$tag}) && $sec2level{$tag} > 0) {
if (/^\@$tag\s+(.+)$/) {
$name = $1;
$name =~ s/\s+$//;
$level = $sec2level{$tag};
$name = &update_sec_num($tag, $level) . " $name"
if $number_sections && $tag !~ /^unnumbered/;
if ($tag =~ /heading$/) {
push(@lines, &html_debug("\n", __LINE__));
if ($html_element ne 'body') {
# We are in a nice pickle here. We are trying to get a H? heading
# even though we are not in the body level. So, we convert it to a
# nice, bold, line by itself.
$_ = &debug("\n\n
$name
\n\n", __LINE__);
} else {
$_ = &debug("
$name \n", __LINE__);
&html_push_if('body');
}
print "# heading, section $name, level $level\n"
if $debug & $DEBUG_TOC;
} else {
if ($split_chapter) {
unless ($toplevel) {
# first time we see a "section"
unless ($level == 1) {
warn "$ERROR The first section found is not of level 1: $_";
warn "$ERROR I'll split on sections of level $level...\n";
}
$toplevel = $level;
}
if ($level == $toplevel) {
&next_doc;
push(@lines, $SPLITTAG) if $split_num++;
push(@sections, $name);
}
}
$sec_num++;
$docid = "SEC$sec_num";
$tocid = "TOC$sec_num";
# check biblio and glossary
$in_bibliography = ($name =~ /^([A-Z]|\d+)?(\.\d+)*\s*bibliography$/i);
$in_glossary = ($name =~ /^([A-Z]|\d+)?(\.\d+)*\s*glossary$/i);
# check node
if ($node) {
if ($node2sec{$node}) {
warn "$ERROR Duplicate node found: $node\n";
} else {
$node2sec{$node} = $name;
$node2href{$node} = "$docu_doc#$docid";
print "# node $node, section $name, level $level\n"
if $debug & $DEBUG_TOC;
}
$node = '';
} else {
print "# no node, section $name, level $level\n"
if $debug & $DEBUG_TOC;
}
# update TOC
while ($level > $curlevel) {
$curlevel++;
push(@toc_lines, "
\n");
}
while ($level < $curlevel) {
$curlevel--;
push(@toc_lines, " \n");
}
$_ = "
" . &anchor($tocid, "$docu_doc#$docid", $name, 1);
push(@toc_lines, &substitute_style($_));
# update DOC
push(@lines, &html_debug("\n", __LINE__));
&html_reset;
$_ = "".&anchor($docid, "$docu_toc#$tocid", $name)." \n";
$_ = &debug($_, __LINE__);
push(@lines, &html_debug("\n", __LINE__));
}
# update DOC
foreach $line (split(/\n+/, $_)) {
push(@lines, "$line\n");
}
next;
} else {
warn "$ERROR Bad section line: $_";
}
} else {
# track variables
$value{$1} = $2, next if /^\@set\s+($VARRE)\s+(.*)$/o;
delete $value{$1}, next if /^\@clear\s+($VARRE)\s*$/o;
# store things
$value{'_setfilename'} = $1, next if /^\@setfilename\s+(.*)$/;
$value{'_settitle'} = $1, next if /^\@settitle\s+(.*)$/;
$value{'_author'} .= "$1\n", next if /^\@author\s+(.*)$/;
$value{'_subtitle'} .= "$1\n", next if /^\@subtitle\s+(.*)$/;
$value{'_title'} .= "$1\n", next if /^\@title\s+(.*)$/;
# index
if (/^\@(..?)index\s+/) {
unless ($valid_index{$1}) {
warn "$ERROR Undefined index command: $_";
next;
}
$id = 'IDX' . ++$idx_num;
$index = $1 . 'index';
$what = &substitute_style($');
$what =~ s/\s+$//;
print "# found $index for '$what' id $id\n"
if $debug & $DEBUG_INDEX;
eval(<\n", __LINE__));
push(@lines, &anchor($id, '', $invisible_mark, !$in_pre));
&html_push('P');
} elsif ($html_element eq 'DL' ||
$html_element eq 'UL' ||
$html_element eq 'OL' ) {
$deferred_ref .= &anchor($id, '', $invisible_mark, !$in_pre) . " ";
}
next;
}
# list item
if (/^\@itemx?\s+/) {
$what = $';
$what =~ s/\s+$//;
if ($in_bibliography && $use_bibliography) {
if ($what =~ /^$BIBRE$/o) {
$id = 'BIB' . ++$bib_num;
$bib2href{$what} = "$docu_doc#$id";
print "# found bibliography for '$what' id $id\n"
if $debug & $DEBUG_BIB;
$what = &anchor($id, '', $what);
}
} elsif ($in_glossary && $use_glossary) {
$id = 'GLOSS' . ++$gloss_num;
$entry = $what;
$entry =~ tr/A-Z/a-z/ unless $entry =~ /^[A-Z\s]+$/;
$gloss2href{$entry} = "$docu_doc#$id";
print "# found glossary for '$entry' id $id\n"
if $debug & $DEBUG_GLOSS;
$what = &anchor($id, '', $what);
}
&html_pop_if('P');
if ($html_element eq 'DL' || $html_element eq 'DD') {
if ($things_map{$in_table} && !$what) {
# special case to allow @table @bullet for instance
push(@lines, &debug("$things_map{$in_table}\n", __LINE__));
} else {
push(@lines, &debug("\@$in_table\{$what\}\n", __LINE__));
}
push(@lines, " ");
&html_push('DD') unless $html_element eq 'DD';
if ($table_type) { # add also an index
unshift(@input_spool, "\@${table_type}index $what\n");
}
} elsif ($html_element eq 'TABLE' || $html_element eq 'TR') {
# Add $what");
&html_push('TR') unless $html_element eq 'TR';
} else {
push(@lines, &debug("$what\n", __LINE__));
&html_push('LI') unless $html_element eq 'LI';
}
push(@lines, &html_debug("\n", __LINE__));
if ($deferred_ref) {
push(@lines, &debug("$deferred_ref\n", __LINE__));
$deferred_ref = '';
}
next;
}
}
}
# paragraph separator
if ($_ eq "\n") {
next if $#lines >= 0 && $lines[$#lines] eq "\n";
if ($html_element eq 'P') {
push(@lines, "\n");
$_ = &debug("\n", __LINE__);
&html_pop;
}
} elsif ($html_element eq 'body' || $html_element eq 'BLOCKQUOTE') {
push(@lines, "\n");
&html_push('P');
$_ = &debug($_, __LINE__);
}
# otherwise
push(@lines, $_);
}
# finish TOC
$level = 0;
while ($level < $curlevel) {
$curlevel--;
push(@toc_lines, "\n");
}
print "# end of pass 1\n" if $verbose;
#+++############################################################################
# #
# Pass 2/3: handle style, menu, index, cross-reference #
# #
#---############################################################################
@lines2 = (); # whole document (2nd pass)
@lines3 = (); # whole document (3rd pass)
$in_menu = 0; # am I inside a menu
$in_top = 1;
while (@lines) {
$_ = shift(@lines);
#
# special case (protected sections)
#
if (/^$PROTECTTAG/o) {
push(@lines2, $_);
next;
}
if ($in_top && $_ eq "$TOPTAG") {
$in_top = 0;
@top_lines = @lines2; # Contents of the top node.
@lines2 = (); # Don't use them in place.
next;
}
#
# menu
#
$in_menu = 1, push(@lines2, &debug("
\n", __LINE__)), next if /^\@menu\b/;
$in_menu = 0, push(@lines2, &debug(" \n", __LINE__)), next if /^\@end\s+menu\b/;
if ($in_menu) {
if (/^\*\s+($NODERE)::/o) {
$descr = $';
chop($descr);
&menu_entry($1, $1, $descr);
} elsif (/^\*\s+(.+):\s+([^\t,\.\n]+)[\t,\.\n]/) {
$descr = $';
chop($descr);
&menu_entry($1, $2, $descr);
} elsif (/^\*/) {
warn "$ERROR Bad menu line: $_";
} else { # description continued?
push(@lines2, $_);
}
next;
}
#
# printindex
#
if (/^\@printindex\s+(\w\w)\b/) {
local($index, *ary, @keys, $key, $letter, $last_letter, @refs);
if ($predefined_index{$1}) {
$index = $predefined_index{$1} . 'index';
} else {
$index = $1 . 'index';
}
eval("*ary = *$index");
@keys = keys(%ary);
foreach $key (@keys) {
$_ = $key;
1 while s/<(\w+)>\`(.*)\'<\/\1>/$2/; # remove HTML tags with quotes
1 while s/<(\w+)>(.*)<\/\1>/$2/; # remove HTML tags
$_ = &unprotect_html($_);
&unprotect_texi;
tr/A-Z/a-z/; # lowercase
$key2alpha{$key} = $_;
print "# index $key sorted as $_\n"
if $key ne $_ && $debug & $DEBUG_INDEX;
}
$last_letter = undef;
foreach $key (sort byalpha @keys) {
$letter = substr($key2alpha{$key}, 0, 1);
$letter = substr($key2alpha{$key}, 0, 2) if $letter eq $;;
if (!defined($last_letter) || $letter ne $last_letter) {
push(@lines2, "\n") if defined($last_letter);
push(@lines2, "" . &protect_html($letter) . " \n");
push(@lines2, "\n");
$last_letter = $letter;
}
@refs = ();
foreach (split(/$;/, $ary{$key})) {
push(@refs, &anchor('', $_, $key, 0));
}
push(@lines2, "" . join(", ", @refs) . "\n");
}
push(@lines2, " \n") if defined($last_letter);
next;
}
#
# simple style substitutions
#
$_ = &substitute_style($_);
#
# xref
#
while (/\@(x|px|info|)ref{($XREFRE)(}?)/o) {
# note: Texinfo may accept other characters
($type, $nodes, $full) = ($1, $2, $3);
($before, $after) = ($`, $');
if (! $full && $after) {
warn "$ERROR Bad xref (no ending } on line): $_";
$_ = "$before$;0${type}ref\{$nodes$after";
next; # while xref
}
if ($type eq 'x') {
$type = 'See ';
} elsif ($type eq 'px') {
$type = 'see ';
} elsif ($type eq 'info') {
$type = 'See Info';
} else {
$type = '';
}
unless ($full) {
$next = shift(@lines);
$next = &substitute_style($next);
chop($nodes); # remove final newline
if ($next =~ /\}/) { # split on 2 lines
$nodes .= " $`";
$after = $';
} else {
$nodes .= " $next";
$next = shift(@lines);
$next = &substitute_style($next);
chop($nodes);
if ($next =~ /\}/) { # split on 3 lines
$nodes .= " $`";
$after = $';
} else {
warn "$ERROR Bad xref (no ending }): $_";
$_ = "$before$;0xref\{$nodes$after";
unshift(@lines, $next);
next; # while xref
}
}
}
$nodes =~ s/\s+/ /g; # remove useless spaces
@args = split(/\s*,\s*/, $nodes);
$node = $args[0]; # the node is always the first arg
&normalise_node($node);
$sec = $node2sec{$node};
$href = $anchor2href{$node};
if (@args == 5) { # reference to another manual
$sec = $args[2] || $node;
$man = $args[4] || $args[3];
$_ = "${before}${type}section `$sec' in \@cite{$man}$after";
} elsif ($type =~ /Info/) { # inforef
warn "$ERROR Wrong number of arguments: $_" unless @args == 3;
($nn, $_, $in) = @args;
$_ = "${before}${type} file `$in', node `$nn'$after";
} elsif ($sec) {
$href = $node2href{$node};
$_ = "${before}${type}section " . &anchor('', $href, $sec) . $after;
} elsif ($href) {
$_ = "${before}${type} " . &anchor('', $href, $node) . $after;
} else {
warn "$ERROR Undefined node ($node) href=$href: $_";
$_ = "$before$;0xref{$nodes}$after";
}
}
#
# try to guess bibliography references or glossary terms
#
unless (/^/) {
$done .= $pre . &anchor('', $href, $what);
} else {
$done .= "$pre$what";
}
$_ = $post;
}
$_ = $done . $_;
}
if ($use_glossary) {
$done = '';
while (/\b\w+\b/) {
($pre, $what, $post) = ($`, $&, $');
$entry = $what;
$entry =~ tr/A-Z/a-z/ unless $entry =~ /^[A-Z\s]+$/;
$href = $gloss2href{$entry};
if (defined($href) && $post !~ /^[^<]*<\/A>/) {
$done .= $pre . &anchor('', $href, $what);
} else {
$done .= "$pre$what";
}
$_ = $post;
}
$_ = $done . $_;
}
}
# otherwise
push(@lines2, $_);
}
print "# end of pass 2\n" if $verbose;
#
# split style substitutions
#
while (@lines2) {
$_ = shift(@lines2);
#
# special case (protected sections)
#
if (/^$PROTECTTAG/o) {
push(@lines3, $_);
next;
}
#
# split style substitutions
#
$old = '';
while ($old ne $_) {
$old = $_;
if (/\@(\w+)\{/) {
($before, $style, $after) = ($`, $1, $');
if (defined($style_map{$style})) {
$_ = $after;
$text = '';
$after = '';
$failed = 1;
while (@lines2) {
if (/\}/) {
$text .= $`;
$after = $';
$failed = 0;
last;
} else {
$text .= $_;
$_ = shift(@lines2);
}
}
if ($failed) {
die "* Bad syntax (\@$style) after: $before\n";
} else {
$text = &apply_style($style, $text);
$_ = "$before$text$after";
}
}
}
}
# otherwise
push(@lines3, $_);
}
print "# end of pass 3\n" if $verbose;
#+++############################################################################
# #
# Pass 4: foot notes, final cleanup #
# #
#---############################################################################
@foot_lines = (); # footnotes
@doc_lines = (); # final document
$end_of_para = 0; # true if last line is
while (@lines3) {
$_ = shift(@lines3);
#
# special case (protected sections)
#
if (/^$PROTECTTAG/o) {
push(@doc_lines, $_);
$end_of_para = 0;
next;
}
#
# footnotes
#
while (/\@footnote([^\{\s]+)\{/) {
($before, $d, $after) = ($`, $1, $');
$_ = $after;
$text = '';
$after = '';
$failed = 1;
while (@lines3) {
if (/\}/) {
$text .= $`;
$after = $';
$failed = 0;
last;
} else {
$text .= $_;
$_ = shift(@lines3);
}
}
if ($failed) {
die "* Bad syntax (\@footnote) after: $before\n";
} else {
$foot_num++;
$docid = "DOCF$foot_num";
$footid = "FOOT$foot_num";
$foot = "($foot_num)";
push(@foot_lines, "
" . &anchor($footid, "$d#$docid", $foot) . " \n");
$text = "$text" unless $text =~ /^\s*
/;
push(@foot_lines, "$text\n");
$_ = $before . &anchor($docid, "$docu_foot#$footid", $foot) . $after;
}
}
#
# remove unnecessary
#
if (/^\s*
\s*$/) {
next if $end_of_para++;
} else {
$end_of_para = 0;
}
# otherwise
push(@doc_lines, $_);
}
print "# end of pass 4\n" if $verbose;
#+++############################################################################
# #
# Pass 5: print things #
# #
#---############################################################################
$header = <
EOT
$full_title = $value{'_title'} || $value{'_settitle'} || "Untitled Document";
$title = $value{'_settitle'} || $full_title;
$_ = &substitute_style($full_title);
&unprotect_texi;
s/\n$//; # rmv last \n (if any)
$full_title = "" . join(" \n", split(/\n/, $_)) . " \n";
#
# print ToC
#
# ... unless using menus instead. Make the TOC lines empty rather than
# null so we get a ToC page with the top node (including menu).
@toc_lines = ("") if $show_menu;
if (!$monolithic && @toc_lines) {
if (open(FILE, "> $docu_toc")) {
print "# creating $docu_toc...\n" if $verbose;
&print_toplevel_header("$title - Table of Contents");
&print_ruler;
&print (*top_lines, FILE); # Contents of the top node before the TOC.
&print(*toc_lines, FILE);
&print_toplevel_footer;
close(FILE);
} else {
warn "$ERROR Can't write to $docu_toc: $!\n";
}
}
#
# print footnotes
#
if (!$monolithic && @foot_lines) {
if (open(FILE, "> $docu_foot")) {
print "# creating $docu_foot...\n" if $verbose;
&print_toplevel_header("$title - Footnotes");
&print_ruler;
&print(*foot_lines, FILE);
&print_toplevel_footer;
close(FILE);
} else {
warn "$ERROR Can't write to $docu_foot: $!\n";
}
}
#
# print document
#
if ($split_chapter || $split_node) { # split
$doc_num = 0;
$last_num = scalar(@sections);
$first_doc = &doc_name(1);
$last_doc = &doc_name($last_num);
while (@sections) {
$section = shift(@sections);
&next_doc;
if (open(FILE, "> $docu_doc")) {
print "# creating $docu_doc...\n" if $verbose;
$prev_doc = ($doc_num == 1 ? undef : &doc_name($doc_num - 1));
$next_doc = ($doc_num == $last_num ? undef : &doc_name($doc_num + 1));
$links = ($next_doc ? "Go to the ";
$navigation .= ($prev_doc ? &anchor('', $first_doc, "first") : "first");
$navigation .= ", ";
$navigation .= ($prev_doc ? &anchor('', $prev_doc, "previous") : "previous");
$navigation .= ", ";
$navigation .= ($next_doc ? &anchor('', $next_doc, "next") : "next");
$navigation .= ", ";
$navigation .= ($next_doc ? &anchor('', $last_doc, "last") : "last");
$navigation .= " section, " . &anchor('', $docu_toc, "table of contents") . ".\n";
print FILE $navigation;
&print_ruler;
# find corresponding lines
@tmp_lines = ();
while (@doc_lines) {
$_ = shift(@doc_lines);
last if ($_ eq $SPLITTAG);
push(@tmp_lines, $_);
}
&print(*tmp_lines, FILE);
&print_ruler;
print FILE $navigation;
&print_footer;
close(FILE);
} else {
warn "$ERROR Can't write to $docu_doc: $!\n";
}
}
} else { # not split
if (open(FILE, "> $docu_doc")) {
print "# creating $docu_doc...\n" if $verbose;
if ($monolithic || !@toc_lines) {
&print_toplevel_header($title);
} else {
&print_header($title, "");
print FILE $full_title;
}
if ($monolithic && @toc_lines) {
&print_ruler;
print FILE "
Table of Contents \n";
&print(*toc_lines, FILE);
}
&print_ruler;
&print(*doc_lines, FILE);
if ($monolithic && @foot_lines) {
&print_ruler;
print FILE "Footnotes \n";
&print(*foot_lines, FILE);
}
if ($monolithic || !@toc_lines) {
&print_toplevel_footer;
} else {
&print_footer;
}
close(FILE);
} else {
warn "$ERROR Can't write to $docu_doc: $!\n";
}
}
print "# that's all folks\n" if $verbose;
#+++############################################################################
# #
# Low level functions #
# #
#---############################################################################
sub update_sec_num {
local($name, $level) = @_;
$level--; # here we start at 0
if ($name =~ /^appendix/) {
# appendix style
if (defined(@appendix_sec_num)) {
&incr_sec_num($level, @appendix_sec_num);
} else {
@appendix_sec_num = ('A', 0, 0, 0);
}
return(join('.', @appendix_sec_num[0..$level]));
} else {
# normal style
if (defined(@normal_sec_num)) {
&incr_sec_num($level, @normal_sec_num);
} else {
@normal_sec_num = (1, 0, 0, 0);
}
return(join('.', @normal_sec_num[0..$level]));
}
}
sub incr_sec_num {
local($level, $l);
$level = shift(@_);
$_[$level]++;
foreach $l ($level+1 .. 3) {
$_[$l] = 0;
}
}
sub check {
local($_, %seen, %context, $before, $match, $after);
while (<>) {
if (/\@(\*|\.|\:|\@|\{|\})/) {
$seen{$&}++;
$context{$&} .= "> $_" if $verbose;
$_ = "$`XX$'";
redo;
}
if (/\@(\w+)/) {
($before, $match, $after) = ($`, $&, $');
if ($before =~ /\b[\w-]+$/ && $after =~ /^[\w-.]*\b/) { # e-mail address
$seen{'e-mail address'}++;
$context{'e-mail address'} .= "> $_" if $verbose;
} else {
$seen{$match}++;
$context{$match} .= "> $_" if $verbose;
}
$match =~ s/^\@/X/;
$_ = "$before$match$after";
redo;
}
}
foreach (sort(keys(%seen))) {
if ($verbose) {
print "$_\n";
print $context{$_};
} else {
print "$_ ($seen{$_})\n";
}
}
}
sub open {
local($name) = @_;
++$fh_name;
if (open($fh_name, $name)) {
unshift(@fhs, $fh_name);
} else {
warn "$ERROR Can't read file $name: $!\n";
}
}
sub init_input {
@fhs = (); # hold the file handles to read
@input_spool = (); # spooled lines to read
$fh_name = 'FH000';
&open($docu);
}
sub next_line {
local($fh, $line);
if (@input_spool) {
$line = shift(@input_spool);
return($line);
}
while (@fhs) {
$fh = $fhs[0];
$line = <$fh>;
return($line) if $line;
close($fh);
shift(@fhs);
}
return(undef);
}
# used in pass 1, use &next_line
sub skip_until {
local($tag) = @_;
local($_);
while ($_ = &next_line) {
return if /^\@end\s+$tag\s*$/;
}
die "* Failed to find '$tag' after: " . $lines[$#lines];
}
#
# HTML stacking to have a better HTML output
#
sub html_reset {
@html_stack = ('html');
$html_element = 'body';
}
sub html_push {
local($what) = @_;
push(@html_stack, $html_element);
$html_element = $what;
}
sub html_push_if {
local($what) = @_;
push(@html_stack, $html_element)
if ($html_element && $html_element ne 'P');
$html_element = $what;
}
sub html_pop {
$html_element = pop(@html_stack);
}
sub html_pop_if {
local($elt);
if (@_) {
foreach $elt (@_) {
if ($elt eq $html_element) {
$html_element = pop(@html_stack) if @html_stack;
last;
}
}
} else {
$html_element = pop(@html_stack) if @html_stack;
}
}
sub html_debug {
local($what, $line) = @_;
return("$what")
if $debug & $DEBUG_HTML;
return($what);
}
# to debug the output...
sub debug {
local($what, $line) = @_;
return("$what")
if $debug & $DEBUG_HTML;
return($what);
}
sub normalise_node {
$_[0] =~ s/\s+/ /g;
$_[0] =~ s/ $//;
$_[0] =~ s/^ //;
}
sub menu_entry {
local($entry, $node, $descr) = @_;
local($href);
&normalise_node($node);
$href = $node2href{$node};
if ($href) {
$descr =~ s/^\s+//;
$descr = ": $descr" if $descr;
push(@lines2, "" . &anchor('', $href, $entry) . "$descr\n");
} else {
warn "$ERROR Undefined node ($node): $_";
}
}
sub do_email { "<" . &anchor('', "mailto:$_[0]", "$_[0] ") . ">" }
sub do_url { &anchor('', "$_[0]", "$_[0] ") }
sub do_ctrl { "^$_[0]" }
sub do_sc { "\U$_[0]\E" }
sub apply_style {
local($texi_style, $text) = @_;
local($style);
$style = $style_map{$texi_style};
if (defined($style)) { # known style
if ($style =~ /^\"/) { # add quotes
$style = $';
$text = "\`$text\'";
}
if ($style =~ /^\&/) { # custom
$style = $';
$text = &$style($text);
} elsif ($style) { # good style
$text = "<$style>$text";
} else { # no style
}
} else { # unknown style
$text = undef;
}
return($text);
}
# remove Texinfo styles
sub remove_style {
local($_) = @_;
s/\@\w+{([^\{\}]+)}/$1/g;
return($_);
}
sub substitute_style {
local($_) = @_;
local($changed, $done, $style, $text);
$changed = 1;
while ($changed) {
$changed = 0;
$done = '';
while (/\@(\w+){([^\{\}]+)}/) {
$text = &apply_style($1, $2);
if ($text) {
$_ = "$`$text$'";
$changed = 1;
} else {
$done .= "$`\@$1";
$_ = "{$2}$'";
}
}
$_ = $done . $_;
}
return($_);
}
sub anchor {
local($name, $href, $text, $newline) = @_;
local($result);
$result = "\n";
}
sub print_header {
local($_);
$links = $_[1];
# clean the title
$_ = &remove_style($_[0]);
&unprotect_texi;
# print the header
if ($doctype eq 'html2') {
print FILE $html2_doctype; # Wrong if any multitable used
} elsif ($doctype) {
print FILE $doctype;
}
print FILE <
$header
$_
$links
EOT
}
sub print_toplevel_header {
local($_);
&print_header ($_[0], "");
print FILE $full_title;
if ($value{'_subtitle'}) {
$value{'_subtitle'} =~ s/\n+$//;
foreach (split(/\n/, $value{'_subtitle'})) {
$_ = &substitute_style($_);
&unprotect_texi;
print FILE "$_ \n";
}
}
if ($value{'_author'}) {
$value{'_author'} =~ s/\n+$//;
foreach (split(/\n/, $value{'_author'})) {
$_ = &substitute_style($_);
&unprotect_texi;
# s/[\w.-]+\@[\w.-]+/$&<\/A>/g;
print FILE "$_ \n";
}
}
print FILE "\n";
}
sub print_footer {
print FILE <
EOT
}
sub print_toplevel_footer {
&print_ruler;
print FILE <texi2html
translator version 1.51a.
EOT
&print_footer;
}
sub protect_texi {
# protect @ { } ` '
s/\@\@/$;0/go;
s/\@\{/$;1/go;
s/\@\}/$;2/go;
s/\@\`/$;3/go;
s/\@\'/$;4/go;
}
sub protect_html {
local($what) = @_;
# protect & < >
$what =~ s/\&/\&\#38;/g;
$what =~ s/\/\&\#62;/g;
# but recognize some HTML things
$what =~ s/\&\#60;\/A\&\#62;/<\/A>/g; #
$what =~ s/\&\#60;A ([^\&]+)\&\#62;//g; #
$what =~ s/\&\#60;IMG ([^\&]+)\&\#62;/