#!/usr/bin/perl
'di ';
'ig 00 ';
# $Id: texi2html,v 1.7 1998-06-19 15:55:28 obachman Exp $
# Description: Program to transform most Texinfo documents to HTML.
# The plan is for the next version of makeinfo to support HTML output
# directly, but until then ...
$THISPROG = "texi2html 1.54"; # 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.
# 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 s for Up, Index, Glossary?
# Inserting copyright links: Having texinfo markup for the online copyright
# would allow a link to that from wherever.
#+++############################################################################
# #
# Constants #
# #
#---############################################################################
$DEBUG_TOC = 1;
$DEBUG_INDEX = 2;
$DEBUG_BIB = 4;
$DEBUG_GLOSS = 8;
$DEBUG_DEF = 16;
$DEBUG_HTML = 32;
$DEBUG_USER = 64;
#$IMG_FIRST_ACTIVE = "";
#$IMG_FIRST_PASSIVE = "";
#$IMG_LAST_ACTIVE = "";
#$IMG_LAST_PASSIVE = "";
#$IMG_NEXT_ACTIVE = "";
#$IMG_NEXT_PASSIVE = "";
#$IMG_PREV_ACTIVE = "";
#$IMG_PREV_PASSIVE = "";
#$IMG_TOC = "";
$IMG_FIRST_ACTIVE = "";
$IMG_FIRST_PASSIVE = "";
$IMG_LAST_ACTIVE = "";
$IMG_LAST_PASSIVE = "";
$IMG_NEXT_ACTIVE = "";
$IMG_NEXT_PASSIVE = "";
$IMG_PREV_ACTIVE = "";
$IMG_PREV_PASSIVE = "";
$IMG_TOC = "";
$IMG_LEFT = "images/bg_left.gif";
$IMG_RIGHT = "images/bg_right.gif";
$BIBRE = '\[[\w\/]+\]'; # RE for a bibliography reference
$FILERE = '[\/\w.+-]+'; # RE for a file name
$VARRE = '[^\s\{\}]+'; # RE for a variable name
$NODERE = '[^@{}:\'`",]+'; # RE for a node name
$NODESRE = '[^@{}:\'`"]+'; # RE for a list of node names
$XREFRE = '[^@{}]+'; # RE for a xref (should use NODERE)
$ERROR = "***"; # prefix for errors and warnings
$HOMEPAGE = "http://wwwcn.cern.ch/dci/texi2html/"; # program home page
$TODAY = &pretty_date; # like "20 September 1993"
$SPLITTAG = "\n"; # tag to know where to split
$PROTECTTAG = "_ThisIsProtected_"; # tag to recognize protected sections
$TOPTAG = ""; # tag to mark first node (end of preamble)
$html2_doctype = '';
#
# language dependent constants
#
#$LDC_SEE = 'see';
#$LDC_SECTION = 'section';
#$LDC_IN = 'in';
#$LDC_TOC = 'Table of Contents';
#$LDC_GOTO = 'Go to the';
#$LDC_FOOT = 'Footnotes';
# TODO: @def* shortcuts
#
# pre-defined indices
#
%predefined_index = (
'cp', 'c',
'fn', 'f',
'vr', 'v',
'ky', 'k',
'pg', 'p',
'tp', 't',
);
#
# valid indices
#
%valid_index = (
'c', 1,
'f', 1,
'v', 1,
'k', 1,
'p', 1,
't', 1,
);
#
# texinfo section names to level
#
%sec2level = (
'top', 0,
'chapter', 1,
'unnumbered', 1,
'majorheading', 1,
'chapheading', 1,
'appendix', 1,
'section', 2,
'unnumberedsec', 2,
'heading', 2,
'appendixsec', 2,
'appendixsection', 2,
'subsection', 3,
'unnumberedsubsec', 3,
'subheading', 3,
'appendixsubsec', 3,
'subsubsection', 4,
'unnumberedsubsubsec', 4,
'subsubheading', 4,
'appendixsubsubsec', 4,
);
#
# accent map, TeX command to ISO name
#
%accent_map = (
'"', 'uml',
'~', 'tilde',
'^', 'circ',
'`', 'grave',
'\'', 'acute',
',', 'cedil',
# fixme: (not Latin1) = H d dotaccent dotless ringaccent
# tieaccent u ubaraccent v
);
#
# texinfo "simple things" (@foo) to HTML ones
#
%simple_map = (
# cf. makeinfo.c
"*", "
", # HTML+
" ", " ", # nbsp
"\n", "\n",
"|", "",
# spacing commands
":", "",
"!", "!",
"?", "?",
".", ".",
"\t", " ",
"-", "", # soft hyphen
'tab', '
', # 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_l_map = (
'center', 'CENTER',
);
%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',
'image', '&do_image', # in-line images
'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_uref', # new special case
'url', '&do_url', # 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_ignore = (
'manual', 1,
'end manual', 1,
);
%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,
);
%append2num = (
'A', 1,
'B', 2,
'C', 3,
'D', 4,
'E', 5,
'F', 6,
'G', 7,
'H', 8,
'I', 9,
'J', 10,
);
#+++############################################################################
# #
# 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;
$make_entry_page = 1;
$make_menu_page = 1;
$section_type = 0;
$ignore_part = 0;
$usage = < \n", __LINE__));
next;
} elsif ($tag eq 'setref') {
&protect_html; # if setref contains '&' for instance
if (/^\@$tag\s*{($NODERE)}\s*$/) {
$setref = $1;
$setref =~ s/\s+/ /g; # normalize
$setref =~ s/ $//;
$node2sec{$setref} = $name;
$node2href{$setref} = "$docu_doc#$docid";
} else {
warn "$ERROR Bad setref line: $_";
}
next;
} elsif ($tag eq 'defindex' || $tag eq 'defcodeindex') {
if (/^\@$tag\s+(\w\w)\s*$/) {
$valid_index{$1} = 1;
} else {
warn "$ERROR Bad defindex line: $_";
}
next;
} elsif ($tag eq 'direntry') {
&skip_until ($tag);
next;
} elsif (defined($def_map{$tag})) {
if ($def_map{$tag}) {
s/^\@$tag\s+//;
$tag = $def_map{$tag};
$_ = "\@$tag $_";
$tag =~ s/\s.*//;
}
} elsif (defined($user_sub{$tag})) {
s/^\@$tag\s+//;
$sub = $user_sub{$tag};
print "# user $tag = $sub, arg: $_" if $debug & $DEBUG_USER;
if (defined(&$sub)) {
chop($_);
&$sub($_);
} else {
warn "$ERROR Bad user sub for $tag: $sub\n";
}
next;
}
if (defined($def_map{$tag})) {
s/^\@$tag\s+//;
if ($tag =~ /x$/) {
# extra definition line
$tag = $`;
$is_extra = 1;
} else {
$is_extra = 0;
}
while (/\{([^\{\}]*)\}/) {
# this is a {} construct
($before, $contents, $after) = ($`, $1, $');
# protect spaces
$contents =~ s/\s+/$;9/g;
# restore $_ protecting {}
$_ = "$before$;7$contents$;8$after";
}
@args = split(/\s+/, &protect_html($_));
foreach (@args) {
s/$;9/ /g; # unprotect spaces
s/$;7/\{/g; # ... {
s/$;8/\}/g; # ... }
}
$type = shift(@args);
$type =~ s/^\{(.*)\}$/$1/;
print "# def ($tag): {$type} ", join(', ', @args), "\n"
if $debug & $DEBUG_DEF;
$type .= ':'; # it's nicer like this
$name = shift(@args);
$name =~ s/^\{(.*)\}$/$1/;
if ($is_extra) {
$_ = &debug(" $name \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;
while(@lines2) {
$_ = shift(@lines2);
if (/\@(\w+)\ /) {
($before, $style, $after) = ($`, $1, $');
if (defined($style_l_map{$style})) {
$_ = $after;
$text = '';
$after = '';
$failed = 1;
while (@lines2) {
if (/\n/) {
$text .= $`;
$after = $';
$failed = 0;
last;
} else {
$text .= $_;
$_ = shift(@lines2);
}
}
if ($failed) {
die "* Bad syntax (\@$style) after: $before\n";
} else {
$text = &apply_l_style($style, $text);
$_ = "$before$text$after\n";
}
}
}
push(@top_lines, $_);
}
#@top_lines = @lines2; # Contents of the top node.
@lines2 = (); # Don't use them in place.
next;
}
#
# menu
#
$in_menu = 1, push(@lines2, &debug("
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, " $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;
push(@menu_lines, " \n");
#push(@menu_lines, " Go to the ";
$navigation = " ";
if ($IMG_FIRST_ACTIVE ne "") {
$navigation .= ($prev_doc ? &anchor('', $first_doc, '',
$IMG_FIRST_ACTIVE) : $IMG_FIRST_PASSIVE);
$navigation .= " ";
}
$navigation .= ($prev_doc ? &anchor('', $prev_doc, '', $IMG_PREV_ACTIVE) : $IMG_PREV_PASSIVE);
$navigation .= " ";
$navigation .= ($next_doc ? &anchor('', $next_doc, '', $IMG_NEXT_ACTIVE) : $IMG_NEXT_PASSIVE);
if ($IMG_LAST_ACTIVE ne "") {
$navigation .= " ";
$navigation .= ($next_doc ? &anchor('', $last_doc, '',
$IMG_LAST_ACTIVE) : $IMG_LAST_PASSIVE);
}
#$navigation .= " section, " . &anchor('', $docu_toc, '', "") . ".\n";
$navigation .= " " . &anchor('', $docu_toc, '', $IMG_TOC) . "\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, "", 0);
print FILE $full_title;
}
if ($monolithic && @toc_lines) {
&print_ruler;
print FILE " \n");
} else {
warn "$ERROR Undefined node ($node): $_";
}
}
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, " \n";
}
sub print_frame {
print FILE < \n";
}
sub print_footer {
print FILE <\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");
&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 \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");
&html_pop_if('TABLE');
} else {
push(@lines, "\n
\n");
}
while ($level < $curlevel) {
$curlevel--;
push(@toc_lines, "
\n");
}
$_ = "
at ends of rows for non-tables browsers.
push(@lines, "
\n") if $html_element eq 'TR';
push(@lines, "$what");
&html_push('TR') unless $html_element eq 'TR';
} else {
push(@lines, &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, "" . &anchor($footid, "$d#$docid", '', $foot) . "
\n");
$text = "\n");
foreach (@left_index) {
$entry = $_;
@part = split(/\ /);
$name = join(' ', @part[1..$#part]);
if (!/^[A-Z0-9]\./) {
&left_menu_entry($part[0], $name);
}
}
push(@menu_lines, "
\n");
print "# end of pass 5\n" if $verbose;
#+++############################################################################
# #
# Pass 6: print things #
# #
#---############################################################################
$header = <" . 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_header("$title - Table of Contents", "", 0);
# &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";
}
}
#
#
#
if (!$monolithic && $make_entry_page) {
if(open(FILE, "> $docu_main")) {
&print_header("$title - $docu_name", "", 1);
print "# creating $docu_main...\n" if $verbose;
#&print_frame($docu_name . "_1.html");
&print_frame($docu_toc);
&print_toplevel_footer;
close(FILE);
} else {
warn "$ERROR Can't write to $docu_main: $!\n";
}
}
#
#
#
if (!$monolithic && $make_menu_page && @menu_lines) {
if(open(FILE, "> $docu_left")) {
&print_header("$title - $docu_left", "", 1);
print "# creating $docu_left...\n" if $verbose;
&print(*menu_lines, FILE);
&print_footer;
close(FILE);
} else {
warn "$ERROR Can't write to $docu_main: $!\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 ? "\n" : "");
$links .= ($prev_doc ? "\n" : "");
$links .= "\n";
# fixme: try rel=Index too?
&print_header("$title - $section", $links, 0);
#$navigation = "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/) || ($section_type)) {
# appendix style
$section_type = 1;
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
$section_type = 0;
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 left_menu_entry {
local($secnum, $entry) = @_;
local($_);
local($href, $descr, $oltype,$value);
$_ = $secnum;
$value = $secnum;
if (/[A-Z]/) {
$oltype = "
";
}
sub do_uref {
my($href,$text);
($href,$text) = split(/,/,"$_[0]");
$text =~ s/(^\s+)|(\s+$)//; # trim leading and trailing white space
$text = $href unless $text;
# args to anchor() are: ($name, $href, $text, $newline)
&anchor('', "$href", '', "$text")
}
sub do_url {
my($address,$text);
($address,$text) = split(/,/, "$_[0]");
$text =~ s/(^\s+)|(\s+$)//; # trim leading and trailing white space
$text = $address unless $text;
$address =~ s///g;
&anchor('', "${address}", '_parent', "${text}")
}
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$style>";
} else { # no style
}
} else { # unknown style
$text = undef;
}
return($text);
}
sub apply_l_style {
local($texi_style, $text) = @_;
local($style);
$style = $style_l_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$style>";
} 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, $target, $text, $newline) = @_;
local($result);
$result = "$_
\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 "Modified by the Singular-Team 19.6.1998
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/\\&\#60;/g;
$what =~ s/\>/\&\#62;/g;
# but recognize some HTML things
$what =~ s/\&\#60;\/A\&\#62;/<\/A>/g; #