![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to texi2html-eg CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM_contrib2 / windows / help|
Return to texi2html-eg CVS log | Up to [local] / OpenXM_contrib2 / windows / help |
1.1 noro 1: #!/usr/bin/perl
2: #+##############################################################################
3: # #
4: # File: texi2html #
5: # #
6: # Description: Program to transform most Texinfo documents to HTML #
7: # #
8: #-##############################################################################
9:
10: # @(#)texi2html 1.52 01/05/98 Written (mainly) by Lionel Cons, Lionel.Cons@cern.ch
11:
12: # Please read the copyright at the end of the man page.
13:
14: #+++############################################################################
15: # #
16: # Constants #
17: # #
18: #---############################################################################
19:
20: $DEBUG_TOC = 1;
21: $DEBUG_INDEX = 2;
22: $DEBUG_BIB = 4;
23: $DEBUG_GLOSS = 8;
24: $DEBUG_DEF = 16;
25: $DEBUG_HTML = 32;
26: $DEBUG_USER = 64;
27:
28: $BIBRE = '\[[\w\/-]+\]'; # RE for a bibliography reference
29: $FILERE = '[\/\w.+-]+'; # RE for a file name
30: $VARRE = '[^\s\{\}]+'; # RE for a variable name
31: $NODERE = '[^@{}:\'`",]+'; # RE for a node name
32: $NODESRE = '[^@{}:\'`"]+'; # RE for a list of node names
33: $XREFRE = '[^@{}]+'; # RE for a xref (should use NODERE)
34:
35: $ERROR = "***"; # prefix for errors and warnings
36: $THISPROG = "texi2html 1.52"; # program name and version
37: $HOMEPAGE = "http://wwwinfo.cern.ch/dis/texi2html/"; # program home page
38: $TODAY = &pretty_date; # like "20 September 1993"
39: $SPLITTAG = "<!-- SPLIT HERE -->\n"; # tag to know where to split
40: $PROTECTTAG = "_ThisIsProtected_"; # tag to recognize protected sections
41: $html2_doctype = '<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML 2.0 Strict Level 2//EN">';
42:
43: #
44: # language dependent constants
45: #
46: #$LDC_SEE = 'see';
47: #$LDC_SECTION = 'section';
48: #$LDC_IN = 'in';
49: #$LDC_TOC = 'Table of Contents';
50: #$LDC_GOTO = 'Go to the';
51: #$LDC_FOOT = 'Footnotes';
52: # TODO: @def* shortcuts
53:
54: #
55: # pre-defined indices
56: #
57: %predefined_index = (
58: 'cp', 'c',
59: 'fn', 'f',
60: 'vr', 'v',
61: 'ky', 'k',
62: 'pg', 'p',
63: 'tp', 't',
64: );
65:
66: #
67: # valid indices
68: #
69: %valid_index = (
70: 'c', 1,
71: 'f', 1,
72: 'v', 1,
73: 'k', 1,
74: 'p', 1,
75: 't', 1,
76: );
77:
78: #
79: # texinfo section names to level
80: #
81: %sec2level = (
82: 'top', 0,
83: 'chapter', 1,
84: 'unnumbered', 1,
85: 'majorheading', 1,
86: 'chapheading', 1,
87: 'appendix', 1,
88: 'section', 2,
89: 'unnumberedsec', 2,
90: 'heading', 2,
91: 'appendixsec', 2,
92: 'appendixsection', 2,
93: 'subsection', 3,
94: 'unnumberedsubsec', 3,
95: 'subheading', 3,
96: 'appendixsubsec', 3,
97: 'subsubsection', 4,
98: 'unnumberedsubsubsec', 4,
99: 'subsubheading', 4,
100: 'appendixsubsubsec', 4,
101: );
102:
103: #
104: # accent map, TeX command to ISO name
105: #
106: %accent_map = (
107: '"', 'uml',
108: '~', 'tilde',
109: '^', 'circ',
110: '`', 'grave',
111: '\'', 'acute',
112: );
113:
114: #
115: # texinfo "simple things" (@foo) to HTML ones
116: #
117: %simple_map = (
118: # cf. makeinfo.c
119: "*", "<BR>", # HTML+
120: " ", " ",
121: "\n", "\n",
122: "|", "",
123: # spacing commands
124: ":", "",
125: "!", "!",
126: "?", "?",
127: ".", ".",
128: "-", "",
129: );
130:
131: #
132: # texinfo "things" (@foo{}) to HTML ones
133: #
134: %things_map = (
135: 'TeX', 'TeX',
136: 'br', '<P>', # paragraph break
137: 'bullet', '*',
138: 'copyright', '(C)',
139: 'dots', '...',
140: 'equiv', '==',
141: 'error', 'error-->',
142: 'expansion', '==>',
143: 'minus', '-',
144: 'point', '-!-',
145: 'print', '-|',
146: 'result', '=>',
147: 'today', $TODAY,
148: );
149:
150: #
151: # texinfo styles (@foo{bar}) to HTML ones
152: #
153: %style_map = (
154: 'asis', '',
155: 'b', 'B',
156: 'cite', 'CITE',
157: 'code', 'CODE',
158: 'ctrl', '&do_ctrl', # special case
159: 'dfn', 'EM', # DFN tag is illegal in the standard
160: 'dmn', '', # useless
161: 'email', '&do_email', # insert a clickable email address
162: 'emph', 'EM',
163: 'file', '"TT', # will put quotes, cf. &apply_style
164: 'i', 'I',
165: 'kbd', 'KBD',
166: 'key', 'KBD',
167: 'math', 'EM',
168: 'r', '', # unsupported
169: 'samp', '"SAMP', # will put quotes, cf. &apply_style
170: 'sc', '&do_sc', # special case
171: 'strong', 'STRONG',
172: 't', 'TT',
173: 'titlefont', '', # useless
174: 'uref', '&do_uref', # insert a clickable URL
175: 'url', '&do_url', # insert a clickable URL
176: 'var', 'VAR',
177: 'w', '', # unsupported
178: );
179:
180: #
181: # texinfo format (@foo/@end foo) to HTML ones
182: #
183: %format_map = (
184: 'display', 'PRE',
185: 'example', 'PRE',
186: 'format', 'PRE',
187: 'lisp', 'PRE',
188: 'quotation', 'BLOCKQUOTE',
189: 'smallexample', 'PRE',
190: 'smalllisp', 'PRE',
191: # lists
192: 'itemize', 'UL',
193: 'enumerate', 'OL',
194: # poorly supported
195: 'flushleft', 'PRE',
196: 'flushright', 'PRE',
197: );
198:
199: #
200: # texinfo definition shortcuts to real ones
201: #
202: %def_map = (
203: # basic commands
204: 'deffn', 0,
205: 'defvr', 0,
206: 'deftypefn', 0,
207: 'deftypevr', 0,
208: 'defcv', 0,
209: 'defop', 0,
210: 'deftp', 0,
211: # basic x commands
212: 'deffnx', 0,
213: 'defvrx', 0,
214: 'deftypefnx', 0,
215: 'deftypevrx', 0,
216: 'defcvx', 0,
217: 'defopx', 0,
218: 'deftpx', 0,
219: # shortcuts
220: 'defun', 'deffn Function',
221: 'defmac', 'deffn Macro',
222: 'defspec', 'deffn {Special Form}',
223: 'defvar', 'defvr Variable',
224: 'defopt', 'defvr {User Option}',
225: 'deftypefun', 'deftypefn Function',
226: 'deftypevar', 'deftypevr Variable',
227: 'defivar', 'defcv {Instance Variable}',
228: 'defmethod', 'defop Method',
229: # x shortcuts
230: 'defunx', 'deffnx Function',
231: 'defmacx', 'deffnx Macro',
232: 'defspecx', 'deffnx {Special Form}',
233: 'defvarx', 'defvrx Variable',
234: 'defoptx', 'defvrx {User Option}',
235: 'deftypefunx', 'deftypefnx Function',
236: 'deftypevarx', 'deftypevrx Variable',
237: 'defivarx', 'defcvx {Instance Variable}',
238: 'defmethodx', 'defopx Method',
239: );
240:
241: #
242: # things to skip
243: #
244: %to_skip = (
245: # comments
246: 'c', 1,
247: 'comment', 1,
248: # useless
249: 'contents', 1,
250: 'shortcontents', 1,
251: 'summarycontents', 1,
252: 'footnotestyle', 1,
253: 'end ifclear', 1,
254: 'end ifset', 1,
255: 'titlepage', 1,
256: 'end titlepage', 1,
257: # unsupported commands (formatting)
258: 'afourpaper', 1,
259: 'cropmarks', 1,
260: 'finalout', 1,
261: 'headings', 1,
262: 'need', 1,
263: 'page', 1,
264: 'setchapternewpage', 1,
265: 'everyheading', 1,
266: 'everyfooting', 1,
267: 'evenheading', 1,
268: 'evenfooting', 1,
269: 'oddheading', 1,
270: 'oddfooting', 1,
271: 'smallbook', 1,
272: 'vskip', 1,
273: 'filbreak', 1,
274: 'paragraphindent', 1,
275: # unsupported formats
276: 'cartouche', 1,
277: 'end cartouche', 1,
278: 'group', 1,
279: 'end group', 1,
280: );
281:
282: #+++############################################################################
283: # #
284: # Argument parsing, initialisation #
285: # #
286: #---############################################################################
287:
288: %value = (); # hold texinfo variables, see also -D
289:
290: $use_bibliography = 1;
291: $use_acc = 0;
292: $debug = 0;
293: $doctype = '';
294: $check = 0;
295: $expandinfo = 0;
296: $use_glossary = 0;
297: $invisible_mark = '';
298: $use_iso = 0;
299: @include_dirs = ();
300: $show_menu = 0;
301: $number_sections = 0;
302: $split_node = 0;
303: $split_chapter = 0;
304: $monolithic = 0;
305: $verbose = 0;
306: $usage = <<EOT;
307: This is $THISPROG
308: To convert a Texinfo file to HMTL: $0 [options] file
309: where options can be:
310: -expandinfo : use \@ifinfo sections, not \@iftex
311: -glossary : handle a glossary
312: -invisible name: use 'name' as an invisible anchor
313: -Dname : define name like with \@set
314: -I dir : search also for files in 'dir'
315: -menu : handle menus
316: -monolithic : output only one file including ToC
317: -number : number sections
318: -split_chapter : split on main sections
319: -split_node : split on nodes
320: -usage : print usage instructions
321: -verbose : verbose output
322: To check converted files: $0 -check [-verbose] files
323: EOT
324:
325: while (@ARGV && $ARGV[0] =~ /^-/) {
326: $_ = shift(@ARGV);
327: if (/^-acc$/) { $use_acc = 1; next; }
328: if (/^-d(ebug)?(\d+)?$/) { $debug = $2 || shift(@ARGV); next; }
329: if (/^-doctype$/) { $doctype = shift(@ARGV); next; }
330: if (/^-c(heck)?$/) { $check = 1; next; }
331: if (/^-e(xpandinfo)?$/) { $expandinfo = 1; next; }
332: if (/^-g(lossary)?$/) { $use_glossary = 1; next; }
333: if (/^-i(nvisible)?$/) { $invisible_mark = shift(@ARGV); next; }
334: if (/^-iso$/) { $use_iso = 1; next; }
335: if (/^-D(.+)?$/) { $value{$1 || shift(@ARGV)} = 1; next; }
336: if (/^-I(.+)?$/) { push(@include_dirs, $1 || shift(@ARGV)); next; }
337: if (/^-m(enu)?$/) { $show_menu = 1; next; }
338: if (/^-mono(lithic)?$/) { $monolithic = 1; next; }
339: if (/^-n(umber)?$/) { $number_sections = 1; next; }
340: if (/^-s(plit)?_?(n(ode)?|c(hapter)?)?$/) {
341: if ($2 =~ /^n/) {
342: $split_node = 1;
343: } else {
344: $split_chapter = 1;
345: }
346: next;
347: }
348: if (/^-v(erbose)?$/) { $verbose = 1; next; }
349: die $usage;
350: }
351: if ($check) {
352: die $usage unless @ARGV > 0;
353: ✓
354: exit;
355: }
356:
357: if (($split_node || $split_chapter) && $monolithic) {
358: warn "Can't use -monolithic with -split, -monolithic ignored.\n";
359: $monolithic = 0;
360: }
361: if ($expandinfo) {
362: $to_skip{'ifinfo'}++;
363: $to_skip{'end ifinfo'}++;
364: } else {
365: $to_skip{'iftex'}++;
366: $to_skip{'end iftex'}++;
367: }
368: $invisible_mark = '<IMG SRC="invisible.xbm">' if $invisible_mark eq 'xbm';
369: die $usage unless @ARGV == 1;
370: $docu = shift(@ARGV);
371: if ($docu =~ /.*\//) {
372: chop($docu_dir = $&);
373: $docu_name = $';
374: } else {
375: $docu_dir = '.';
376: $docu_name = $docu;
377: }
378: unshift(@include_dirs, $docu_dir);
379: $docu_name =~ s/\.te?x(i|info)?$//; # basename of the document
380:
381: $docu_doc = "$docu_name.html"; # document's contents
382: if ($monolithic) {
383: $docu_toc = $docu_foot = $docu_doc;
384: } else {
385: $docu_toc = "${docu_name}_toc.html"; # document's table of contents
386: $docu_foot = "${docu_name}_foot.html"; # document's footnotes
387: }
388:
389: #
390: # variables
391: #
392: $value{'html'} = 1; # predefine html (the output format)
393: $value{'texi2html'} = '1.52'; # predefine texi2html (the translator)
394: # _foo: internal to track @foo
395: foreach ('_author', '_title', '_subtitle',
396: '_settitle', '_setfilename') {
397: $value{$_} = ''; # prevent -w warnings
398: }
399: %node2sec = (); # node to section name
400: %node2href = (); # node to HREF
401: %bib2href = (); # bibliography reference to HREF
402: %gloss2href = (); # glossary term to HREF
403: @sections = (); # list of sections
404: %tag2pro = (); # protected sections
405:
406: #
407: # initial indexes
408: #
409: $bib_num = 0;
410: $foot_num = 0;
411: $gloss_num = 0;
412: $idx_num = 0;
413: $sec_num = 0;
414: $doc_num = 0;
415: $html_num = 0;
416:
417: #
418: # can I use ISO8879 characters? (HTML+)
419: #
420: if ($use_iso) {
421: $things_map{'bullet'} = "•";
422: $things_map{'copyright'} = "©";
423: $things_map{'dots'} = "…";
424: $things_map{'equiv'} = "≡";
425: $things_map{'expansion'} = "→";
426: $things_map{'point'} = "∗";
427: $things_map{'result'} = "⇒";
428: }
429:
430: #
431: # read texi2html extensions (if any)
432: #
433: $extensions = 'texi2html.ext'; # extensions in working directory
434: if (-f $extensions) {
435: print "# reading extensions from $extensions\n" if $verbose;
436: require($extensions);
437: }
438: ($progdir = $0) =~ s/[^\/]+$//;
439: if ($progdir && ($progdir ne './')) {
440: $extensions = "${progdir}texi2html.ext"; # extensions in texi2html directory
441: if (-f $extensions) {
442: print "# reading extensions from $extensions\n" if $verbose;
443: require($extensions);
444: }
445: }
446:
447: print "# reading from $docu\n" if $verbose;
448:
449: #+++############################################################################
450: # #
451: # Pass 1: read source, handle command, variable, simple substitution #
452: # #
453: #---############################################################################
454:
455: @lines = (); # whole document
456: @toc_lines = (); # table of contents
457: $toplevel = 0; # top level seen in hierarchy
458: $curlevel = 0; # current level in TOC
459: $node = ''; # current node name
460: $in_table = 0; # am I inside a table
461: $table_type = ''; # type of table ('', 'f', 'v', 'multi')
462: @tables = (); # nested table support
463: $in_bibliography = 0; # am I inside a bibliography
464: $in_glossary = 0; # am I inside a glossary
465: $in_top = 0; # am I inside the top node
466: $in_pre = 0; # am I inside a preformatted section
467: $in_list = 0; # am I inside a list
468: $in_html = 0; # am I inside an HTML section
469: $first_line = 1; # is it the first line
470: $dont_html = 0; # don't protect HTML on this line
471: $split_num = 0; # split index
472: $deferred_ref = ''; # deferred reference for indexes
473: @html_stack = (); # HTML elements stack
474: $html_element = ''; # current HTML element
475: &html_reset;
476:
477: # build code for simple substitutions
478: # the maps used (%simple_map and %things_map) MUST be aware of this
479: # watch out for regexps, / and escaped characters!
480: $subst_code = '';
481: foreach (keys(%simple_map)) {
482: ($re = $_) =~ s/(\W)/\\$1/g; # protect regexp chars
483: $subst_code .= "s/\\\@$re/$simple_map{$_}/g;\n";
484: }
485: foreach (keys(%things_map)) {
486: $subst_code .= "s/\\\@$_\\{\\}/$things_map{$_}/g;\n";
487: }
488: if ($use_acc) {
489: # accentuated characters
490: foreach (keys(%accent_map)) {
491: if ($_ eq "`") {
492: $subst_code .= "s/$;3";
493: } elsif ($_ eq "'") {
494: $subst_code .= "s/$;4";
495: } else {
496: $subst_code .= "s/\\\@\\$_";
497: }
498: $subst_code .= "([aeiou])/&\${1}$accent_map{$_};/gi;\n";
499: }
500: }
501: eval("sub simple_substitutions { $subst_code }");
502:
503: &init_input;
504: while ($_ = &next_line) {
505: #
506: # remove \input on the first lines only
507: #
508: if ($first_line) {
509: next if /^\\input/;
510: $first_line = 0;
511: }
512: #
513: # parse texinfo tags
514: #
515: $tag = '';
516: $end_tag = '';
517: if (/^\@end\s+(\w+)\b/) {
518: $end_tag = $1;
519: } elsif (/^\@(\w+)\b/) {
520: $tag = $1;
521: }
522: #
523: # handle @ifhtml / @end ifhtml
524: #
525: if ($in_html) {
526: if ($end_tag eq 'ifhtml') {
527: $in_html = 0;
528: } else {
529: $tag2pro{$in_html} .= $_;
530: }
531: next;
532: } elsif ($tag eq 'ifhtml') {
533: $in_html = $PROTECTTAG . ++$html_num;
534: push(@lines, $in_html);
535: next;
536: }
537: #
538: # try to skip the line
539: #
540: if ($end_tag) {
541: next if $to_skip{"end $end_tag"};
542: } elsif ($tag) {
543: next if $to_skip{$tag};
544: last if $tag eq 'bye';
545: }
546: if ($in_top) {
547: # parsing the top node
548: if ($tag eq 'node' || $tag eq 'include' || $sec2level{$tag}) {
549: # no more in top
550: $in_top = 0;
551: } else {
552: # skip it
553: next;
554: }
555: }
556: #
557: # try to remove inlined comments
558: # syntax from tex-mode.el comment-start-skip
559: #
560: s/((^|[^\@])(\@\@)*)\@c(omment)? .*/$1/;
561: # non-@ substitutions cf. texinfmt.el
562: unless ($in_pre) {
563: s/``/\"/g;
564: s/''/\"/g;
565: s/([\w ])---([\w ])/$1--$2/g;
566: }
567: #
568: # analyze the tag
569: #
570: if ($tag) {
571: # skip lines
572: &skip_until($tag), next if $tag eq 'ignore';
573: if ($expandinfo) {
574: &skip_until($tag), next if $tag eq 'iftex';
575: } else {
576: &skip_until($tag), next if $tag eq 'ifinfo';
577: }
578: &skip_until($tag), next if $tag eq 'tex';
579: # handle special tables
580: if ($tag =~ /^(|f|v|multi)table$/) {
581: $table_type = $1;
582: $tag = 'table';
583: }
584: # special cases
585: if ($tag eq 'top' || ($tag eq 'node' && /^\@node\s+top\s*,/i)) {
586: $in_top = 1;
587: @lines = (); # ignore all lines before top (title page garbage)
588: next;
589: } elsif ($tag eq 'node') {
590: $in_top = 0;
591: warn "$ERROR Bad node line: $_" unless $_ =~ /^\@node\s$NODESRE$/o;
592: $_ = &protect_html($_); # if node contains '&' for instance
593: s/^\@node\s+//;
594: ($node) = split(/,/);
595: &normalise_node($node);
596: if ($split_node) {
597: &next_doc;
598: push(@lines, $SPLITTAG) if $split_num++;
599: push(@sections, $node);
600: }
601: next;
602: } elsif ($tag eq 'include') {
603: if (/^\@include\s+($FILERE)\s*$/o) {
604: $file = $1;
605: unless (-e $file) {
606: foreach $dir (@include_dirs) {
607: $file = "$dir/$1";
608: last if -e $file;
609: }
610: }
611: if (-e $file) {
612: &open($file);
613: print "# including $file\n" if $verbose;
614: } else {
615: warn "$ERROR Can't find $file, skipping";
616: }
617: } else {
618: warn "$ERROR Bad include line: $_";
619: }
620: next;
621: } elsif ($tag eq 'ifclear') {
622: if (/^\@ifclear\s+($VARRE)\s*$/o) {
623: next unless defined($value{$1});
624: &skip_until($tag);
625: } else {
626: warn "$ERROR Bad ifclear line: $_";
627: }
628: next;
629: } elsif ($tag eq 'ifset') {
630: if (/^\@ifset\s+($VARRE)\s*$/o) {
631: next if defined($value{$1});
632: &skip_until($tag);
633: } else {
634: warn "$ERROR Bad ifset line: $_";
635: }
636: next;
637: } elsif ($tag eq 'menu') {
638: unless ($show_menu) {
639: &skip_until($tag);
640: next;
641: }
642: &html_push_if($tag);
643: push(@lines, &html_debug("\n", __LINE__));
644: } elsif ($format_map{$tag}) {
645: $in_pre = 1 if $format_map{$tag} eq 'PRE';
646: &html_push_if($format_map{$tag});
647: push(@lines, &html_debug("\n", __LINE__));
648: $in_list++ if $format_map{$tag} eq 'UL' || $format_map{$tag} eq 'OL' ;
649: push(@lines, &debug("<$format_map{$tag}>\n", __LINE__));
650: next;
651: } elsif ($tag eq 'table') {
652: if (/^\@(|f|v|multi)table\s+\@(\w+)/) {
653: $in_table = $2;
654: unshift(@tables, join($;, $table_type, $in_table));
655: if ($table_type eq "multi") {
656: push(@lines, &debug("<TABLE BORDER>\n", __LINE__));
657: &html_push_if('TABLE');
658: } else {
659: push(@lines, &debug("<DL COMPACT>\n", __LINE__));
660: &html_push_if('DL');
661: }
662: push(@lines, &html_debug("\n", __LINE__));
663: } else {
664: warn "$ERROR Bad table line: $_";
665: }
666: next;
667: } elsif ($tag eq 'synindex' || $tag eq 'syncodeindex') {
668: if (/^\@$tag\s+(\w)\w\s+(\w)\w\s*$/) {
669: eval("*${1}index = *${2}index");
670: } else {
671: warn "$ERROR Bad syn*index line: $_";
672: }
673: next;
674: } elsif ($tag eq 'sp') {
675: push(@lines, &debug("<P>\n", __LINE__));
676: next;
677: } elsif ($tag eq 'setref') {
678: &protect_html; # if setref contains '&' for instance
679: if (/^\@$tag\s*{($NODERE)}\s*$/) {
680: $setref = $1;
681: $setref =~ s/\s+/ /g; # normalize
682: $setref =~ s/ $//;
683: $node2sec{$setref} = $name;
684: $node2href{$setref} = "$docu_doc#$docid";
685: } else {
686: warn "$ERROR Bad setref line: $_";
687: }
688: next;
689: } elsif ($tag eq 'defindex' || $tag eq 'defcodeindex') {
690: if (/^\@$tag\s+(\w\w)\s*$/) {
691: $valid_index{$1} = 1;
692: } else {
693: warn "$ERROR Bad defindex line: $_";
694: }
695: next;
696: } elsif (defined($def_map{$tag})) {
697: if ($def_map{$tag}) {
698: s/^\@$tag\s+//;
699: $tag = $def_map{$tag};
700: $_ = "\@$tag $_";
701: $tag =~ s/\s.*//;
702: }
703: } elsif (defined($user_sub{$tag})) {
704: s/^\@$tag\s+//;
705: $sub = $user_sub{$tag};
706: print "# user $tag = $sub, arg: $_" if $debug & $DEBUG_USER;
707: if (defined(&$sub)) {
708: chop($_);
709: &$sub($_);
710: } else {
711: warn "$ERROR Bad user sub for $tag: $sub\n";
712: }
713: next;
714: }
715: if (defined($def_map{$tag})) {
716: s/^\@$tag\s+//;
717: if ($tag =~ /x$/) {
718: # extra definition line
719: $tag = $`;
720: $is_extra = 1;
721: } else {
722: $is_extra = 0;
723: }
724: while (/\{([^\{\}]*)\}/) {
725: # this is a {} construct
726: ($before, $contents, $after) = ($`, $1, $');
727: # protect spaces
728: $contents =~ s/\s+/$;9/g;
729: # restore $_ protecting {}
730: $_ = "$before$;7$contents$;8$after";
731: }
732: @args = split(/\s+/, &protect_html($_));
733: foreach (@args) {
734: s/$;9/ /g; # unprotect spaces
735: s/$;7/\{/g; # ... {
736: s/$;8/\}/g; # ... }
737: }
738: $type = shift(@args);
739: $type =~ s/^\{(.*)\}$/$1/;
740: print "# def ($tag): {$type} ", join(', ', @args), "\n"
741: if $debug & $DEBUG_DEF;
742: $type .= ':'; # it's nicer like this
743: $name = shift(@args);
744: $name =~ s/^\{(.*)\}$/$1/;
745: if ($is_extra) {
746: $_ = &debug("<DT>", __LINE__);
747: } else {
748: $_ = &debug("<DL>\n<DT>", __LINE__);
749: }
750: if ($tag eq 'deffn' || $tag eq 'defvr' || $tag eq 'deftp') {
751: $_ .= "<U>$type</U> <B>$name</B>";
752: $_ .= " <I>@args</I>" if @args;
753: } elsif ($tag eq 'deftypefn' || $tag eq 'deftypevr'
754: || $tag eq 'defcv' || $tag eq 'defop') {
755: $ftype = $name;
756: $name = shift(@args);
757: $name =~ s/^\{(.*)\}$/$1/;
758: $_ .= "<U>$type</U> $ftype <B>$name</B>";
759: $_ .= " <I>@args</I>" if @args;
760: } else {
761: warn "$ERROR Unknown definition type: $tag\n";
762: $_ .= "<U>$type</U> <B>$name</B>";
763: $_ .= " <I>@args</I>" if @args;
764: }
765: $_ .= &debug("\n<DD>", __LINE__);
766: $name = &unprotect_html($name);
767: if ($tag eq 'deffn' || $tag eq 'deftypefn') {
768: unshift(@input_spool, "\@findex $name\n");
769: } elsif ($tag eq 'defop') {
770: unshift(@input_spool, "\@findex $name on $ftype\n");
771: } elsif ($tag eq 'defvr' || $tag eq 'deftypevr' || $tag eq 'defcv') {
772: unshift(@input_spool, "\@vindex $name\n");
773: } else {
774: unshift(@input_spool, "\@tindex $name\n");
775: }
776: $dont_html = 1;
777: }
778: } elsif ($end_tag) {
779: if ($format_map{$end_tag}) {
780: $in_pre = 0 if $format_map{$end_tag} eq 'PRE';
781: $in_list-- if $format_map{$end_tag} eq 'UL' || $format_map{$end_tag} eq 'OL' ;
782: &html_pop_if('LI', 'P');
783: &html_pop_if();
784: push(@lines, &debug("</$format_map{$end_tag}>\n", __LINE__));
785: push(@lines, &html_debug("\n", __LINE__));
786: } elsif ($end_tag =~ /^(|f|v|multi)table$/) {
787: unless (@tables) {
788: warn "$ERROR \@end $end_tag without \@*table\n";
789: next;
790: }
791: ($table_type, $in_table) = split($;, shift(@tables));
792: unless ($1 eq $table_type) {
793: warn "$ERROR \@end $end_tag without matching \@$end_tag\n";
794: next;
795: }
796: if ($table_type eq "multi") {
797: push(@lines, "</TR></TABLE>\n");
798: &html_pop_if('TR');
799: } else {
800: push(@lines, "</DL>\n");
801: &html_pop_if('DD');
802: }
803: &html_pop_if();
804: if (@tables) {
805: ($table_type, $in_table) = split($;, $tables[0]);
806: } else {
807: $in_table = 0;
808: }
809: } elsif (defined($def_map{$end_tag})) {
810: push(@lines, &debug("</DL>\n", __LINE__));
811: } elsif ($end_tag eq 'menu') {
812: &html_pop_if();
813: push(@lines, $_); # must keep it for pass 2
814: }
815: next;
816: }
817: #
818: # misc things
819: #
820: # protect texi and HTML things
821: &protect_texi;
822: $_ = &protect_html($_) unless $dont_html;
823: $dont_html = 0;
824: # substitution (unsupported things)
825: s/^\@center\s+//g;
826: s/^\@exdent\s+//g;
827: s/\@noindent\s+//g;
828: s/\@refill\s+//g;
829: # other substitutions
830: &simple_substitutions;
831: s/\@value{($VARRE)}/$value{$1}/eg;
832: s/\@footnote\{/\@footnote$docu_doc\{/g; # mark footnotes, cf. pass 4
833: #
834: # analyze the tag again
835: #
836: if ($tag) {
837: if (defined($sec2level{$tag}) && $sec2level{$tag} > 0) {
838: if (/^\@$tag\s+(.+)$/) {
839: $name = $1;
840: $name =~ s/\s+$//;
841: $level = $sec2level{$tag};
842: $name = &update_sec_num($tag, $level) . " $name"
843: if $number_sections && $tag !~ /^unnumbered/;
844: if ($tag =~ /heading$/) {
845: push(@lines, &html_debug("\n", __LINE__));
846: if ($html_element ne 'body') {
847: # We are in a nice pickle here. We are trying to get a H? heading
848: # even though we are not in the body level. So, we convert it to a
849: # nice, bold, line by itself.
850: $_ = &debug("\n\n<P><STRONG>$name</STRONG></P>\n\n", __LINE__);
851: } else {
852: $_ = &debug("<H$level>$name</H$level>\n", __LINE__);
853: &html_push_if('body');
854: }
855: print "# heading, section $name, level $level\n"
856: if $debug & $DEBUG_TOC;
857: } else {
858: if ($split_chapter) {
859: unless ($toplevel) {
860: # first time we see a "section"
861: unless ($level == 1) {
862: warn "$ERROR The first section found is not of level 1: $_";
863: warn "$ERROR I'll split on sections of level $level...\n";
864: }
865: $toplevel = $level;
866: }
867: if ($level == $toplevel) {
868: &next_doc;
869: push(@lines, $SPLITTAG) if $split_num++;
870: push(@sections, $name);
871: }
872: }
873: $sec_num++;
874: $docid = "SEC$sec_num";
875: $tocid = "TOC$sec_num";
876: # check biblio and glossary
877: $in_bibliography = ($name =~ /^([A-Z]|\d+)?(\.\d+)*\s*bibliography$/i);
878: $in_glossary = ($name =~ /^([A-Z]|\d+)?(\.\d+)*\s*glossary$/i);
879: # check node
880: if ($node) {
881: if ($node2sec{$node}) {
882: warn "$ERROR Duplicate node found: $node\n";
883: } else {
884: $node2sec{$node} = $name;
885: $node2href{$node} = "$docu_doc#$docid";
886: print "# node $node, section $name, level $level\n"
887: if $debug & $DEBUG_TOC;
888: }
889: $node = '';
890: } else {
891: print "# no node, section $name, level $level\n"
892: if $debug & $DEBUG_TOC;
893: }
894: # update TOC
895: while ($level > $curlevel) {
896: $curlevel++;
897: push(@toc_lines, "<UL>\n");
898: }
899: while ($level < $curlevel) {
900: $curlevel--;
901: push(@toc_lines, "</UL>\n");
902: }
903: $_ = "<LI>" . &anchor($tocid, "$docu_doc#$docid", $name, 1);
904: push(@toc_lines, &substitute_style($_));
905: # update DOC
906: push(@lines, &html_debug("\n", __LINE__));
907: &html_reset;
908: $_ = "<H$level>".&anchor($docid, "$docu_toc#$tocid", $name)."</H$level>\n";
909: $_ = &debug($_, __LINE__);
910: push(@lines, &html_debug("\n", __LINE__));
911: }
912: # update DOC
913: foreach $line (split(/\n+/, $_)) {
914: push(@lines, "$line\n");
915: }
916: next;
917: } else {
918: warn "$ERROR Bad section line: $_";
919: }
920: } else {
921: # track variables
922: $value{$1} = $2, next if /^\@set\s+($VARRE)\s+(.*)$/o;
923: delete $value{$1}, next if /^\@clear\s+($VARRE)\s*$/o;
924: # store things
925: $value{'_setfilename'} = $1, next if /^\@setfilename\s+(.*)$/;
926: $value{'_settitle'} = $1, next if /^\@settitle\s+(.*)$/;
927: $value{'_author'} .= "$1\n", next if /^\@author\s+(.*)$/;
928: $value{'_subtitle'} .= "$1\n", next if /^\@subtitle\s+(.*)$/;
929: $value{'_title'} .= "$1\n", next if /^\@title\s+(.*)$/;
930: # index
931: if (/^\@(..?)index\s+/) {
932: unless ($valid_index{$1}) {
933: warn "$ERROR Undefined index command: $_";
934: next;
935: }
936: $id = 'IDX' . ++$idx_num;
937: $index = $1 . 'index';
938: $what = &substitute_style($');
939: $what =~ s/\s+$//;
940: print "# found $index for '$what' id $id\n"
941: if $debug & $DEBUG_INDEX;
942: eval(<<EOC);
943: if (defined(\$$index\{\$what\})) {
944: \$$index\{\$what\} .= "$;$docu_doc#$id";
945: } else {
946: \$$index\{\$what\} = "$docu_doc#$id";
947: }
948: EOC
949: #
950: # dirty hack to see if I can put an invisible anchor...
951: #
952: if ($html_element eq 'P' ||
953: $html_element eq 'LI' ||
954: $html_element eq 'DT' ||
955: $html_element eq 'DD' ||
956: $html_element eq 'ADDRESS' ||
957: $html_element eq 'B' ||
958: $html_element eq 'BLOCKQUOTE' ||
959: $html_element eq 'PRE' ||
960: $html_element eq 'SAMP') {
961: push(@lines, &anchor($id, '', $invisible_mark, !$in_pre));
962: } elsif ($html_element eq 'body') {
963: push(@lines, &debug("<P>\n", __LINE__));
964: push(@lines, &anchor($id, '', $invisible_mark, !$in_pre));
965: &html_push('P');
966: } elsif ($html_element eq 'DL' ||
967: $html_element eq 'UL' ||
968: $html_element eq 'OL' ) {
969: $deferred_ref .= &anchor($id, '', $invisible_mark, !$in_pre) . " ";
970: }
971: next;
972: }
973: # list item
974: if (/^\@itemx?\s+/) {
975: $what = $';
976: $what =~ s/\s+$//;
977: if ($in_bibliography && $use_bibliography) {
978: if ($what =~ /^$BIBRE$/o) {
979: $id = 'BIB' . ++$bib_num;
980: $bib2href{$what} = "$docu_doc#$id";
981: print "# found bibliography for '$what' id $id\n"
982: if $debug & $DEBUG_BIB;
983: $what = &anchor($id, '', $what);
984: }
985: } elsif ($in_glossary && $use_glossary) {
986: $id = 'GLOSS' . ++$gloss_num;
987: $entry = $what;
988: $entry =~ tr/A-Z/a-z/ unless $entry =~ /^[A-Z\s]+$/;
989: $gloss2href{$entry} = "$docu_doc#$id";
990: print "# found glossary for '$entry' id $id\n"
991: if $debug & $DEBUG_GLOSS;
992: $what = &anchor($id, '', $what);
993: }
994: &html_pop_if('P');
995: if ($html_element eq 'DL' || $html_element eq 'DD') {
996: if ($things_map{$in_table} && !$what) {
997: # special case to allow @table @bullet for instance
998: push(@lines, &debug("<DT>$things_map{$in_table}\n", __LINE__));
999: } else {
1000: push(@lines, &debug("<DT>\@$in_table\{$what\}\n", __LINE__));
1001: }
1002: push(@lines, "<DD>");
1003: &html_push('DD') unless $html_element eq 'DD';
1004: if ($table_type) { # add also an index
1005: unshift(@input_spool, "\@${table_type}index $what\n");
1006: }
1007: } elsif ($html_element eq 'TABLE') {
1008: push(@lines, &debug("<TR><TD>$what</TD>\n", __LINE__));
1009: &html_push('TR');
1010: } elsif ($html_element eq 'TR') {
1011: push(@lines, &debug("</TR>\n", __LINE__));
1012: push(@lines, &debug("<TR><TD>$what</TD>\n", __LINE__));
1013: } else {
1014: push(@lines, &debug("<LI>$what\n", __LINE__));
1015: &html_push('LI') unless $html_element eq 'LI';
1016: }
1017: push(@lines, &html_debug("\n", __LINE__));
1018: if ($deferred_ref) {
1019: push(@lines, &debug("$deferred_ref\n", __LINE__));
1020: $deferred_ref = '';
1021: }
1022: next;
1023: } elsif (/^\@tab\s+(.*)$/) {
1024: push(@lines, "<TD>$1</TD>\n");
1025: next;
1026: }
1027: }
1028: }
1029: # paragraph separator
1030: if ($_ eq "\n") {
1031: next if $#lines >= 0 && $lines[$#lines] eq "\n";
1032: if ($html_element eq 'P') {
1033: push(@lines, "\n");
1034: $_ = &debug("</P>\n", __LINE__);
1035: &html_pop;
1036: }
1037: } elsif ($html_element eq 'body' || $html_element eq 'BLOCKQUOTE') {
1038: push(@lines, "<P>\n");
1039: &html_push('P');
1040: $_ = &debug($_, __LINE__);
1041: }
1042: # otherwise
1043: push(@lines, $_);
1044: }
1045:
1046: # finish TOC
1047: $level = 0;
1048: while ($level < $curlevel) {
1049: $curlevel--;
1050: push(@toc_lines, "</UL>\n");
1051: }
1052:
1053: print "# end of pass 1\n" if $verbose;
1054:
1055: #+++############################################################################
1056: # #
1057: # Pass 2/3: handle style, menu, index, cross-reference #
1058: # #
1059: #---############################################################################
1060:
1061: @lines2 = (); # whole document (2nd pass)
1062: @lines3 = (); # whole document (3rd pass)
1063: $in_menu = 0; # am I inside a menu
1064:
1065: while (@lines) {
1066: $_ = shift(@lines);
1067: #
1068: # special case (protected sections)
1069: #
1070: if (/^$PROTECTTAG/o) {
1071: push(@lines2, $_);
1072: next;
1073: }
1074: #
1075: # menu
1076: #
1077: $in_menu = 1, push(@lines2, &debug("<UL>\n", __LINE__)), next if /^\@menu\b/;
1078: $in_menu = 0, push(@lines2, &debug("</UL>\n", __LINE__)), next if /^\@end\s+menu\b/;
1079: if ($in_menu) {
1080: if (/^\*\s+($NODERE)::/o) {
1081: $descr = $';
1082: chop($descr);
1083: &menu_entry($1, $1, $descr);
1084: } elsif (/^\*\s+(.+):\s+([^\t,\.\n]+)[\t,\.\n]/) {
1085: $descr = $';
1086: chop($descr);
1087: &menu_entry($1, $2, $descr);
1088: } elsif (/^\*/) {
1089: warn "$ERROR Bad menu line: $_";
1090: } else { # description continued?
1091: push(@lines2, $_);
1092: }
1093: next;
1094: }
1095: #
1096: # printindex
1097: #
1098: if (/^\@printindex\s+(\w\w)\b/) {
1099: local($index, *ary, @keys, $key, $letter, $last_letter, @refs);
1100: if ($predefined_index{$1}) {
1101: $index = $predefined_index{$1} . 'index';
1102: } else {
1103: $index = $1 . 'index';
1104: }
1105: eval("*ary = *$index");
1106: @keys = keys(%ary);
1107: foreach $key (@keys) {
1108: $_ = $key;
1109: 1 while s/<(\w+)>\`(.*)\'<\/\1>/$2/; # remove HTML tags with quotes
1110: 1 while s/<(\w+)>(.*)<\/\1>/$2/; # remove HTML tags
1111: $_ = &unprotect_html($_);
1112: &unprotect_texi;
1113: tr/A-Z/a-z/; # lowercase
1114: $key2alpha{$key} = $_;
1115: print "# index $key sorted as $_\n"
1116: if $key ne $_ && $debug & $DEBUG_INDEX;
1117: }
1118: push(@lines2, "Jump to:\n");
1119: $last_letter = undef;
1120: foreach $key (sort byalpha @keys) {
1121: $letter = substr($key2alpha{$key}, 0, 1);
1122: $letter = substr($key2alpha{$key}, 0, 2) if $letter eq $;;
1123: if (!defined($last_letter) || $letter ne $last_letter) {
1124: push(@lines2, "-\n") if defined($last_letter);
1125: push(@lines2, "<A HREF=\"#$index\_$letter\">" . &protect_html($letter) . "</A>\n");
1126: $last_letter = $letter;
1127: }
1128: }
1129: push(@lines2, "<P>\n");
1130: $last_letter = undef;
1131: foreach $key (sort byalpha @keys) {
1132: $letter = substr($key2alpha{$key}, 0, 1);
1133: $letter = substr($key2alpha{$key}, 0, 2) if $letter eq $;;
1134: if (!defined($last_letter) || $letter ne $last_letter) {
1135: push(@lines2, "</DIR>\n") if defined($last_letter);
1136: push(@lines2, "<H2><A NAME=\"$index\_$letter\">" . &protect_html($letter) . "</A></H2>\n");
1137: push(@lines2, "<DIR>\n");
1138: $last_letter = $letter;
1139: }
1140: @refs = ();
1141: foreach (split(/$;/, $ary{$key})) {
1142: push(@refs, &anchor('', $_, $key, 0));
1143: }
1144: push(@lines2, "<LI>" . join(", ", @refs) . "\n");
1145: }
1146: push(@lines2, "</DIR>\n") if defined($last_letter);
1147: next;
1148: }
1149: #
1150: # simple style substitutions
1151: #
1152: $_ = &substitute_style($_);
1153: #
1154: # xref
1155: #
1156: while (/\@(x|px|info|)ref{($XREFRE)(}?)/o) {
1157: # note: Texinfo may accept other characters
1158: ($type, $nodes, $full) = ($1, $2, $3);
1159: ($before, $after) = ($`, $');
1160: if (! $full && $after) {
1161: warn "$ERROR Bad xref (no ending } on line): $_";
1162: $_ = "$before$;0${type}ref\{$nodes$after";
1163: next; # while xref
1164: }
1165: if ($type eq 'x') {
1166: $type = 'See ';
1167: } elsif ($type eq 'px') {
1168: $type = 'see ';
1169: } elsif ($type eq 'info') {
1170: $type = 'See Info';
1171: } else {
1172: $type = '';
1173: }
1174: unless ($full) {
1175: $next = shift(@lines);
1176: $next = &substitute_style($next);
1177: chop($nodes); # remove final newline
1178: if ($next =~ /\}/) { # split on 2 lines
1179: $nodes .= " $`";
1180: $after = $';
1181: } else {
1182: $nodes .= " $next";
1183: $next = shift(@lines);
1184: $next = &substitute_style($next);
1185: chop($nodes);
1186: if ($next =~ /\}/) { # split on 3 lines
1187: $nodes .= " $`";
1188: $after = $';
1189: } else {
1190: warn "$ERROR Bad xref (no ending }): $_";
1191: $_ = "$before$;0xref\{$nodes$after";
1192: unshift(@lines, $next);
1193: next; # while xref
1194: }
1195: }
1196: }
1197: $nodes =~ s/\s+/ /g; # remove useless spaces
1198: @args = split(/\s*,\s*/, $nodes);
1199: $node = $args[0]; # the node is always the first arg
1200: &normalise_node($node);
1201: $sec = $node2sec{$node};
1202: if (@args == 5) { # reference to another manual
1203: $sec = $args[2] || $node;
1204: $man = $args[4] || $args[3];
1205: $_ = "${before}${type}section `$sec' in \@cite{$man}$after";
1206: } elsif ($type =~ /Info/) { # inforef
1207: warn "$ERROR Wrong number of arguments: $_" unless @args == 3;
1208: ($nn, $_, $in) = @args;
1209: $_ = "${before}${type} file `$in', node `$nn'$after";
1210: } elsif ($sec) {
1211: $href = $node2href{$node};
1212: $_ = "${before}${type}section " . &anchor('', $href, $sec) . $after;
1213: } else {
1214: warn "$ERROR Undefined node ($node): $_";
1215: $_ = "$before$;0xref{$nodes}$after";
1216: }
1217: }
1218: #
1219: # try to guess bibliography references or glossary terms
1220: #
1221: unless (/^<H\d><A NAME=\"SEC\d/) {
1222: if ($use_bibliography) {
1223: $done = '';
1224: while (/$BIBRE/o) {
1225: ($pre, $what, $post) = ($`, $&, $');
1226: $href = $bib2href{$what};
1227: if (defined($href) && $post !~ /^[^<]*<\/A>/) {
1228: $done .= $pre . &anchor('', $href, $what);
1229: } else {
1230: $done .= "$pre$what";
1231: }
1232: $_ = $post;
1233: }
1234: $_ = $done . $_;
1235: }
1236: if ($use_glossary) {
1237: $done = '';
1238: while (/\b\w+\b/) {
1239: ($pre, $what, $post) = ($`, $&, $');
1240: $entry = $what;
1241: $entry =~ tr/A-Z/a-z/ unless $entry =~ /^[A-Z\s]+$/;
1242: $href = $gloss2href{$entry};
1243: if (defined($href) && $post !~ /^[^<]*<\/A>/) {
1244: $done .= $pre . &anchor('', $href, $what);
1245: } else {
1246: $done .= "$pre$what";
1247: }
1248: $_ = $post;
1249: }
1250: $_ = $done . $_;
1251: }
1252: }
1253: # otherwise
1254: push(@lines2, $_);
1255: }
1256: print "# end of pass 2\n" if $verbose;
1257:
1258: #
1259: # split style substitutions
1260: #
1261: while (@lines2) {
1262: $_ = shift(@lines2);
1263: #
1264: # special case (protected sections)
1265: #
1266: if (/^$PROTECTTAG/o) {
1267: push(@lines3, $_);
1268: next;
1269: }
1270: #
1271: # split style substitutions
1272: #
1273: $old = '';
1274: while ($old ne $_) {
1275: $old = $_;
1276: if (/\@(\w+)\{/) {
1277: ($before, $style, $after) = ($`, $1, $');
1278: if (defined($style_map{$style})) {
1279: $_ = $after;
1280: $text = '';
1281: $after = '';
1282: $failed = 1;
1283: while (@lines2) {
1284: if (/\}/) {
1285: $text .= $`;
1286: $after = $';
1287: $failed = 0;
1288: last;
1289: } else {
1290: $text .= $_;
1291: $_ = shift(@lines2);
1292: }
1293: }
1294: if ($failed) {
1295: die "* Bad syntax (\@$style) after: $before\n";
1296: } else {
1297: $text = &apply_style($style, $text);
1298: $_ = "$before$text$after";
1299: }
1300: }
1301: }
1302: }
1303: # otherwise
1304: push(@lines3, $_);
1305: }
1306: print "# end of pass 3\n" if $verbose;
1307:
1308: #+++############################################################################
1309: # #
1310: # Pass 4: foot notes, final cleanup #
1311: # #
1312: #---############################################################################
1313:
1314: @foot_lines = (); # footnotes
1315: @doc_lines = (); # final document
1316: $end_of_para = 0; # true if last line is <P>
1317:
1318: while (@lines3) {
1319: $_ = shift(@lines3);
1320: #
1321: # special case (protected sections)
1322: #
1323: if (/^$PROTECTTAG/o) {
1324: push(@doc_lines, $_);
1325: $end_of_para = 0;
1326: next;
1327: }
1328: #
1329: # footnotes
1330: #
1331: while (/\@footnote([^\{\s]+)\{/) {
1332: ($before, $d, $after) = ($`, $1, $');
1333: $_ = $after;
1334: $text = '';
1335: $after = '';
1336: $failed = 1;
1337: while (@lines3) {
1338: if (/\}/) {
1339: $text .= $`;
1340: $after = $';
1341: $failed = 0;
1342: last;
1343: } else {
1344: $text .= $_;
1345: $_ = shift(@lines3);
1346: }
1347: }
1348: if ($failed) {
1349: die "* Bad syntax (\@footnote) after: $before\n";
1350: } else {
1351: $foot_num++;
1352: $docid = "DOCF$foot_num";
1353: $footid = "FOOT$foot_num";
1354: $foot = "($foot_num)";
1355: push(@foot_lines, "<H3>" . &anchor($footid, "$d#$docid", $foot) . "</H3>\n");
1356: $text = "<P>$text" unless $text =~ /^\s*<P>/;
1357: push(@foot_lines, "$text\n");
1358: $_ = $before . &anchor($docid, "$docu_foot#$footid", $foot) . $after;
1359: }
1360: }
1361: #
1362: # remove unnecessary <P>
1363: #
1364: if (/^\s*<P>\s*$/) {
1365: next if $end_of_para++;
1366: } else {
1367: $end_of_para = 0;
1368: }
1369: # otherwise
1370: push(@doc_lines, $_);
1371: }
1372: print "# end of pass 4\n" if $verbose;
1373:
1374: #+++############################################################################
1375: # #
1376: # Pass 5: print things #
1377: # #
1378: #---############################################################################
1379:
1380: $header = <<EOT;
1381: <!-- This HTML file has been created by $THISPROG
1382: from $docu on $TODAY -->
1383: EOT
1384:
1385: $full_title = $value{'_title'} || $value{'_settitle'} || "Untitled Document";
1386: $title = $value{'_settitle'} || $full_title;
1387: $_ = &substitute_style($full_title);
1388: &unprotect_texi;
1389: s/\n$//; # rmv last \n (if any)
1390: $full_title = "<H1>" . join("</H1>\n<H1>", split(/\n/, $_)) . "</H1>\n";
1391:
1392: #
1393: # print ToC
1394: #
1395: if (!$monolithic && @toc_lines) {
1396: if (open(FILE, "> $docu_toc")) {
1397: print "# creating $docu_toc...\n" if $verbose;
1398: &print_toplevel_header("$title - Table of Contents");
1399: &print_ruler;
1400: &print(*toc_lines, FILE);
1401: &print_toplevel_footer;
1402: close(FILE);
1403: } else {
1404: warn "$ERROR Can't write to $docu_toc: $!\n";
1405: }
1406: }
1407:
1408: #
1409: # print footnotes
1410: #
1411: if (!$monolithic && @foot_lines) {
1412: if (open(FILE, "> $docu_foot")) {
1413: print "# creating $docu_foot...\n" if $verbose;
1414: &print_toplevel_header("$title - Footnotes");
1415: &print_ruler;
1416: &print(*foot_lines, FILE);
1417: &print_toplevel_footer;
1418: close(FILE);
1419: } else {
1420: warn "$ERROR Can't write to $docu_foot: $!\n";
1421: }
1422: }
1423:
1424: #
1425: # print document
1426: #
1427: if ($split_chapter || $split_node) { # split
1428: $doc_num = 0;
1429: $last_num = scalar(@sections);
1430: $first_doc = &doc_name(1);
1431: $last_doc = &doc_name($last_num);
1432: while (@sections) {
1433: $section = shift(@sections);
1434: &next_doc;
1435: if (open(FILE, "> $docu_doc")) {
1436: print "# creating $docu_doc...\n" if $verbose;
1437: &print_header("$title - $section");
1438: $prev_doc = ($doc_num == 1 ? undef : &doc_name($doc_num - 1));
1439: $next_doc = ($doc_num == $last_num ? undef : &doc_name($doc_num + 1));
1440: $navigation = "Go to the ";
1441: $navigation .= ($prev_doc ? &anchor('', $first_doc, "first") : "first");
1442: $navigation .= ", ";
1443: $navigation .= ($prev_doc ? &anchor('', $prev_doc, "previous") : "previous");
1444: $navigation .= ", ";
1445: $navigation .= ($next_doc ? &anchor('', $next_doc, "next") : "next");
1446: $navigation .= ", ";
1447: $navigation .= ($next_doc ? &anchor('', $last_doc, "last") : "last");
1448: $navigation .= " section, " . &anchor('', $docu_toc, "table of contents") . ".\n";
1449: print FILE $navigation;
1450: &print_ruler;
1451: # find corresponding lines
1452: @tmp_lines = ();
1453: while (@doc_lines) {
1454: $_ = shift(@doc_lines);
1455: last if ($_ eq $SPLITTAG);
1456: push(@tmp_lines, $_);
1457: }
1458: &print(*tmp_lines, FILE);
1459: &print_ruler;
1460: print FILE $navigation;
1461: &print_footer;
1462: close(FILE);
1463: } else {
1464: warn "$ERROR Can't write to $docu_doc: $!\n";
1465: }
1466: }
1467: } else { # not split
1468: if (open(FILE, "> $docu_doc")) {
1469: print "# creating $docu_doc...\n" if $verbose;
1470: if ($monolithic || !@toc_lines) {
1471: &print_toplevel_header($title);
1472: } else {
1473: &print_header($title);
1474: print FILE $full_title;
1475: }
1476: if ($monolithic && @toc_lines) {
1477: &print_ruler;
1478: print FILE "<H1>Table of Contents</H1>\n";
1479: &print(*toc_lines, FILE);
1480: }
1481: &print_ruler;
1482: &print(*doc_lines, FILE);
1483: if ($monolithic && @foot_lines) {
1484: &print_ruler;
1485: print FILE "<H1>Footnotes</H1>\n";
1486: &print(*foot_lines, FILE);
1487: }
1488: if ($monolithic || !@toc_lines) {
1489: &print_toplevel_footer;
1490: } else {
1491: &print_footer;
1492: }
1493: close(FILE);
1494: } else {
1495: warn "$ERROR Can't write to $docu_doc: $!\n";
1496: }
1497: }
1498:
1499: print "# that's all folks\n" if $verbose;
1500:
1501: #+++############################################################################
1502: # #
1503: # Low level functions #
1504: # #
1505: #---############################################################################
1506:
1507: sub update_sec_num {
1508: local($name, $level) = @_;
1509:
1510: $level--; # here we start at 0
1511: if ($name =~ /^appendix/) {
1512: # appendix style
1.2 ! ohara 1513: if ( @appendix_sec_num ) {
1.1 noro 1514: &incr_sec_num($level, @appendix_sec_num);
1515: } else {
1516: @appendix_sec_num = ('A', 0, 0, 0);
1517: }
1518: return(join('.', @appendix_sec_num[0..$level]));
1519: } else {
1520: # normal style
1.2 ! ohara 1521: if ( @normal_sec_num ) {
1.1 noro 1522: &incr_sec_num($level, @normal_sec_num);
1523: } else {
1524: @normal_sec_num = (1, 0, 0, 0);
1525: }
1526: return(join('.', @normal_sec_num[0..$level]));
1527: }
1528: }
1529:
1530: sub incr_sec_num {
1531: local($level, $l);
1532: $level = shift(@_);
1533: $_[$level]++;
1534: foreach $l ($level+1 .. 3) {
1535: $_[$l] = 0;
1536: }
1537: }
1538:
1539: sub check {
1540: local($_, %seen, %context, $before, $match, $after);
1541:
1542: while (<>) {
1543: if (/\@(\*|\.|\:|\@|\{|\})/) {
1544: $seen{$&}++;
1545: $context{$&} .= "> $_" if $verbose;
1546: $_ = "$`XX$'";
1547: redo;
1548: }
1549: if (/\@(\w+)/) {
1550: ($before, $match, $after) = ($`, $&, $');
1551: if ($before =~ /\b[\w-]+$/ && $after =~ /^[\w-.]*\b/) { # e-mail address
1552: $seen{'e-mail address'}++;
1553: $context{'e-mail address'} .= "> $_" if $verbose;
1554: } else {
1555: $seen{$match}++;
1556: $context{$match} .= "> $_" if $verbose;
1557: }
1558: $match =~ s/^\@/X/;
1559: $_ = "$before$match$after";
1560: redo;
1561: }
1562: }
1563:
1564: foreach (sort(keys(%seen))) {
1565: if ($verbose) {
1566: print "$_\n";
1567: print $context{$_};
1568: } else {
1569: print "$_ ($seen{$_})\n";
1570: }
1571: }
1572: }
1573:
1574: sub open {
1575: local($name) = @_;
1576:
1577: ++$fh_name;
1578: if (open($fh_name, $name)) {
1579: unshift(@fhs, $fh_name);
1580: } else {
1581: warn "$ERROR Can't read file $name: $!\n";
1582: }
1583: }
1584:
1585: sub init_input {
1586: @fhs = (); # hold the file handles to read
1587: @input_spool = (); # spooled lines to read
1588: $fh_name = 'FH000';
1589: &open($docu);
1590: }
1591:
1592: sub next_line {
1593: local($fh, $line);
1594:
1595: if (@input_spool) {
1596: $line = shift(@input_spool);
1597: return($line);
1598: }
1599: while (@fhs) {
1600: $fh = $fhs[0];
1601: $line = <$fh>;
1602: return($line) if $line;
1603: close($fh);
1604: shift(@fhs);
1605: }
1606: return(undef);
1607: }
1608:
1609: # used in pass 1, use &next_line
1610: sub skip_until {
1611: local($tag) = @_;
1612: local($_);
1613:
1614: while ($_ = &next_line) {
1615: return if /^\@end\s+$tag\s*$/;
1616: }
1617: die "* Failed to find '$tag' after: " . $lines[$#lines];
1618: }
1619:
1620: #
1621: # HTML stacking to have a better HTML output
1622: #
1623:
1624: sub html_reset {
1625: @html_stack = ('html');
1626: $html_element = 'body';
1627: }
1628:
1629: sub html_push {
1630: local($what) = @_;
1631: push(@html_stack, $html_element);
1632: $html_element = $what;
1633: }
1634:
1635: sub html_push_if {
1636: local($what) = @_;
1637: push(@html_stack, $html_element)
1638: if ($html_element && $html_element ne 'P');
1639: $html_element = $what;
1640: }
1641:
1642: sub html_pop {
1643: $html_element = pop(@html_stack);
1644: }
1645:
1646: sub html_pop_if {
1647: local($elt);
1648:
1649: if (@_) {
1650: foreach $elt (@_) {
1651: if ($elt eq $html_element) {
1652: $html_element = pop(@html_stack) if @html_stack;
1653: last;
1654: }
1655: }
1656: } else {
1657: $html_element = pop(@html_stack) if @html_stack;
1658: }
1659: }
1660:
1661: sub html_debug {
1662: local($what, $line) = @_;
1663: return("<!-- $line @html_stack, $html_element -->$what")
1664: if $debug & $DEBUG_HTML;
1665: return($what);
1666: }
1667:
1668: # to debug the output...
1669: sub debug {
1670: local($what, $line) = @_;
1671: return("<!-- $line -->$what")
1672: if $debug & $DEBUG_HTML;
1673: return($what);
1674: }
1675:
1676: sub normalise_node {
1677: $_[0] =~ s/\s+/ /g;
1678: $_[0] =~ s/ $//;
1679: $_[0] =~ s/^ //;
1680: }
1681:
1682: sub menu_entry {
1683: local($entry, $node, $descr) = @_;
1684: local($href);
1685:
1686: &normalise_node($node);
1687: $href = $node2href{$node};
1688: if ($href) {
1689: $descr =~ s/^\s+//;
1690: $descr = ": $descr" if $descr;
1691: push(@lines2, "<LI>" . &anchor('', $href, $entry) . "$descr\n");
1692: } else {
1693: warn "$ERROR Undefined node ($node): $_";
1694: }
1695: }
1696:
1697: sub do_ctrl { "^$_[0]" }
1698:
1699: sub do_email {
1700: local($addr, $text) = split(/,\s*/, $_[0]);
1701:
1702: $text = $addr unless $text;
1703: &anchor('', "mailto:$addr", $text);
1704: }
1705:
1706: sub do_sc { "\U$_[0]\E" }
1707:
1708: sub do_uref {
1709: local($url, $text) = split(/,\s*/, $_[0]);
1710:
1711: $text = $url unless $text;
1712: &anchor('', $url, $text);
1713: }
1714:
1715: sub do_url { &anchor('', $_[0], $_[0]) }
1716:
1717: sub apply_style {
1718: local($texi_style, $text) = @_;
1719: local($style);
1720:
1721: $style = $style_map{$texi_style};
1722: if (defined($style)) { # known style
1723: if ($style =~ /^\"/) { # add quotes
1724: $style = $';
1725: $text = "\`$text\'";
1726: }
1727: if ($style =~ /^\&/) { # custom
1728: $style = $';
1729: $text = &$style($text);
1730: } elsif ($style) { # good style
1731: $text = "<$style>$text</$style>";
1732: } else { # no style
1733: }
1734: } else { # unknown style
1735: $text = undef;
1736: }
1737: return($text);
1738: }
1739:
1740: # remove Texinfo styles
1741: sub remove_style {
1742: local($_) = @_;
1743: s/\@\w+{([^\{\}]+)}/$1/g;
1744: return($_);
1745: }
1746:
1747: sub substitute_style {
1748: local($_) = @_;
1749: local($changed, $done, $style, $text);
1750:
1751: $changed = 1;
1752: while ($changed) {
1753: $changed = 0;
1754: $done = '';
1755: while (/\@(\w+){([^\{\}]+)}/) {
1756: $text = &apply_style($1, $2);
1757: if ($text) {
1758: $_ = "$`$text$'";
1759: $changed = 1;
1760: } else {
1761: $done .= "$`\@$1";
1762: $_ = "{$2}$'";
1763: }
1764: }
1765: $_ = $done . $_;
1766: }
1767: return($_);
1768: }
1769:
1770: sub anchor {
1771: local($name, $href, $text, $newline) = @_;
1772: local($result);
1773:
1774: $result = "<A";
1775: $result .= " NAME=\"$name\"" if $name;
1776: $result .= " HREF=\"$href\"" if $href;
1777: $result .= ">$text</A>";
1778: $result .= "\n" if $newline;
1779: return($result);
1780: }
1781:
1782: sub pretty_date {
1783: local(@MoY, $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst);
1784:
1785: @MoY = ('January', 'Febuary', 'March', 'April', 'May', 'June',
1786: 'July', 'August', 'September', 'October', 'November', 'December');
1787: ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime(time);
1788: $year += ($year < 70) ? 2000 : 1900;
1789: return("$mday $MoY[$mon] $year");
1790: }
1791:
1792: sub doc_name {
1793: local($num) = @_;
1794:
1795: return("${docu_name}_$num.html");
1796: }
1797:
1798: sub next_doc {
1799: $docu_doc = &doc_name(++$doc_num);
1800: }
1801:
1802: sub print {
1803: local(*lines, $fh) = @_;
1804: local($_);
1805:
1806: while (@lines) {
1807: $_ = shift(@lines);
1808: if (/^$PROTECTTAG/o) {
1809: $_ = $tag2pro{$_};
1810: } else {
1811: &unprotect_texi;
1812: }
1813: print $fh $_;
1814: }
1815: }
1816:
1817: sub print_ruler {
1818: print FILE "<P><HR><P>\n";
1819: }
1820:
1821: sub print_header {
1822: local($_);
1823:
1824: # clean the title
1825: $_ = &remove_style($_[0]);
1826: &unprotect_texi;
1827: # print the header
1828: if ($doctype eq 'html2') {
1829: print FILE $html2_doctype;
1830: } elsif ($doctype) {
1831: print FILE $doctype;
1832: }
1833: print FILE <<EOT;
1834: <HTML>
1835: <HEAD>
1836: $header
1837: <TITLE>$_</TITLE>
1838: </HEAD>
1839: <BODY>
1840: EOT
1841: }
1842:
1843: sub print_toplevel_header {
1844: local($_);
1845:
1846: &print_header; # pass given arg...
1847: print FILE $full_title;
1848: if ($value{'_subtitle'}) {
1849: $value{'_subtitle'} =~ s/\n+$//;
1850: foreach (split(/\n/, $value{'_subtitle'})) {
1851: $_ = &substitute_style($_);
1852: &unprotect_texi;
1853: print FILE "<H2>$_</H2>\n";
1854: }
1855: }
1856: if ($value{'_author'}) {
1857: $value{'_author'} =~ s/\n+$//;
1858: foreach (split(/\n/, $value{'_author'})) {
1859: $_ = &substitute_style($_);
1860: &unprotect_texi;
1861: s/[\w.-]+\@[\w.-]+/<A HREF="mailto:$&">$&<\/A>/g;
1862: print FILE "<ADDRESS>$_</ADDRESS>\n";
1863: }
1864: }
1865: print FILE "<P>\n";
1866: }
1867:
1868: sub print_footer {
1869: print FILE <<EOT;
1870: </BODY>
1871: </HTML>
1872: EOT
1873: }
1874:
1875: sub print_toplevel_footer {
1876: &print_ruler;
1877: print FILE <<EOT;
1878: This document was generated on $TODAY using the
1879: <A HREF=\"$HOMEPAGE\">texi2html</A>
1880: translator version 1.52.</P>
1881: EOT
1882: &print_footer;
1883: }
1884:
1885: sub protect_texi {
1886: # protect @ { } ` '
1887: s/\@\@/$;0/go;
1888: s/\@\{/$;1/go;
1889: s/\@\}/$;2/go;
1890: s/\@\`/$;3/go;
1891: s/\@\'/$;4/go;
1892: }
1893:
1894: sub protect_html {
1895: local($what) = @_;
1896: # protect & < >
1897: $what =~ s/\&/\&\#38;/g;
1898: $what =~ s/\</\&\#60;/g;
1899: $what =~ s/\>/\&\#62;/g;
1900: # but recognize some HTML things
1901: $what =~ s/\&\#60;\/A\&\#62;/<\/A>/g; # </A>
1902: $what =~ s/\&\#60;A ([^\&]+)\&\#62;/<A $1>/g; # <A [^&]+>
1903: $what =~ s/\&\#60;IMG ([^\&]+)\&\#62;/<IMG $1>/g; # <IMG [^&]+>
1904: return($what);
1905: }
1906:
1907: sub unprotect_texi {
1908: s/$;0/\@/go;
1909: s/$;1/\{/go;
1910: s/$;2/\}/go;
1911: s/$;3/\`/go;
1912: s/$;4/\'/go;
1913: }
1914:
1915: sub unprotect_html {
1916: local($what) = @_;
1917: $what =~ s/\&\#38;/\&/g;
1918: $what =~ s/\&\#60;/\</g;
1919: $what =~ s/\&\#62;/\>/g;
1920: return($what);
1921: }
1922:
1923: sub byalpha {
1924: $key2alpha{$a} cmp $key2alpha{$b};
1925: }
1926: