Produce "dip" -- basically digested paragraphs for standalone backends
[platform/upstream/nasm.git] / doc / rdsrc.pl
1 #!/usr/bin/perl
2
3 # Read the source-form of the NASM manual and generate the various
4 # output forms.
5
6 # TODO:
7 #
8 # Ellipsis support would be nice.
9
10 # Source-form features:
11 # ---------------------
12
13 # Bullet \b
14 #   Bullets the paragraph. Rest of paragraph is indented to cope. In
15 #   HTML, consecutive groups of bulleted paragraphs become unordered
16 #   lists.
17
18 # Emphasis \e{foobar}
19 #   produces `_foobar_' in text and italics in HTML, PS, RTF
20
21 # Inline code \c{foobar}
22 #   produces ``foobar'' in text, and fixed-pitch font in HTML, PS, RTF
23
24 # Display code
25 # \c  line one
26 # \c   line two
27 #   produces fixed-pitch font where appropriate, and doesn't break
28 #   pages except sufficiently far into the middle of a display.
29
30 # Chapter, header and subheader
31 # \C{intro} Introduction
32 # \H{whatsnasm} What is NASM?
33 # \S{free} NASM Is Free
34 #   dealt with as appropriate. Chapters begin on new sides, possibly
35 #   even new _pages_. (Sub)?headers are good places to begin new
36 #   pages. Just _after_ a (sub)?header isn't.
37 #   The keywords can be substituted with \K and \k.
38 #
39 # Keyword \K{cintro} \k{cintro}
40 #   Expands to `Chapter 1', `Section 1.1', `Section 1.1.1'. \K has an
41 #   initial capital whereas \k doesn't. In HTML, will produce
42 #   hyperlinks.
43
44 # Web link \W{http://foobar/}{text} or \W{mailto:me@here}\c{me@here}
45 #   the \W prefix is ignored except in HTML; in HTML the last part
46 #   becomes a hyperlink to the first part.
47
48 # Literals \{ \} \\
49 #   In case it's necessary, they expand to the real versions.
50
51 # Nonbreaking hyphen \-
52 #   Need more be said?
53
54 # Source comment \#
55 #   Causes everything after it on the line to be ignored by the
56 #   source-form processor.
57 #
58 # Indexable word \i{foobar} (or \i\e{foobar} or \i\c{foobar}, equally)
59 #   makes word appear in index, referenced to that point
60 #   \i\c comes up in code style even in the index; \i\e doesn't come
61 #   up in emphasised style.
62 #
63 # Indexable non-displayed word \I{foobar} or \I\c{foobar}
64 #   just as \i{foobar} except that nothing is displayed for it
65 #
66 # Index rewrite
67 # \IR{foobar} \c{foobar} operator, uses of
68 #   tidies up the appearance in the index of something the \i or \I
69 #   operator was applied to
70 #
71 # Index alias
72 # \IA{foobar}{bazquux}
73 #   aliases one index tag (as might be supplied to \i or \I) to
74 #   another, so that \I{foobar} has the effect of \I{bazquux}, and
75 #   \i{foobar} has the effect of \I{bazquux}foobar
76 #
77 # Metadata
78 # \M{key}{something}
79 #   defines document metadata, such as authorship, title and copyright;
80 #   different output formats use this differently.
81 #
82
83 $diag = 1, shift @ARGV if $ARGV[0] eq "-d";
84
85 $| = 1;
86
87 $tstruct_previtem = $node = "Top";
88 $nodes = ($node);
89 $tstruct_level{$tstruct_previtem} = 0;
90 $tstruct_last[$tstruct_level{$tstruct_previtem}] = $tstruct_previtem;
91 $MAXLEVEL = 10;  # really 3, but play safe ;-)
92
93 # Read the file; pass a paragraph at a time to the paragraph processor.
94 print "Reading input...";
95 $pname = "para000000";
96 @pnames = @pflags = ();
97 $para = undef;
98 while (<>) {
99   chomp;
100   if (!/\S/ || /^\\(IA|IR|M)/) { # special case: \IA \IR \M imply new-paragraph
101     &got_para($para);
102     $para = undef;
103   }
104   if (/\S/) {
105     s/\\#.*$//; # strip comments
106     $para .= " " . $_;
107   }
108 }
109 &got_para($para);
110 print "done.\n";
111
112 # Now we've read in the entire document and we know what all the
113 # heading keywords refer to. Go through and fix up the \k references.
114 print "Fixing up cross-references...";
115 &fixup_xrefs;
116 print "done.\n";
117
118 # Sort the index tags, according to the slightly odd order I've decided on.
119 print "Sorting index tags...";
120 &indexsort;
121 print "done.\n";
122
123 if ($diag) {
124   print "Writing index-diagnostic file...";
125   &indexdiag;
126   print "done.\n";
127 }
128
129 # OK. Write out the various output files.
130 print "Producing text output: ";
131 &write_txt;
132 print "done.\n";
133 print "Producing HTML output: ";
134 &write_html;
135 print "done.\n";
136 print "Producing PostScript output: ";
137 &write_ps;
138 print "done.\n";
139 print "Producing Texinfo output: ";
140 &write_texi;
141 print "done.\n";
142 print "Producing WinHelp output: ";
143 &write_hlp;
144 print "done.\n";
145 print "Producing Documentation Intermediate Paragraphs: ";
146 &write_dip;
147 print "done.\n";
148
149 sub got_para {
150   local ($_) = @_;
151   my $pflags = "", $i, $w, $l, $t;
152   return if !/\S/;
153
154   @$pname = ();
155
156   # Strip off _leading_ spaces, then determine type of paragraph.
157   s/^\s*//;
158   $irewrite = undef;
159   if (/^\\c[^{]/) {
160     # A code paragraph. The paragraph-array will contain the simple
161     # strings which form each line of the paragraph.
162     $pflags = "code";
163     while (/^\\c (([^\\]|\\[^c])*)(.*)$/) {
164       $l = $1;
165       $_ = $3;
166       $l =~ s/\\{/{/g;
167       $l =~ s/\\}/}/g;
168       $l =~ s/\\\\/\\/g;
169       push @$pname, $l;
170     }
171     $_ = ''; # suppress word-by-word code
172   } elsif (/^\\C/) {
173     # A chapter heading. Define the keyword and allocate a chapter
174     # number.
175     $cnum++;
176     $hnum = 0;
177     $snum = 0;
178     $xref = "chapter-$cnum";
179     $pflags = "chap $cnum :$xref";
180     die "badly formatted chapter heading: $_\n" if !/^\\C{([^}]*)}\s*(.*)$/;
181     $refs{$1} = "chapter $cnum";
182     $node = "Chapter $cnum";
183     &add_item($node, 1);
184     $xrefnodes{$node} = $xref; $nodexrefs{$xref} = $node;
185     $xrefs{$1} = $xref;
186     $_ = $2;
187     # the standard word-by-word code will happen next
188   } elsif (/^\\A/) {
189     # An appendix heading. Define the keyword and allocate an appendix
190     # letter.
191     $cnum++;
192     $cnum = 'A' if $cnum =~ /[0-9]+/;
193     $hnum = 0;
194     $snum = 0;
195     $xref = "appendix-$cnum";
196     $pflags = "appn $cnum :$xref";
197     die "badly formatted appendix heading: $_\n" if !/^\\A{([^}]*)}\s*(.*)$/;
198     $refs{$1} = "appendix $cnum";
199     $node = "Appendix $cnum";
200     &add_item($node, 1);
201     $xrefnodes{$node} = $xref; $nodexrefs{$xref} = $node;
202     $xrefs{$1} = $xref;
203     $_ = $2;
204     # the standard word-by-word code will happen next
205   } elsif (/^\\H/) {
206     # A major heading. Define the keyword and allocate a section number.
207     $hnum++;
208     $snum = 0;
209     $xref = "section-$cnum.$hnum";
210     $pflags = "head $cnum.$hnum :$xref";
211     die "badly formatted heading: $_\n" if !/^\\[HP]{([^}]*)}\s*(.*)$/;
212     $refs{$1} = "section $cnum.$hnum";
213     $node = "Section $cnum.$hnum";
214     &add_item($node, 2);
215     $xrefnodes{$node} = $xref; $nodexrefs{$xref} = $node;
216     $xrefs{$1} = $xref;
217     $_ = $2;
218     # the standard word-by-word code will happen next
219   } elsif (/^\\S/) {
220     # A sub-heading. Define the keyword and allocate a section number.
221     $snum++;
222     $xref = "section-$cnum.$hnum.$snum";
223     $pflags = "subh $cnum.$hnum.$snum :$xref";
224     die "badly formatted subheading: $_\n" if !/^\\S{([^}]*)}\s*(.*)$/;
225     $refs{$1} = "section $cnum.$hnum.$snum";
226     $node = "Section $cnum.$hnum.$snum";
227     &add_item($node, 3);
228     $xrefnodes{$node} = $xref; $nodexrefs{$xref} = $node;
229     $xrefs{$1} = $xref;
230     $_ = $2;
231     # the standard word-by-word code will happen next
232   } elsif (/^\\IR/) {
233     # An index-rewrite.
234     die "badly formatted index rewrite: $_\n" if !/^\\IR{([^}]*)}\s*(.*)$/;
235     $irewrite = $1;
236     $_ = $2;
237     # the standard word-by-word code will happen next
238   } elsif (/^\\IA/) {
239     # An index-alias.
240     die "badly formatted index alias: $_\n" if !/^\\IA{([^}]*)}{([^}]*)}\s*$/;
241     $idxalias{$1} = $2;
242     return; # avoid word-by-word code
243   } elsif (/^\\M/) {
244     # Metadata
245     die "badly formed metadata: $_\n" if !/^\\M{([^}]*)}{([^}]*)}\s*$/;
246     $metadata{$1} = $2;
247     return; # avoid word-by-word code
248   } elsif (/^\\b/) {
249     # A bulleted paragraph. Strip off the initial \b and let the
250     # word-by-word code take care of the rest.
251     $pflags = "bull";
252     s/^\\b\s*//;
253   } else {
254     # A normal paragraph. Just set $pflags: the word-by-word code does
255     # the rest.
256     $pflags = "norm";
257   }
258
259   # The word-by-word code: unless @$pname is already defined (which it
260   # will be in the case of a code paragraph), split the paragraph up
261   # into words and push each on @$pname.
262   #
263   # Each thing pushed on @$pname should have a two-character type
264   # code followed by the text.
265   #
266   # Type codes are:
267   # "n " for normal
268   # "da" for a dash
269   # "es" for first emphasised word in emphasised bit
270   # "e " for emphasised in mid-emphasised-bit
271   # "ee" for last emphasised word in emphasised bit
272   # "eo" for single (only) emphasised word
273   # "c " for code
274   # "k " for cross-ref
275   # "kK" for capitalised cross-ref
276   # "w " for Web link
277   # "wc" for code-type Web link
278   # "x " for beginning of resolved cross-ref; generates no visible output,
279   #      and the text is the cross-reference code
280   # "xe" for end of resolved cross-ref; text is same as for "x ".
281   # "i " for point to be indexed: the text is the internal index into the
282   #      index-items arrays
283   # "sp" for space
284   while (/\S/) {
285     s/^\s*//, push @$pname, "sp" if /^\s/;
286     $indexing = $qindex = 0;
287     if (/^(\\[iI])?\\c/) {
288       $qindex = 1 if $1 eq "\\I";
289       $indexing = 1, s/^\\[iI]// if $1;
290       s/^\\c//;
291       die "badly formatted \\c: \\c$_\n" if !/{(([^\\}]|\\.)*)}(.*)$/;
292       $w = $1;
293       $_ = $3;
294       $w =~ s/\\{/{/g;
295       $w =~ s/\\}/}/g;
296       $w =~ s/\\-/-/g;
297       $w =~ s/\\\\/\\/g;
298       (push @$pname,"i"),$lastp = $#$pname if $indexing;
299       push @$pname,"c $w" if !$qindex;
300       $$pname[$lastp] = &addidx($node, $w, "c $w") if $indexing;
301     } elsif (/^\\[iIe]/) {
302       /^(\\[iI])?(\\e)?/;
303       $emph = 0;
304       $qindex = 1 if $1 eq "\\I";
305       $indexing = 1, $type = "\\i" if $1;
306       $emph = 1, $type = "\\e" if $2;
307       s/^(\\[iI])?(\\e?)//;
308       die "badly formatted $type: $type$_\n" if !/{(([^\\}]|\\.)*)}(.*)$/;
309       $w = $1;
310       $_ = $3;
311       $w =~ s/\\{/{/g;
312       $w =~ s/\\}/}/g;
313       $w =~ s/\\-/-/g;
314       $w =~ s/\\\\/\\/g;
315       $t = $emph ? "es" : "n ";
316       @ientry = ();
317       (push @$pname,"i"),$lastp = $#$pname if $indexing;
318       foreach $i (split /\s+/,$w) {  # \e and \i can be multiple words
319         push @$pname,"$t$i","sp" if !$qindex;
320         ($ii=$i) =~ tr/A-Z/a-z/, push @ientry,"n $ii","sp" if $indexing;
321         $t = $emph ? "e " : "n ";
322       }
323       $w =~ tr/A-Z/a-z/, pop @ientry if $indexing;
324       $$pname[$lastp] = &addidx($node, $w, @ientry) if $indexing;
325       pop @$pname if !$qindex; # remove final space
326       if (substr($$pname[$#$pname],0,2) eq "es" && !$qindex) {
327         substr($$pname[$#$pname],0,2) = "eo";
328       } elsif ($emph && !$qindex) {
329         substr($$pname[$#$pname],0,2) = "ee";
330       }
331     } elsif (/^\\[kK]/) {
332       $t = "k ";
333       $t = "kK" if /^\\K/;
334       s/^\\[kK]//;
335       die "badly formatted \\k: \\c$_\n" if !/{([^}]*)}(.*)$/;
336       $_ = $2;
337       push @$pname,"$t$1";
338     } elsif (/^\\W/) {
339       s/^\\W//;
340       die "badly formatted \\W: \\W$_\n"
341           if !/{([^}]*)}(\\i)?(\\c)?{(([^\\}]|\\.)*)}(.*)$/;
342       $l = $1;
343       $w = $4;
344       $_ = $6;
345       $t = "w ";
346       $t = "wc" if $3 eq "\\c";
347       $indexing = 1 if $2;
348       $w =~ s/\\{/{/g;
349       $w =~ s/\\}/}/g;
350       $w =~ s/\\-/-/g;
351       $w =~ s/\\\\/\\/g;
352       (push @$pname,"i"),$lastp = $#$pname if $indexing;
353       push @$pname,"$t<$l>$w";
354       $$pname[$lastp] = &addidx($node, $w, "c $w") if $indexing;
355     } else {
356       die "what the hell? $_\n" if !/^(([^\s\\\-]|\\[\\{}\-])*-?)(.*)$/;
357       die "painful death! $_\n" if !length $1;
358       $w = $1;
359       $_ = $3;
360       $w =~ s/\\{/{/g;
361       $w =~ s/\\}/}/g;
362       $w =~ s/\\-/-/g;
363       $w =~ s/\\\\/\\/g;
364       if ($w eq "-") {
365         push @$pname,"da";
366       } else {
367         push @$pname,"n $w";
368       }
369     }
370   }
371   if ($irewrite ne undef) {
372     &addidx(undef, $irewrite, @$pname);
373     @$pname = ();
374   } else {
375     push @pnames, $pname;
376     push @pflags, $pflags;
377     $pname++;
378   }
379 }
380
381 sub addidx {
382   my ($node, $text, @ientry) = @_;
383   $text = $idxalias{$text} || $text;
384   if ($node eq undef || !$idxmap{$text}) {
385     @$ientry = @ientry;
386     $idxmap{$text} = $ientry;
387     $ientry++;
388   }
389   if ($node) {
390     $idxnodes{$node,$text} = 1;
391     return "i $text";
392   }
393 }
394
395 sub indexsort {
396   my $iitem, $ientry, $i, $piitem, $pcval, $cval, $clrcval;
397
398   @itags = map { # get back the original data as the 1st elt of each list
399              $_->[0]
400            } sort { # compare auxiliary (non-first) elements of lists
401              $a->[1] cmp $b->[1] ||
402              $a->[2] cmp $b->[2] ||
403              $a->[0] cmp $b->[0]
404            } map { # transform array into list of 3-element lists
405              my $ientry = $idxmap{$_};
406              my $a = substr($$ientry[0],2);
407              $a =~ tr/A-Za-z//cd;
408              [$_, uc($a), substr($$ientry[0],0,2)]
409            } keys %idxmap;
410
411   # Having done that, check for comma-hood.
412   $cval = 0;
413   foreach $iitem (@itags) {
414     $ientry = $idxmap{$iitem};
415     $clrcval = 1;
416     $pcval = $cval;
417     FL:for ($i=0; $i <= $#$ientry; $i++) {
418       if ($$ientry[$i] =~ /^(n .*,)(.*)/) {
419         $$ientry[$i] = $1;
420         splice @$ientry,$i+1,0,"n $2" if length $2;
421         $commapos{$iitem} = $i+1;
422         $cval = join("\002", @$ientry[0..$i]);
423         $clrcval = 0;
424         last FL;
425       }
426     }
427     $cval = undef if $clrcval;
428     $commanext{$iitem} = $commaafter{$piitem} = 1
429       if $cval and ($cval eq $pcval);
430     $piitem = $iitem;
431   }
432 }
433
434 sub indexdiag {
435   my $iitem,$ientry,$w,$ww,$foo,$node;
436   open INDEXDIAG,">index.diag";
437   foreach $iitem (@itags) {
438     $ientry = $idxmap{$iitem};
439     print INDEXDIAG "<$iitem> ";
440     foreach $w (@$ientry) {
441       $ww = &word_txt($w);
442       print INDEXDIAG $ww unless $ww eq "\001";
443     }
444     print INDEXDIAG ":";
445     $foo = " ";
446     foreach $node (@nodes) {
447       (print INDEXDIAG $foo,$node), $foo = ", " if $idxnodes{$node,$iitem};
448     }
449     print INDEXDIAG "\n";
450   }
451   close INDEXDIAG;
452 }
453
454 sub fixup_xrefs {
455   my $pname, $p, $i, $j, $k, $caps, @repl;
456
457   for ($p=0; $p<=$#pnames; $p++) {
458     next if $pflags[$p] eq "code";
459     $pname = $pnames[$p];
460     for ($i=$#$pname; $i >= 0; $i--) {
461       if ($$pname[$i] =~ /^k/) {
462         $k = $$pname[$i];
463         $caps = ($k =~ /^kK/);
464         $k = substr($k,2);      
465         $repl = $refs{$k};
466         die "undefined keyword `$k'\n" unless $repl;
467         substr($repl,0,1) =~ tr/a-z/A-Z/ if $caps;
468         @repl = ();
469         push @repl,"x $xrefs{$k}";
470         foreach $j (split /\s+/,$repl) {
471           push @repl,"n $j";
472           push @repl,"sp";
473         }
474         pop @repl; # remove final space
475         push @repl,"xe$xrefs{$k}";
476         splice @$pname,$i,1,@repl;
477       }
478     }
479   }
480 }
481
482 sub write_txt {
483   # This is called from the top level, so I won't bother using
484   # my or local.
485
486   # Open file.
487   print "writing file...";
488   open TEXT,">nasmdoc.txt";
489   select TEXT;
490
491   # Preamble.
492   $title = "The Netwide Assembler: NASM";
493   $spaces = ' ' x ((75-(length $title))/2);
494   ($underscore = $title) =~ s/./=/g;
495   print "$spaces$title\n$spaces$underscore\n";
496
497   for ($para = 0; $para <= $#pnames; $para++) {
498     $pname = $pnames[$para];
499     $pflags = $pflags[$para];
500     $ptype = substr($pflags,0,4);
501
502     print "\n"; # always one of these before a new paragraph
503
504     if ($ptype eq "chap") {
505       # Chapter heading. "Chapter N: Title" followed by a line of
506       # minus signs.
507       $pflags =~ /chap (.*) :(.*)/;
508       $title = "Chapter $1: ";
509       foreach $i (@$pname) {
510         $ww = &word_txt($i);
511         $title .= $ww unless $ww eq "\001";
512       }
513       print "$title\n";
514       $title =~ s/./-/g;
515       print "$title\n";
516     } elsif ($ptype eq "appn") {
517       # Appendix heading. "Appendix N: Title" followed by a line of
518       # minus signs.
519       $pflags =~ /appn (.*) :(.*)/;
520       $title = "Appendix $1: ";
521       foreach $i (@$pname) {
522         $ww = &word_txt($i);
523         $title .= $ww unless $ww eq "\001";
524       }
525       print "$title\n";
526       $title =~ s/./-/g;
527       print "$title\n";
528     } elsif ($ptype eq "head" || $ptype eq "subh") {
529       # Heading or subheading. Just a number and some text.
530       $pflags =~ /.... (.*) :(.*)/;
531       $title = sprintf "%6s ", $1;
532       foreach $i (@$pname) {
533         $ww = &word_txt($i);
534         $title .= $ww unless $ww eq "\001";
535       }
536       print "$title\n";
537     } elsif ($ptype eq "code") {
538       # Code paragraph. Emit each line with a seven character indent.
539       foreach $i (@$pname) {
540         warn "code line longer than 68 chars: $i\n" if length $i > 68;
541         print ' 'x7, $i, "\n";
542       }
543     } elsif ($ptype eq "bull" || $ptype eq "norm") {
544       # Ordinary paragraph, optionally bulleted. We wrap, with ragged
545       # 75-char right margin and either 7 or 11 char left margin
546       # depending on bullets.
547       if ($ptype eq "bull") {
548         $line = ' 'x7 . '(*) ';
549         $next = ' 'x11;
550       } else {
551         $line = $next = ' 'x7;
552       }
553       @a = @$pname;
554       $wd = $wprev = '';
555       do {
556         do { $w = &word_txt(shift @a) } while $w eq "\001"; # nasty hack
557         $wd .= $wprev;
558         if ($wprev =~ /-$/ || $w eq ' ' || $w eq '' || $w eq undef) {
559           if (length ($line . $wd) > 75) {
560             $line =~ s/\s*$//; # trim trailing spaces
561             print "$line\n";
562             $line = $next;
563             $wd =~ s/^\s*//; # trim leading spaces
564           }
565           $line .= $wd;
566           $wd = '';
567         }
568         $wprev = $w;
569       } while ($w ne '' && $w ne undef);
570       if ($line =~ /\S/) {
571         $line =~ s/\s*$//; # trim trailing spaces
572         print "$line\n";
573       }
574     }
575   }
576
577   # Close file.
578   select STDOUT;
579   close TEXT;
580 }
581
582 sub word_txt {
583   my ($w) = @_;
584   my $wtype, $wmajt;
585
586   return undef if $w eq '' || $w eq undef;
587   $wtype = substr($w,0,2);
588   $wmajt = substr($wtype,0,1);
589   $w = substr($w,2);
590   $w =~ s/<.*>// if $wmajt eq "w"; # remove web links
591   if ($wmajt eq "n" || $wtype eq "e " || $wtype eq "w ") {
592     return $w;
593   } elsif ($wtype eq "sp") {
594     return ' ';
595   } elsif ($wtype eq "da") {
596     return '-';
597   } elsif ($wmajt eq "c" || $wtype eq "wc") {
598     return "`${w}'";
599   } elsif ($wtype eq "es") {
600     return "_${w}";
601   } elsif ($wtype eq "ee") {
602     return "${w}_";
603   } elsif ($wtype eq "eo") {
604     return "_${w}_";
605   } elsif ($wmajt eq "x" || $wmajt eq "i") {
606     return "\001";
607   } else {
608     die "panic in word_txt: $wtype$w\n";
609   }
610 }
611
612 sub write_html {
613   # This is called from the top level, so I won't bother using
614   # my or local.
615
616   # Write contents file. Just the preamble, then a menu of links to the
617   # separate chapter files and the nodes therein.
618   print "writing contents file...";
619   open TEXT,">nasmdoc0.html";
620   select TEXT;
621   &html_preamble(0);
622   print "<p>This manual documents NASM, the Netwide Assembler: an assembler\n";
623   print "targetting the Intel x86 series of processors, with portable source.\n";
624   print "<p>";
625   for ($node = $tstruct_next{'Top'}; $node; $node = $tstruct_next{$node}) {
626     if ($tstruct_level{$node} == 1) {
627       # Invent a file name.
628       ($number = lc($xrefnodes{$node})) =~ s/.*-//;
629       $fname="nasmdocx.html";
630       substr($fname,8 - length $number, length $number) = $number;
631       $html_fnames{$node} = $fname;
632       $link = $fname;
633       print "<p>";
634     } else {
635       # Use the preceding filename plus a marker point.
636       $link = $fname . "#$xrefnodes{$node}";
637     }
638     $title = "$node: ";
639     $pname = $tstruct_pname{$node};
640     foreach $i (@$pname) {
641       $ww = &word_html($i);
642       $title .= $ww unless $ww eq "\001";
643     }
644     print "<a href=\"$link\">$title</a><br>\n";
645   }
646   print "<p><a href=\"nasmdoci.html\">Index</a>\n";
647   print "</body></html>\n";
648   select STDOUT;
649   close TEXT;
650
651   # Open a null file, to ensure output (eg random &html_jumppoints calls)
652   # goes _somewhere_.
653   print "writing chapter files...";
654   open TEXT,">/dev/null";
655   select TEXT;
656   $html_lastf = '';
657
658   $in_list = 0;
659
660   for ($para = 0; $para <= $#pnames; $para++) {
661     $pname = $pnames[$para];
662     $pflags = $pflags[$para];
663     $ptype = substr($pflags,0,4);
664
665     $in_list = 0, print "</ul>\n" if $in_list && $ptype ne "bull";
666     if ($ptype eq "chap") {
667       # Chapter heading. Begin a new file.
668       $pflags =~ /chap (.*) :(.*)/;
669       $title = "Chapter $1: ";
670       $xref = $2;
671       &html_jumppoints; print "</body></html>\n"; select STDOUT; close TEXT;
672       $html_lastf = $html_fnames{$chapternode};
673       $chapternode = $nodexrefs{$xref};
674       $html_nextf = $html_fnames{$tstruct_mnext{$chapternode}};
675       open TEXT,">$html_fnames{$chapternode}"; select TEXT; &html_preamble(1);
676       foreach $i (@$pname) {
677         $ww = &word_html($i);
678         $title .= $ww unless $ww eq "\001";
679       }
680       $h = "<h2><a name=\"$xref\">$title</a></h2>\n";
681       print $h; print FULL $h;
682     } elsif ($ptype eq "appn") {
683       # Appendix heading. Begin a new file.
684       $pflags =~ /appn (.*) :(.*)/;
685       $title = "Appendix $1: ";
686       $xref = $2;
687       &html_jumppoints; print "</body></html>\n"; select STDOUT; close TEXT;
688       $html_lastf = $html_fnames{$chapternode};
689       $chapternode = $nodexrefs{$xref};
690       $html_nextf = $html_fnames{$tstruct_mnext{$chapternode}};
691       open TEXT,">$html_fnames{$chapternode}"; select TEXT; &html_preamble(1);
692       foreach $i (@$pname) {
693         $ww = &word_html($i);
694         $title .= $ww unless $ww eq "\001";
695       }
696       print "<h2><a name=\"$xref\">$title</a></h2>\n";
697     } elsif ($ptype eq "head" || $ptype eq "subh") {
698       # Heading or subheading.
699       $pflags =~ /.... (.*) :(.*)/;
700       $hdr = ($ptype eq "subh" ? "h4" : "h3");
701       $title = $1 . " ";
702       $xref = $2;
703       foreach $i (@$pname) {
704         $ww = &word_html($i);
705         $title .= $ww unless $ww eq "\001";
706       }
707       print "<$hdr><a name=\"$xref\">$title</a></$hdr>\n";
708     } elsif ($ptype eq "code") {
709       # Code paragraph.
710       print "<p><pre>\n";
711       foreach $i (@$pname) {
712         $w = $i;
713         $w =~ s/&/&amp;/g;
714         $w =~ s/</&lt;/g;
715         $w =~ s/>/&gt;/g;
716         print $w, "\n";
717       }
718       print "</pre>\n";
719     } elsif ($ptype eq "bull" || $ptype eq "norm") {
720       # Ordinary paragraph, optionally bulleted. We wrap, with ragged
721       # 75-char right margin and either 7 or 11 char left margin
722       # depending on bullets.
723       if ($ptype eq "bull") {
724         $in_list = 1, print "<ul>\n" unless $in_list;
725         $line = '<li>';
726       } else {
727         $line = '<p>';
728       }
729       @a = @$pname;
730       $wd = $wprev = '';
731       do {
732         do { $w = &word_html(shift @a) } while $w eq "\001"; # nasty hack
733         $wd .= $wprev;
734         if ($w eq ' ' || $w eq '' || $w eq undef) {
735           if (length ($line . $wd) > 75) {
736             $line =~ s/\s*$//; # trim trailing spaces
737             print "$line\n";
738             $line = '';
739             $wd =~ s/^\s*//; # trim leading spaces
740           }
741           $line .= $wd;
742           $wd = '';
743         }
744         $wprev = $w;
745       } while ($w ne '' && $w ne undef);
746       if ($line =~ /\S/) {
747         $line =~ s/\s*$//; # trim trailing spaces
748         print "$line\n";
749       }
750     }
751   }
752
753   # Close whichever file was open.
754   &html_jumppoints;
755   print "</body></html>\n";
756   select STDOUT;
757   close TEXT;
758
759   print "\n   writing index file...";
760   open TEXT,">nasmdoci.html";
761   select TEXT;
762   &html_preamble(0);
763   print "<p align=center><a href=\"nasmdoc0.html\">Contents</a>\n";
764   print "<p>";
765   &html_index;
766   print "<p align=center><a href=\"nasmdoc0.html\">Contents</a>\n";
767   print "</body></html>\n";
768   select STDOUT;
769   close TEXT;
770 }
771
772 sub html_preamble {
773   print "<html><head><title>NASM Manual</title></head>\n";
774   print "<body><h1 align=center>The Netwide Assembler: NASM</h1>\n\n";
775   &html_jumppoints if $_[0];
776 }
777
778 sub html_jumppoints {
779   print "<p align=center>";
780   print "<a href=\"$html_nextf\">Next Chapter</a> |\n" if $html_nextf;
781   print "<a href=\"$html_lastf\">Previous Chapter</a> |\n" if $html_lastf;
782   print "<a href=\"nasmdoc0.html\">Contents</a> |\n";
783   print "<a href=\"nasmdoci.html\">Index</a>\n";
784 }
785
786 sub html_index {
787   my $itag, $a, @ientry, $sep, $w, $wd, $wprev, $line;
788
789   $chapternode = '';
790   foreach $itag (@itags) {
791     $ientry = $idxmap{$itag};
792     @a = @$ientry;
793     push @a, "n :";
794     $sep = 0;
795     foreach $node (@nodes) {
796       next if !$idxnodes{$node,$itag};
797       push @a, "n ," if $sep;
798       push @a, "sp", "x $xrefnodes{$node}", "n $node", "xe$xrefnodes{$node}";
799       $sep = 1;
800     }
801     $line = '';
802     do {
803       do { $w = &word_html(shift @a) } while $w eq "\001"; # nasty hack
804       $wd .= $wprev;
805       if ($w eq ' ' || $w eq '' || $w eq undef) {
806         if (length ($line . $wd) > 75) {
807           $line =~ s/\s*$//; # trim trailing spaces
808           print "$line\n";
809           $line = '';
810           $wd =~ s/^\s*//; # trim leading spaces
811         }
812         $line .= $wd;
813         $wd = '';
814       }
815       $wprev = $w;
816     } while ($w ne '' && $w ne undef);
817     if ($line =~ /\S/) {
818       $line =~ s/\s*$//; # trim trailing spaces
819       print "$line\n";
820     }
821     print "<br>\n";
822   }
823 }
824
825 sub word_html {
826   my ($w) = @_;
827   my $wtype, $wmajt, $pfx, $sfx;
828
829   return undef if $w eq '' || $w eq undef;
830
831   $wtype = substr($w,0,2);
832   $wmajt = substr($wtype,0,1);
833   $w = substr($w,2);
834   $pfx = $sfx = '';
835   $pfx = "<a href=\"$1\">", $sfx = "</a>", $w = $2
836     if $wmajt eq "w" && $w =~ /^<(.*)>(.*)$/;
837   $w =~ s/&/&amp;/g;
838   $w =~ s/</&lt;/g;
839   $w =~ s/>/&gt;/g;
840   if ($wmajt eq "n" || $wtype eq "e " || $wtype eq "w ") {
841     return $pfx . $w . $sfx;
842   } elsif ($wtype eq "sp") {
843     return ' ';
844   } elsif ($wtype eq "da") {
845     return '-'; # sadly, en-dashes are non-standard in HTML
846   } elsif ($wmajt eq "c" || $wtype eq "wc") {
847     return $pfx . "<code><nobr>${w}</nobr></code>" . $sfx;
848   } elsif ($wtype eq "es") {
849     return "<em>${w}";
850   } elsif ($wtype eq "ee") {
851     return "${w}</em>";
852   } elsif ($wtype eq "eo") {
853     return "<em>${w}</em>";
854   } elsif ($wtype eq "x ") {
855     # Magic: we must resolve the cross reference into file and marker
856     # parts, then dispose of the file part if it's us, and dispose of
857     # the marker part if the cross reference describes the top node of
858     # another file.
859     my $node = $nodexrefs{$w}; # find the node we're aiming at
860     my $level = $tstruct_level{$node}; # and its level
861     my $up = $node, $uplev = $level-1;
862     $up = $tstruct_up{$up} while $uplev--; # get top node of containing file
863     my $file = ($up ne $chapternode) ? $html_fnames{$up} : "";
864     my $marker = ($level == 1 and $file) ? "" : "#$w";
865     return "<a href=\"$file$marker\">";
866   } elsif ($wtype eq "xe") {
867     return "</a>";
868   } elsif ($wmajt eq "i") {
869     return "\001";
870   } else {
871     die "panic in word_html: $wtype$w\n";
872   }
873 }
874
875 sub ref_ps {
876     my($r) = @_;
877     $r =~ s/\./_/g;
878     return 'n'.$r;
879 }
880
881 sub ps_write_bookmarks {
882     my $para;
883     my %nchildren = ();
884     my %titles = ();
885     my @reflist = ();
886     my $ref, $pref, $i, $title;
887
888     for ($para = 0; $para <= $#pnames; $para++) {
889         my $pname = $pnames[$para];
890         my $pflags = $pflags[$para];
891         my $ptype = substr($pflags,0,4);
892         
893         if ($ptype eq "chap" || $ptype eq "appn") {
894             # Chapter/appendix heading. "Chapter N: Title" followed by a line of
895             # minus signs.
896             
897             $pflags =~ /(chap|appn) (.*) :(.*)/;
898             $ref = &ref_ps($2);
899             $title = '';
900             foreach $i (@$pname) {
901                 $title .= &word_ps_title($i);
902             }
903             $titles{$ref} = $title;
904             push @reflist, $ref;
905         } elsif ($ptype eq "head" || $ptype eq "subh") {
906             # Heading/subheading.  Just a number and some text.
907             $pflags =~ /.... (.*) :(.*)/;
908             $ref = &ref_ps($1);
909             $ref =~ /^(n[0-9A-Za-z_]+)\_[0-9A-Za-z]+$/;
910             $pref = $1;
911
912             $title = '';
913             foreach $i (@$pname) {
914                 $title .= &word_ps_title($i);
915             }
916             $titles{$ref} = $title;
917             push @reflist, $ref;
918             $nchildren{$pref}++;
919         }
920     }
921
922     # Now we should have enough data to generate the bookmarks
923     print "[/Title (Contents) /Dest /nContents /OUT pdfmark";
924     foreach $i ( @reflist ) {
925         print '[/Title (', $titles{$i}, ")\n";
926         print '/Count -', $nchildren{$i}, ' ' if ( $nchildren{$i} );
927         print "/Dest /$i /OUT pdfmark\n";
928     }
929     print "[/Title (Index) /Dest /nIndex /OUT pdfmark\n";
930 }
931
932 sub write_ps {
933   # This is called from the top level, so I won't bother using
934   # my or local.
935
936   # First, set up the font metric arrays.
937   &font_metrics;
938
939   # First stage: reprocess the source arrays into a list of
940   # lines, each of which is a list of word-strings, each of
941   # which has a single-letter font code followed by text.
942   # Each line also has an associated type, which will be
943   # used for final alignment and font selection and things.
944   #
945   # Font codes are:
946   #   n == Normal
947   #   e == Emphasised
948   #   c == Code
949   #  ' ' == space (no following text required)
950   #  '-' == dash (no following text required)
951   #
952   # Line types are:
953   #   chap == Chapter or appendix heading.
954   #   head == Major heading.
955   #   subh == Sub-heading.
956   #   Ccha == Contents entry for a chapter.
957   #   Chea == Contents entry for a heading.
958   #   Csub == Contents entry for a subheading.
959   #   cone == Code paragraph with just this one line on it.
960   #   cbeg == First line of multi-line code paragraph.
961   #   cbdy == Interior line of multi-line code paragraph.
962   #   cend == Final line of multi-line code paragraph.
963   #   none == Normal paragraph with just this one line on it.
964   #   nbeg == First line of multi-line normal paragraph.
965   #   nbdy == Interior line of multi-line normal paragraph.
966   #   nend == Final line of multi-line normal paragraph.
967   #   bone == Bulleted paragraph with just this one line on it.
968   #   bbeg == First line of multi-line bulleted paragraph.
969   #   bbdy == Interior line of multi-line bulleted paragraph.
970   #   bend == Final line of multi-line bulleted paragraph.
971   print "line-breaks...";
972   $lname = "psline000000";
973   $lnamei = "idx" . $lname;
974   @lnames = @ltypes = ();
975
976   $linewidth = 468;             # ADJUSTABLE: width of a normal text line
977   $bulletadj = 12;              # ADJUSTABLE: space for a bullet
978
979   for ($para = 0; $para <= $#pnames; $para++) {
980     $pname = $pnames[$para];
981     $pflags = $pflags[$para];
982     $ptype = substr($pflags,0,4);
983
984     # New paragraph _ergo_ new line.
985     @line = ();
986     @lindex = (); # list of index tags referenced to this line
987
988     if ($ptype eq "chap") {
989       # Chapter heading. "Chapter N: Title" followed by a line of
990       # minus signs.
991       $pflags =~ /chap (.*) :(.*)/;
992       push @line, "B".&ref_ps($1), "nChapter", " ", "n$1:", " ";
993       foreach $i (@$pname) {
994         $ww = &word_ps($i);
995         push @line, $ww unless $ww eq "x";
996       }
997       @$lname = @line; @$lnamei = @lindex;
998       push @lnames, $lname++;
999       $lnamei = "idx" . $lname;
1000       push @ltypes, "chap";
1001     } elsif ($ptype eq "appn") {
1002       # Appendix heading. "Appendix N: Title" followed by a line of
1003       # minus signs.
1004       $pflags =~ /appn (.*) :(.*)/;
1005       push @line, "B".&ref_ps($1), "nAppendix", " ", "n$1:", " ";
1006       foreach $i (@$pname) {
1007         $ww = &word_ps($i);
1008         push @line, $ww unless $ww eq "x";
1009       }
1010       @$lname = @line; @$lnamei = @lindex;
1011       push @lnames, $lname++;
1012       $lnamei = "idx" . $lname;
1013       push @ltypes, "chap";
1014     } elsif ($ptype eq "head") {
1015       # Heading. Just a number and some text.
1016       $pflags =~ /.... (.*) :(.*)/;
1017       push @line, "B".&ref_ps($1), "n$1";
1018       foreach $i (@$pname) {
1019         $ww = &word_ps($i);
1020         push @line, $ww unless $ww eq "x";
1021       }
1022       @$lname = @line; @$lnamei = @lindex;
1023       push @lnames, $lname++;
1024       $lnamei = "idx" . $lname;
1025       push @ltypes, $ptype;
1026     } elsif ($ptype eq "subh") {
1027       # Subheading. Just a number and some text.
1028       $pflags =~ /subh (.*) :(.*)/;
1029       push @line, "B".&ref_ps($1), "n$1";
1030       foreach $i (@$pname) {
1031         push @line, &word_ps($i);
1032       }
1033       @$lname = @line; @$lnamei = @lindex;
1034       push @lnames, $lname++;
1035       $lnamei = "idx" . $lname;
1036       push @ltypes, "subh";
1037     } elsif ($ptype eq "code") {
1038       # Code paragraph. Emit lines one at a time.
1039       $type = "cbeg";
1040       foreach $i (@$pname) {
1041         @$lname = ("c$i");
1042         push @lnames, $lname++;
1043         $lnamei = "idx" . $lname;
1044         push @ltypes, $type;
1045         $type = "cbdy";
1046       }
1047       $ltypes[$#ltypes] = ($ltypes[$#ltypes] eq "cbeg" ? "cone" : "cend");
1048     } elsif ($ptype eq "bull" || $ptype eq "norm") {
1049       # Ordinary paragraph, optionally bulleted. We wrap, with ragged
1050       # 75-char right margin and either 7 or 11 char left margin
1051       # depending on bullets.
1052       if ($ptype eq "bull") {
1053         $width = $linewidth - $bulletadj;
1054         $type = $begtype = "bbeg";
1055         $bodytype = "bbdy";
1056         $onetype = "bone";
1057         $endtype = "bend";
1058       } else {
1059         $width = $linewidth;
1060         $type = $begtype = "nbeg";
1061         $bodytype = "nbdy";
1062         $onetype = "none";
1063         $endtype = "nend";
1064       }
1065       @a = @$pname;
1066       @line = @wd = ();
1067       $linelen = 0;
1068       $wprev = undef;
1069       do {
1070         do { $w = &word_ps(shift @a) } while ($w eq "x");
1071         push @wd, $wprev if $wprev;
1072         if ($wprev =~ /^n.*-$/ || $w eq ' ' || $w eq '' || $w eq undef) {
1073           $wdlen = &len_ps(@wd);
1074           if ($linelen + $wdlen > $width) {
1075             pop @line while $line[$#line] eq ' '; # trim trailing spaces
1076             @$lname = @line; @$lnamei = @lindex;
1077             push @lnames, $lname++;
1078             $lnamei = "idx" . $lname;
1079             push @ltypes, $type;
1080             $type = $bodytype;
1081             @line = @lindex = ();
1082             $linelen = 0;
1083             shift @wd while $wd[0] eq ' '; # trim leading spaces
1084           }
1085           push @line, @wd;
1086           $linelen += $wdlen;
1087           @wd = ();
1088         }
1089         $wprev = $w;
1090       } while ($w ne '' && $w ne undef);
1091       if (@line) {
1092         pop @line while $line[$#line] eq ' '; # trim trailing spaces
1093         @$lname = @line; @$lnamei = @lindex;
1094         push @lnames, $lname++;
1095         $lnamei = "idx" . $lname;
1096         push @ltypes, $type;
1097         $type = $bodytype;
1098       }
1099       $ltypes[$#ltypes] =
1100         ($ltypes[$#ltypes] eq $begtype ? $onetype : $endtype);
1101     }
1102   }
1103
1104   # We've now processed the document source into lines. Before we
1105   # go on and do the page breaking, we'll fabricate a table of contents,
1106   # line by line, and then after doing page breaks we'll go back and
1107   # insert the page numbers into the contents entries.
1108   print "building contents...";
1109   @clnames = @cltypes = ();
1110   $clname = "pscont000000";
1111   @$clname = ("BnContents", "nContents"); # "chapter heading" for TOC
1112   push @clnames,$clname++;
1113   push @cltypes,"chap";
1114   for ($i=0; $i<=$#lnames; $i++) {
1115     $lname = $lnames[$i];
1116     if ($ltypes[$i] =~ /^(chap|head|subh)/) {
1117       @$clname = @$lname;
1118       splice @$clname,2,0," " if ($ltypes[$i] !~ /chap/);
1119       push @$clname,$i; # placeholder for page number
1120       push @clnames,$clname++;
1121       push @cltypes,"C" . substr($ltypes[$i],0,3);
1122     }
1123   }
1124   @$clname = ("BnIndex", "nIndex"); # contents entry for Index
1125   push @$clname,$i;      # placeholder for page number
1126   $idx_clname = $clname;
1127   push @clnames,$clname++;
1128   push @cltypes,"Ccha";
1129   $contlen = $#clnames + 1;
1130   unshift @lnames,@clnames;
1131   unshift @ltypes,@cltypes;
1132
1133   # Second stage: now we have a list of lines, break them into pages.
1134   # We do this by means of adding a third array in parallel with
1135   # @lnames and @ltypes, called @lpages, in which we store the page
1136   # number that each line resides on. We also add @ycoord which
1137   # stores the vertical position of each line on the page.
1138   #
1139   # Page breaks may not come after line-types:
1140   #   chap head subh cbeg nbeg bbeg
1141   # and may not come before line-types:
1142   #   cend nend bend
1143   # They are forced before line-types:
1144   #   chap
1145   print "page-breaks...";
1146   $pmax = 600; # ADJUSTABLE: maximum length of a page in points
1147   $textht = 11; # ADJUSTABLE: height of a normal line in points
1148   $spacing = 6; # ADJUSTABLE: space between paragraphs, in points
1149   $headht = 14; # ADJUSTABLE: height of a major heading in points
1150   $subht = 12; # ADJUSTABLE: height of a sub-heading in points
1151   $pstart = 0; # start line of current page
1152   $plen = 0; # current length of current page
1153   $pnum = 1; # number of current page
1154   $bpt = -1; # last feasible break point
1155   $i = 0; # line number
1156   while ($i <= $#lnames) {
1157     $lname = $lnames[$i];
1158     # Add the height of this line (computed the last time we went round
1159     # the loop, unless we're a chapter heading in which case we do it
1160     # now) to the length of the current page. Also, _put_ this line on
1161     # the current page, and allocate it a y-coordinate.
1162     if ($ltypes[$i] =~ /^chap$/) {
1163       $pnum += 1 - ($pnum & 1);  # advance to odd numbered page if necessary
1164       $plen = 100; # ADJUSTABLE: space taken up by a chapter heading
1165       $ycoord[$i] = 0; # chapter heading: y-coord doesn't matter
1166     } else {
1167       $ycoord[$i] = $plen + $space;
1168       $plen += $space + $ht;
1169     }
1170     # See if we can break after this line.
1171     $bpt = $i if $ltypes[$i] !~ /^chap|head|subh|cbeg|nbeg|bbeg$/ &&
1172                  $ltypes[$i+1] !~ /^cend|nend|bend$/;
1173     # Assume, to start with, that we don't break after this line.
1174     $break = 0;
1175     # See if a break is forced.
1176     $break = 1, $bpt = $i if $ltypes[$i+1] eq "chap" || !$ltypes[$i+1];
1177     # Otherwise, compute the height of the next line, and break if
1178     # it would make this page too long.
1179     $ht = $textht, $space = 0 if $ltypes[$i+1] =~ /^[nbc](bdy|end)$/;
1180     $ht = $textht, $space = $spacing if $ltypes[$i+1] =~ /^[nbc](one|beg)$/;
1181     $ht = $textht, $space = $spacing if $ltypes[$i+1] =~ /^C/;
1182     $ht = $subht, $space = $spacing if $ltypes[$i+1] eq "subh";
1183     $ht = $headht, $space = $spacing if $ltypes[$i+1] eq "head";
1184     $break = 1 if $plen + $space + $ht > $pmax;
1185     # Now, if we're breaking, assign page number $pnum to all lines up
1186     # to $bpt, set $i == $bpt+1, and zero $space since we are at the
1187     # start of a new page and don't want leading space.
1188     if ($break) {
1189       die "no feasible break point at all on page $pnum\n" if $bpt == -1;
1190       for ($j = $pstart; $j <= $bpt; $j++) {
1191         $lnamei = "idx" . $lnames[$j];
1192         foreach $k (@$lnamei) {
1193           ${$psidxpp{$k}}{$pnum} = 1;
1194         }
1195         $lpages[$j] = $pnum;
1196       }
1197       $pnum++;
1198       $i = $bpt;
1199       $bpt = -1;
1200       $pstart = $i+1;
1201       $plen = 0;
1202       $space = 0;
1203     }
1204     $i++;
1205   }
1206
1207   # Now fix up the TOC with page numbers.
1208   print "\n   fixing up contents...";
1209   for ($i=0; $i<=$#lnames; $i++) {
1210     $lname = $lnames[$i];
1211     if ($ltypes[$i] =~ /^C/) {
1212       $j = pop @$lname;
1213       push @$lname, "n" . $lpages[$j+$contlen];
1214     }
1215   }
1216
1217   # Having got page numbers for most stuff, generate an index.
1218   print "building index...";
1219   $iwid = 222;
1220   $sep = 12;
1221   $commaindent = 32;
1222   foreach $k (@itags) {
1223     @line = ();
1224     $cmd = "index";
1225     @idxentry = @{$idxmap{$k}};
1226     if ($commaafter{$k} and !$commanext{$k}) {
1227       # This line is a null line beginning a multiple entry. We must
1228       # output the prefix on a line by itself.
1229
1230       @idxhead = splice @idxentry,0,$commapos{$k};
1231       @line = ();
1232       foreach $i (@idxhead) {
1233         $ww = &word_ps($i);
1234         push @line, $ww unless $ww eq "x";
1235       }
1236       &ps_idxout("index",\@line,[]);
1237       $cmd = "iindex";
1238       @line = ();
1239     }
1240     $cmd = "iindex", splice @idxentry,0,$commapos{$k} if $commanext{$k};
1241     foreach $i (@idxentry) {
1242       $ww = &word_ps($i);
1243       push @line, $ww unless $ww eq "x";
1244     }
1245     $len = $iwid - $sep - &len_ps(@line);
1246     warn "text for index tag `%s' is longer than one index line!\n"
1247       if $len < -$sep;
1248     @pp = ();
1249     $inums = join(',',sort { $a <=> $b } keys %{$psidxpp{$k}});
1250     while (length $inums) {
1251       $inums =~ /^([^,]+)(,?)(.*)$/;
1252       $inums = $3, $inumc = $2; $inum = $1;
1253       @pnum = (" ", "Bp$inum", "n$inum", "E");
1254       push(@pnum, "n$inumc") if ( $inumc ne '' );
1255       $pnumlen = &len_ps(@pnum);
1256       if ($pnumlen > $len) {
1257         &ps_idxout($cmd,\@line,\@pp);
1258         @pp = ();
1259         @line = ();
1260         $cmd = "index";
1261         $len = $iwid - $sep;
1262       }
1263       push @pp, @pnum;
1264       $len -= $pnumlen;
1265     }
1266     &ps_idxout($cmd,\@line,\@pp) if (length @pp);
1267     $l1 = &len_ps(@line);
1268     $l2 = &len_ps($pp);
1269   }
1270   $$idx_clname[$#$idx_clname] = "n" . $pnum; # fix up TOC entry for index
1271
1272   print "writing file...";
1273   open PS,">nasmdoc.ps";
1274   select PS;
1275   $page = $lpages[0];
1276   &ps_header;
1277   &ps_write_bookmarks;
1278   for ($i=0; $i<=$#lnames; $i++) {
1279     &ps_throw_pg($page,$lpages[$i]) if $page != $lpages[$i];
1280     $page = $lpages[$i];
1281     &ps_out_line($ycoord[$i],$ltypes[$i],$lnames[$i]);
1282   }
1283   $i = 0;
1284   while ($i <= $#psindex) {
1285     &ps_throw_pg($page, $pnum) if $page != $pnum;
1286     $page = $pnum++;
1287     $ypos = 0;
1288     $ypos = 100, &ps_out_line(0, "chap", ["BnIndex", "nIndex"]) if !$i;
1289     $lines = ($pmax - $ypos) / $textht;
1290     my $col; # ps_out_line hits this variable
1291     PAGE:for ($col = 1; $col <= 2; $col++) {
1292       $y = $ypos; $l = $lines;
1293       COL: while ($l > 0) {
1294         $j = $i+1;
1295         $j++ while $psindex[$j] and ($psindex[$j][3] == 0); # find next break
1296         last COL if $j-$i > $l or $i > $#psindex;
1297         while ($i < $j) {
1298           &ps_out_line($y, $psindex[$i][0] eq "index" ? "idl$col" : "ldl$col",
1299                        $psindex[$i][1]);
1300           &ps_out_line($y,"idr$col",$psindex[$i][2]);
1301           $i++;
1302           $y += $textht;
1303           $l--;
1304         }
1305       }
1306       last PAGE if $i > $#psindex;
1307     }
1308   }
1309   &ps_trailer($page);
1310   close PS;
1311   select STDOUT;
1312 }
1313
1314 sub ps_idxout {
1315   my ($cmd, $left, $right) = @_;
1316   my $break = 1;
1317   $break = 0
1318       if ($#psindex >= 0) and ( ($#$left < 0) or ($cmd eq "iindex") );
1319   push @psindex,[$cmd,[@$left],[@$right],$break];
1320 }
1321
1322 sub ps_header {
1323     $pshdr = <<'EOF';
1324 /sp (n ) def
1325 /nf /Times-Roman findfont 11 scalefont def
1326 /ef /Times-Italic findfont 11 scalefont def
1327 /cf /Courier findfont 11 scalefont def
1328 /nc /Helvetica-Bold findfont 18 scalefont def
1329 /ec /Helvetica-Oblique findfont 18 scalefont def
1330 /cc /Courier-Bold findfont 18 scalefont def
1331 /nh /Helvetica-Bold findfont 14 scalefont def
1332 /eh /Helvetica-Oblique findfont 14 scalefont def
1333 /ch /Courier-Bold findfont 14 scalefont def
1334 /ns /Helvetica-Bold findfont 12 scalefont def
1335 /es /Helvetica-Oblique findfont 12 scalefont def
1336 /cs /Courier-Bold findfont 12 scalefont def
1337 /n 16#6E def /e 16#65 def /c 16#63 def
1338 /B 16#42 def /E 16#45 def /D 16#44 def
1339 /min { 2 copy gt { exch } if pop } def
1340 /max { 2 copy lt { exch } if pop } def
1341 /lkbegun 0 def
1342 /lkury 0 def
1343 /lkurx 0 def
1344 /lklly 0 def
1345 /lkllx 0 def
1346 /lktarget () def
1347 /linkbegin {
1348   /lkbegun 1 def
1349   /lktarget exch cvn def
1350 } def
1351 /linkshow {
1352   lkbegun 0 ne {
1353     gsave dup true charpath pathbbox grestore
1354     lkbegun 1 eq {
1355       /lkury exch def
1356       /lkurx exch def
1357       /lklly exch def
1358       /lkllx exch def
1359       /lkbegun 2 def
1360     } {
1361       lkury max /lkury exch def
1362       lkurx max /lkurx exch def
1363       lklly min /lklly exch def
1364       lkllx min /lkllx exch def
1365     } ifelse
1366   } if
1367   show
1368 } def
1369 /linkend {
1370   [/Rect [ lkllx lklly lkurx lkury ]
1371     /Color [ 1.0 0.0 0.0 ]
1372     /Border [0 0 0]
1373     /Dest lktarget
1374     /Subtype /Link
1375     /ANN pdfmark
1376   /lkbegun 0 def
1377 } def
1378 /linkdest {
1379   /lkdest exch cvn def
1380   [ /Dest lkdest
1381     /View [ /XYZ currentpoint 0 ]
1382     /DEST pdfmark
1383 } def
1384 /handlelink {
1385   dup 0 get
1386   dup B eq {
1387     pop dup length 1 sub 1 exch getinterval linkbegin
1388   } {
1389     E eq {
1390       pop linkend
1391     } {
1392       dup length 1 sub 1 exch getinterval linkdest
1393     } ifelse
1394   } ifelse
1395 } def
1396 /pageodd {
1397    550 50 moveto ns setfont dup stringwidth pop neg 0 rmoveto show
1398 } def
1399 /pageeven { 50 50 moveto ns setfont show } def
1400 /destmark {
1401   dup length 1 sub 1 exch getinterval linkdest
1402 } def
1403 /chapter {
1404   100 620 moveto
1405   dup 0 get destmark
1406   dup length 1 sub 1 exch getinterval
1407   {
1408     dup 0 get
1409     dup n eq {pop nc setfont} {
1410       e eq {ec setfont} {cc setfont} ifelse
1411     } ifelse
1412     dup length 1 sub 1 exch getinterval show
1413   } forall
1414   0 setlinecap 3 setlinewidth
1415   newpath 100 610 moveto 468 0 rlineto stroke
1416 } def
1417 /heading {
1418   686 exch sub /y exch def /a exch def
1419   90 y moveto
1420   a 0 get destmark
1421   a 1 get dup length 1 sub 1 exch getinterval
1422   nh setfont dup stringwidth pop neg 0 rmoveto show
1423   100 y moveto
1424   a dup length 2 sub 2 exch getinterval {
1425     /s exch def
1426     s 0 get
1427     dup n eq {pop nh setfont} {
1428       e eq {eh setfont} {ch setfont} ifelse
1429     } ifelse
1430     s s length 1 sub 1 exch getinterval show
1431   } forall
1432 } def
1433 /subhead {
1434   688 exch sub /y exch def /a exch def
1435   90 y moveto
1436   a 0 get destmark
1437   a 1 get dup length 1 sub 1 exch getinterval
1438   ns setfont dup stringwidth pop neg 0 rmoveto show
1439   100 y moveto
1440   a dup length 2 sub 2 exch getinterval {
1441     /s exch def
1442     s 0 get
1443     dup n eq {pop ns setfont} {
1444       e eq {es setfont} {cs setfont} ifelse
1445     } ifelse
1446     s s length 1 sub 1 exch getinterval show
1447   } forall
1448 } def
1449 /disp { /j exch def
1450   568 exch sub exch 689 exch sub moveto
1451   {
1452     /s exch def
1453     s 0 get
1454     dup E le {
1455       pop s handlelink
1456     } {
1457       dup n eq {pop nf setfont} {
1458         e eq {ef setfont} {cf setfont} ifelse
1459       } ifelse
1460       s s length 1 sub 1 exch getinterval linkshow
1461       s sp eq {j 0 rmoveto} if
1462     } ifelse
1463   } forall
1464 } def
1465 /contents { /w exch def /y exch def /a exch def
1466   /yy 689 y sub def
1467   a a length 1 sub get dup length 1 sub 1 exch getinterval
1468   /ss exch def
1469   nf setfont 568 ss stringwidth pop sub /ex exch def
1470   a 0 a length 1 sub getinterval y w 0 disp
1471   /sx currentpoint pop def nf setfont
1472   100 10 568 { /i exch def
1473     i 5 sub sx gt i 5 add ex lt and {
1474       i yy moveto (.) linkshow
1475     } if
1476   } for
1477   ex yy moveto ss linkshow
1478   linkend
1479 } def
1480 /just { /w exch def /y exch def /a exch def
1481   /jj w def /spaces 0 def
1482   a {
1483     /s exch def
1484     s 0 get
1485     dup n eq {pop nf setfont} {
1486       e eq {ef setfont} {cf setfont} ifelse
1487     } ifelse
1488     s s length 1 sub 1 exch getinterval stringwidth pop
1489     jj exch sub /jj exch def
1490     s sp eq {/spaces spaces 1 add def} if
1491   } forall
1492   a y w jj spaces spaces 0 eq {pop pop 0} {div} ifelse disp
1493 } def
1494 /idl { 468 exch sub 0 disp } def
1495 /ldl { 436 exch sub 0 disp } def
1496 /idr { 222 add 468 exch sub /x exch def /y exch def /a exch def
1497   a {
1498     /s exch def
1499     s 0 get
1500     dup E le {
1501       pop
1502     } {
1503       dup n eq {pop nf setfont} {
1504         e eq {ef setfont} {cf setfont} ifelse
1505       } ifelse
1506       s s length 1 sub 1 exch getinterval stringwidth pop
1507       x add /x exch def
1508     } ifelse
1509   } forall
1510   a y x 0 disp
1511 } def
1512 /left {0 disp} def
1513 /bullet {
1514   nf setfont dup 100 exch 689 exch sub moveto (\267) show
1515 } def
1516 [/PageMode /UseOutlines /DOCVIEW pdfmark
1517 EOF
1518   print "%!PS-Adobe-3.0\n";
1519   print "%%BoundingBox: 95 95 590 705\n";
1520   print "%%Creator: a nasty Perl script\n";
1521   print "%%DocumentData: Clean7Bit\n";
1522   print "%%Orientation: Portrait\n";
1523   print "%%Pages: $lpages[$#lpages]\n";
1524   print "%%DocumentNeededResources: font Times-Roman Times-Italic\n";
1525   print "%%+ font Helvetica-Bold Courier Courier-Bold\n";
1526   print "%%EndComments\n";
1527   print "%%BeginProlog\n";
1528   # This makes sure non-PDF PostScript interpreters don't choke on
1529   # pdfmarks in the output
1530   print "/pdfmark where\n";
1531   print "{pop} {userdict /pdfmark /cleartomark load put} ifelse\n";
1532   print "%%EndProlog\n";
1533   print "%%BeginSetup\n";
1534   print "save\n";
1535   $pshdr =~ s/\s+/ /g;
1536   while ($pshdr =~ /\S/) {
1537     last if length($pshdr) < 72 || $pshdr !~ /^(.{0,72}\S)\s(.*)$/;
1538     $pshdr = $2;
1539     print "$1\n";
1540   }
1541   print "$pshdr\n" if $pshdr =~ /\S/;
1542   print "%%EndSetup\n";
1543   &ps_initpg($lpages[0]);
1544 }
1545
1546 sub ps_trailer {
1547   my ($oldpg) = @_;
1548   &ps_donepg($oldpg);
1549   print "%%Trailer\nrestore\n%%EOF\n";
1550 }
1551
1552 sub ps_throw_pg {
1553   my ($oldpg, $newpg) = @_;
1554   while ($oldpg < $newpg) {
1555     &ps_donepg($oldpg);
1556     $oldpg++;
1557     &ps_initpg($oldpg);
1558   }
1559 }
1560
1561 sub ps_initpg {
1562   my ($pgnum) = @_;
1563   print "%%Page: $pgnum $pgnum\n";
1564   print "%%BeginPageSetup\nsave\n%%EndPageSetup\n";
1565   print "95 705 moveto (p$pgnum) linkdest\n";
1566 }
1567
1568 sub ps_donepg {
1569   my ($pgnum) = @_;
1570   if ($pgnum & 1) {
1571     print "%%PageTrailer\n($pgnum)pageodd restore showpage\n";
1572   } else {
1573     print "%%PageTrailer\n($pgnum)pageeven restore showpage\n";
1574   }
1575 }
1576
1577 sub ps_out_line {
1578   my ($ypos,$ltype,$lname) = @_;
1579   my $c,$d,$wid;
1580
1581   print "[";
1582   $col = 1;
1583   foreach $c (@$lname) {#
1584     $c= "n " if $c eq " ";
1585     $c = "n\261" if $c eq "-";
1586     $d = '';
1587     while (length $c) {
1588       $d .= $1, $c = $2 while $c =~ /^([ -\'\*-\[\]-~]+)(.*)$/;
1589       while (1) {
1590         $d .= "\\$1", $c = $2, next if $c =~ /^([\\\(\)])(.*)$/;
1591         ($d .= sprintf "\\%3o",unpack("C",$1)), $c = $2, next
1592           if $c =~ /^([^ -~])(.*)$/;
1593         last;
1594       }
1595     }
1596     $d = "($d)";
1597     $col = 0, print "\n" if $col>0 && $col+length $d > 77;
1598     print $d;
1599     $col += length $d;
1600   }
1601   print "\n" if $col > 60;
1602   print "]";
1603   if ($ltype =~ /^[nb](beg|bdy)$/) {
1604     printf "%d %s%d just\n",
1605       $ypos, ($ltype eq "bbeg" ? "bullet " : ""),
1606       ($ltype =~ /^b/ ? 456 : 468);
1607   } elsif ($ltype =~ /^[nb](one|end)$/) {
1608     printf "%d %s%d left\n",
1609       $ypos, ($ltype eq "bone" ? "bullet " : ""),
1610       ($ltype =~ /^b/ ? 456 : 468);
1611   } elsif ($ltype =~ /^c(one|beg|bdy|end)$/) {
1612     printf "$ypos 468 left\n";
1613   } elsif ($ltype =~ /^C/) {
1614     $wid = 468;
1615     $wid = 456 if $ltype eq "Chea";
1616     $wid = 444 if $ltype eq "Csub";
1617     printf "$ypos $wid contents\n";
1618   } elsif ($ltype eq "chap") {
1619     printf "chapter\n";
1620   } elsif ($ltype eq "head") {
1621     printf "$ypos heading\n";
1622   } elsif ($ltype eq "subh") {
1623     printf "$ypos subhead\n";
1624   } elsif ($ltype =~ /([il]d[lr])([12])/) {
1625     $left = ($2 eq "2" ? 468-222 : 0);
1626     printf "$ypos $left $1\n";
1627   }
1628 }
1629
1630 sub word_ps {
1631   my ($w) = @_;
1632   my $wtype, $wmajt;
1633
1634   return undef if $w eq '' || $w eq undef;
1635
1636   $wtype = substr($w,0,2);
1637   $wmajt = substr($wtype,0,1);
1638   $w = substr($w,2);
1639   $w =~ s/<.*>// if $wmajt eq "w"; # remove web links
1640   if ($wmajt eq "n" || $wtype eq "w ") {
1641     return "n$w";
1642   } elsif ($wtype eq "sp") {
1643     return ' ';
1644   } elsif ($wtype eq "da") {
1645     return '-';
1646   } elsif ($wmajt eq "c" || $wtype eq "wc") {
1647     return "c$w";
1648   } elsif ($wmajt eq "e") {
1649     return "e$w";
1650   } elsif ($wmajt eq "x") {
1651     return "x";
1652   } elsif ($wtype eq "i ") {
1653     push @lindex, $w;
1654     return "x";
1655   } else {
1656     die "panic in word_ps: $wtype$w\n";
1657   }
1658 }
1659
1660 sub word_ps_title {
1661   my ($w) = @_;
1662   my $wtype, $wmajt;
1663
1664   return undef if $w eq '' || $w eq undef;
1665
1666   $wtype = substr($w,0,2);
1667   $wmajt = substr($wtype,0,1);
1668   $w = substr($w,2);
1669   $w =~ s/<.*>// if $wmajt eq "w"; # remove web links
1670   if ($wmajt eq "n" || $wtype eq "w ") {
1671     return $w;
1672   } elsif ($wtype eq "sp") {
1673     return ' ';
1674   } elsif ($wtype eq "da") {
1675     return '-';
1676   } elsif ($wmajt eq "c" || $wtype eq "wc") {
1677     return $w;
1678   } elsif ($wmajt eq "e") {
1679     return $w;
1680   } elsif ($wmajt eq "x") {
1681     return '';
1682   } elsif ($wtype eq "i ") {
1683     return '';
1684   } else {
1685     die "panic in word_ps_title: $wtype$w\n";
1686   }
1687 }
1688
1689 sub len_ps {
1690   my (@line) = @_;
1691   my $l = 0;
1692   my $w, $size;
1693
1694   $size = 11/1000; # used only for length calculations
1695   while ($w = shift @line) {
1696     $w = "n " if $w eq " ";
1697     $w = "n\261" if $w eq "-";
1698     $f = substr($w,0,1);
1699     if ( $f !~ /^[BDE]$/ ) {
1700         $f = "timesr" if $f eq "n";
1701         $f = "timesi" if $f eq "e";
1702         $f = "courr" if $f eq "c";
1703         foreach $c (unpack 'C*',substr($w,1)) {
1704             $l += $size * $$f[$c];
1705         }
1706     }
1707   }
1708   return $l;
1709 }
1710
1711 sub write_texi {
1712   # This is called from the top level, so I won't bother using
1713   # my or local.
1714
1715   # Open file.
1716   print "writing file...";
1717   open TEXT,">nasmdoc.texi";
1718   select TEXT;
1719
1720   # Preamble.
1721   print "\\input texinfo   \@c -*-texinfo-*-\n";
1722   print "\@c \%**start of header\n";
1723   print "\@setfilename ",$metadata{'infofile'},".info\n";
1724   print "\@dircategory ",$metadata{'category'},"\n";
1725   print "\@direntry\n";
1726   printf "* %-28s %s.\n",
1727   sprintf('%s: (%s).', $metadata{'infoname'}, $metadata{'infofile'}),
1728   $metadata{'infotitle'};
1729   print "\@end direntry\n";
1730   print "\@settitle ",$metadata{'title'},"\n";
1731   print "\@setchapternewpage odd\n";
1732   print "\@c \%**end of header\n";
1733   print "\n";
1734   print "\@ifinfo\n";
1735   print $metadata{'summary'}, "\n";
1736   print "\n";
1737   print "Copyright ",$metadata{'year'}," ",$metadata{'author'},"\n";
1738   print "\n";
1739   print $metadata{'license'}, "\n";
1740   print "\@end ifinfo\n";
1741   print "\n";
1742   print "\@titlepage\n";
1743   print "\@title ",$metadata{'title'},"\n";
1744   print "\@author ",$metadata{'author'},"\n";
1745   print "\n";
1746   print "\@page\n";
1747   print "\@vskip 0pt plus 1filll\n";
1748   print "Copyright \@copyright{} ",$metadata{'year'},' ',$metadata{'author'},"\n";
1749   print "\n";
1750   print $metadata{'license'}, "\n";
1751   print "\@end titlepage\n";
1752   print "\n";
1753   print "\@node Top, $tstruct_next{'Top'}, (dir), (dir)\n";
1754   print "\@top ",$metadata{'infotitle'},"\n";
1755   print "\n";
1756   print "\@ifinfo\n";
1757   print $metadata{'summary'}, "\n";
1758   print "\@end ifinfo\n";
1759
1760   $node = "Top";
1761
1762   $bulleting = 0;
1763   for ($para = 0; $para <= $#pnames; $para++) {
1764     $pname = $pnames[$para];
1765     $pflags = $pflags[$para];
1766     $ptype = substr($pflags,0,4);
1767
1768     $bulleting = 0, print "\@end itemize\n" if $bulleting && $ptype ne "bull";
1769     print "\n"; # always one of these before a new paragraph
1770
1771     if ($ptype eq "chap") {
1772       # Chapter heading. Begin a new node.
1773       &texi_menu($node)
1774         if $tstruct_level{$tstruct_next{$node}} > $tstruct_level{$node};
1775       $pflags =~ /chap (.*) :(.*)/;
1776       $node = "Chapter $1";
1777       $title = "Chapter $1: ";
1778       foreach $i (@$pname) {
1779         $ww = &word_texi($i);
1780         $title .= $ww unless $ww eq "\001";
1781       }
1782       print "\@node $node, $tstruct_next{$node}, $tstruct_prev{$node},";
1783       print " $tstruct_up{$node}\n\@unnumbered $title\n";
1784     } elsif ($ptype eq "appn") {
1785       # Appendix heading. Begin a new node.
1786       &texi_menu($node)
1787         if $tstruct_level{$tstruct_next{$node}} > $tstruct_level{$node};
1788       $pflags =~ /appn (.*) :(.*)/;
1789       $node = "Appendix $1";
1790       $title = "Appendix $1: ";
1791       foreach $i (@$pname) {
1792         $ww = &word_texi($i);
1793         $title .= $ww unless $ww eq "\001";
1794       }
1795       print "\@node $node, $tstruct_next{$node}, $tstruct_prev{$node},";
1796       print " $tstruct_up{$node}\n\@unnumbered $title\n";
1797     } elsif ($ptype eq "head" || $ptype eq "subh") {
1798       # Heading or subheading. Begin a new node.
1799       &texi_menu($node)
1800         if $tstruct_level{$tstruct_next{$node}} > $tstruct_level{$node};
1801       $pflags =~ /.... (.*) :(.*)/;
1802       $node = "Section $1";
1803       $title = "$1. ";
1804       foreach $i (@$pname) {
1805         $ww = &word_texi($i);
1806         $title .= $ww unless $ww eq "\001";
1807       }
1808       print "\@node $node, $tstruct_next{$node}, $tstruct_prev{$node},";
1809       print " $tstruct_up{$node}\n";
1810       $hdr = ($ptype eq "subh" ? "\@unnumberedsubsec" : "\@unnumberedsec");
1811       print "$hdr $title\n";
1812     } elsif ($ptype eq "code") {
1813       # Code paragraph. Surround with @example / @end example.
1814       print "\@example\n";
1815       foreach $i (@$pname) {
1816         warn "code line longer than 68 chars: $i\n" if length $i > 68;
1817         $i =~ s/\@/\@\@/g;
1818         $i =~ s/\{/\@\{/g;
1819         $i =~ s/\}/\@\}/g;
1820         print "$i\n";
1821       }
1822       print "\@end example\n";
1823     } elsif ($ptype eq "bull" || $ptype eq "norm") {
1824       # Ordinary paragraph, optionally bulleted. We wrap, FWIW.
1825       if ($ptype eq "bull") {
1826         $bulleting = 1, print "\@itemize \@bullet\n" if !$bulleting;
1827         print "\@item\n";
1828       }
1829       $line = '';
1830       @a = @$pname;
1831       $wd = $wprev = '';
1832       do {
1833         do { $w = &word_texi(shift @a); } while $w eq "\001"; # hack
1834         $wd .= $wprev;
1835         if ($wprev =~ /-$/ || $w eq ' ' || $w eq '' || $w eq undef) {
1836           if (length ($line . $wd) > 75) {
1837             $line =~ s/\s*$//; # trim trailing spaces
1838             print "$line\n";
1839             $line = '';
1840             $wd =~ s/^\s*//; # trim leading spaces
1841           }
1842           $line .= $wd;
1843           $wd = '';
1844         }
1845         $wprev = $w;
1846       } while ($w ne '' && $w ne undef);
1847       if ($line =~ /\S/) {
1848         $line =~ s/\s*$//; # trim trailing spaces
1849         print "$line\n";
1850       }
1851     }
1852   }
1853
1854   # Write index.
1855   &texi_index;
1856
1857   # Close file.
1858   print "\n\@contents\n\@bye\n";
1859   select STDOUT;
1860   close TEXT;
1861 }
1862
1863 # Side effect of this procedure: update global `texiwdlen' to be the length
1864 # in chars of the formatted version of the word.
1865 sub word_texi {
1866   my ($w) = @_;
1867   my $wtype, $wmajt;
1868
1869   return undef if $w eq '' || $w eq undef;
1870   $wtype = substr($w,0,2);
1871   $wmajt = substr($wtype,0,1);
1872   $w = substr($w,2);
1873   $wlen = length $w;
1874   $w =~ s/\@/\@\@/g;
1875   $w =~ s/\{/\@\{/g;
1876   $w =~ s/\}/\@\}/g;
1877   $w =~ s/<.*>// if $wmajt eq "w"; # remove web links
1878   substr($w,0,1) =~ tr/a-z/A-Z/, $capital = 0 if $capital;
1879   if ($wmajt eq "n" || $wtype eq "e " || $wtype eq "w ") {
1880     $texiwdlen = $wlen;
1881     return $w;
1882   } elsif ($wtype eq "sp") {
1883     $texiwdlen = 1;
1884     return ' ';
1885   } elsif ($wtype eq "da") {
1886     $texiwdlen = 2;
1887     return '--';
1888   } elsif ($wmajt eq "c" || $wtype eq "wc") {
1889     $texiwdlen = 2 + $wlen;
1890     return "\@code\{$w\}";
1891   } elsif ($wtype eq "es") {
1892     $texiwdlen = 1 + $wlen;
1893     return "\@emph\{${w}";
1894   } elsif ($wtype eq "ee") {
1895     $texiwdlen = 1 + $wlen;
1896     return "${w}\}";
1897   } elsif ($wtype eq "eo") {
1898     $texiwdlen = 2 + $wlen;
1899     return "\@emph\{${w}\}";
1900   } elsif ($wtype eq "x ") {
1901     $texiwdlen = 0; # we don't need it in this case
1902     $capital = 1; # hack
1903     return "\@ref\{";
1904   } elsif ($wtype eq "xe") {
1905     $texiwdlen = 0; # we don't need it in this case
1906     return "\}";
1907   } elsif ($wmajt eq "i") {
1908     $texiwdlen = 0; # we don't need it in this case
1909     return "\001";
1910   } else {
1911     die "panic in word_texi: $wtype$w\n";
1912   }
1913 }
1914
1915 sub texi_menu {
1916   my ($topitem) = @_;
1917   my $item, $i, $mpname, $title, $wd;
1918
1919   $item = $tstruct_next{$topitem};
1920   print "\@menu\n";
1921   while ($item) {
1922     $title = "";
1923     $mpname = $tstruct_pname{$item};
1924     foreach $i (@$mpname) {
1925       $wd = &word_texi($i);
1926       $title .= $wd unless $wd eq "\001";
1927     }
1928     print "* ${item}:: $title\n";
1929     $item = $tstruct_mnext{$item};
1930   }
1931   print "* Index::\n" if $topitem eq "Top";
1932   print "\@end menu\n";
1933 }
1934
1935 sub texi_index {
1936   my $itag, $ientry, @a, $wd, $item, $len;
1937   my $subnums = "123456789ABCDEFGHIJKLMNOPQRSTU" .
1938                 "VWXYZabcdefghijklmnopqrstuvwxyz";
1939
1940   print "\@ifinfo\n\@node Index, , $FIXMElastnode, Top\n";
1941   print "\@unnumbered Index\n\n\@menu\n";
1942
1943   foreach $itag (@itags) {
1944     $ientry = $idxmap{$itag};
1945     @a = @$ientry;
1946     $item = '';
1947     $len = 0;
1948     foreach $i (@a) {
1949       $wd = &word_texi($i);
1950       $item .= $wd, $len += $texiwdlen unless $wd eq "\001";
1951     }
1952     $i = 0;
1953     foreach $node (@nodes) {
1954       next if !$idxnodes{$node,$itag};
1955       printf "* %s%s (%s): %s.\n",
1956           $item, " " x (40-$len), substr($subnums,$i++,1), $node;
1957     }
1958   }
1959   print "\@end menu\n\@end ifinfo\n";
1960 }
1961
1962 sub write_hlp {
1963   # This is called from the top level, so I won't bother using
1964   # my or local.
1965
1966   # Build the index-tag text forms.
1967   print "building index entries...";
1968   @hlp_index = map {
1969                  my $i,$ww;
1970                  my $ientry = $idxmap{$_};
1971                  my $title = "";
1972                  foreach $i (@$ientry) {
1973                    $ww = &word_hlp($i,0);
1974                    $title .= $ww unless $ww eq "\001";
1975                  }
1976                  $title;
1977                } @itags;
1978
1979   # Write the HPJ project-description file.
1980   print "writing .hpj file...";
1981   open HPJ,">nasmdoc.hpj";
1982   print HPJ "[OPTIONS]\ncompress=true\n";
1983   print HPJ "title=NASM: The Netwide Assembler\noldkeyphrase=no\n\n";
1984   print HPJ "[FILES]\nnasmdoc.rtf\n\n";
1985   print HPJ "[CONFIG]\n";
1986   print HPJ 'CreateButton("btn_up", "&Up",'.
1987             ' "JumpContents(`nasmdoc.hlp'."'".')")';
1988   print HPJ "\nBrowseButtons()\n";
1989   close HPJ;
1990
1991   # Open file.
1992   print "\n   writing .rtf file...";
1993   open TEXT,">nasmdoc.rtf";
1994   select TEXT;
1995
1996   # Preamble.
1997   print "{\\rtf1\\ansi{\\fonttbl\n";
1998   print "\\f0\\froman Times New Roman;\\f1\\fmodern Courier New;\n";
1999   print "\\f2\\fswiss Arial;\\f3\\ftech Wingdings}\\deff0\n";
2000   print "#{\\footnote Top}\n";
2001   print "\${\\footnote Contents}\n";
2002   print "+{\\footnote browse:00000}\n";
2003   print "!{\\footnote DisableButton(\"btn_up\")}\n";
2004   print "\\keepn\\f2\\b\\fs30\\sb0\n";
2005   print "NASM: The Netwide Assembler\n";
2006   print "\\par\\pard\\plain\\sb120\n";
2007   print "This file documents NASM, the Netwide Assembler: an assembler \n";
2008   print "targetting the Intel x86 series of processors, with portable source.\n";
2009
2010   $node = "Top";
2011   $browse = 0;
2012
2013   $newpar = "\\par\\sb120\n";
2014   for ($para = 0; $para <= $#pnames; $para++) {
2015     $pname = $pnames[$para];
2016     $pflags = $pflags[$para];
2017     $ptype = substr($pflags,0,4);
2018
2019     print $newpar;
2020     $newpar = "\\par\\sb120\n";
2021
2022     if ($ptype eq "chap") {
2023       # Chapter heading. Begin a new node.
2024       &hlp_menu($node)
2025         if $tstruct_level{$tstruct_next{$node}} > $tstruct_level{$node};
2026       $pflags =~ /chap (.*) :(.*)/;
2027       $node = "Chapter $1";
2028       $title = $footnotetitle = "Chapter $1: ";
2029       foreach $i (@$pname) {
2030         $ww = &word_hlp($i,1);
2031         $title .= $ww, $footnotetitle .= &word_hlp($i,0) unless $ww eq "\001";
2032       }
2033       print "\\page\n";
2034       printf "#{\\footnote %s}\n", &hlp_sectkw($node);
2035       print "\${\\footnote $footnotetitle}\n";
2036       printf "+{\\footnote browse:%05d}\n", ++$browse;
2037       printf "!{\\footnote ChangeButtonBinding(\"btn_up\"," .
2038              "\"JumpId(\`nasmdoc.hlp',\`%s')\");\n",
2039              &hlp_sectkw($tstruct_up{$node});
2040       print "EnableButton(\"btn_up\")}\n";
2041       &hlp_keywords($node);
2042       print "\\keepn\\f2\\b\\fs30\\sb60\\sa60\n";
2043       print "$title\n";
2044       $newpar = "\\par\\pard\\plain\\sb120\n";
2045     } elsif ($ptype eq "appn") {
2046       # Appendix heading. Begin a new node.
2047       &hlp_menu($node)
2048         if $tstruct_level{$tstruct_next{$node}} > $tstruct_level{$node};
2049       $pflags =~ /appn (.*) :(.*)/;
2050       $node = "Appendix $1";
2051       $title = $footnotetitle = "Appendix $1: ";
2052       foreach $i (@$pname) {
2053         $ww = &word_hlp($i,1);
2054         $title .= $ww, $footnotetitle .= &word_hlp($i,0) unless $ww eq "\001";
2055       }
2056       print "\\page\n";
2057       printf "#{\\footnote %s}\n", &hlp_sectkw($node);
2058       print "\${\\footnote $footnotetitle}\n";
2059       printf "+{\\footnote browse:%05d}\n", ++$browse;
2060       printf "!{\\footnote ChangeButtonBinding(\"btn_up\"," .
2061              "\"JumpId(\`nasmdoc.hlp',\`%s')\");\n",
2062              &hlp_sectkw($tstruct_up{$node});
2063       print "EnableButton(\"btn_up\")}\n";
2064       &hlp_keywords($node);
2065       print "\\keepn\\f2\\b\\fs30\\sb60\\sa60\n";
2066       print "$title\n";
2067       $newpar = "\\par\\pard\\plain\\sb120\n";
2068     } elsif ($ptype eq "head" || $ptype eq "subh") {
2069       # Heading or subheading. Begin a new node.
2070       &hlp_menu($node)
2071         if $tstruct_level{$tstruct_next{$node}} > $tstruct_level{$node};
2072       $pflags =~ /.... (.*) :(.*)/;
2073       $node = "Section $1";
2074       $title = $footnotetitle = "$1. ";
2075       foreach $i (@$pname) {
2076         $ww = &word_hlp($i,1);
2077         $title .= $ww, $footnotetitle .= &word_hlp($i,0) unless $ww eq "\001";
2078       }
2079       print "\\page\n";
2080       printf "#{\\footnote %s}\n", &hlp_sectkw($node);
2081       print "\${\\footnote $footnotetitle}\n";
2082       printf "+{\\footnote browse:%05d}\n", ++$browse;
2083       printf "!{\\footnote ChangeButtonBinding(\"btn_up\"," .
2084              "\"JumpId(\`nasmdoc.hlp',\`%s')\");\n",
2085              &hlp_sectkw($tstruct_up{$node});
2086       print "EnableButton(\"btn_up\")}\n";
2087       &hlp_keywords($node);
2088       print "\\keepn\\f2\\b\\fs30\\sb60\\sa60\n";
2089       print "$title\n";
2090       $newpar = "\\par\\pard\\plain\\sb120\n";
2091     } elsif ($ptype eq "code") {
2092       # Code paragraph.
2093       print "\\keep\\f1\\sb120\n";
2094       foreach $i (@$pname) {
2095         warn "code line longer than 68 chars: $i\n" if length $i > 68;
2096         $i =~ s/\\/\\\\/g;
2097         $i =~ s/\{/\\\{/g;
2098         $i =~ s/\}/\\\}/g;
2099         print "$i\\par\\sb0\n";
2100       }
2101       $newpar = "\\pard\\f0\\sb120\n";
2102     } elsif ($ptype eq "bull" || $ptype eq "norm") {
2103       # Ordinary paragraph, optionally bulleted. We wrap, FWIW.
2104       if ($ptype eq "bull") {
2105         print "\\tx360\\li360\\fi-360{\\f3\\'9F}\\tab\n";
2106         $newpar = "\\par\\pard\\sb120\n";
2107       } else {
2108         $newpar = "\\par\\sb120\n";
2109       }
2110       $line = '';
2111       @a = @$pname;
2112       $wd = $wprev = '';
2113       do {
2114         do { $w = &word_hlp((shift @a),1); } while $w eq "\001"; # hack
2115         $wd .= $wprev;
2116         if ($w eq ' ' || $w eq '' || $w eq undef) {
2117           if (length ($line . $wd) > 75) {
2118             $line =~ s/\s*$//; # trim trailing spaces
2119             print "$line \n"; # and put one back
2120             $line = '';
2121             $wd =~ s/^\s*//; # trim leading spaces
2122           }
2123           $line .= $wd;
2124           $wd = '';
2125         }
2126         $wprev = $w;
2127       } while ($w ne '' && $w ne undef);
2128       if ($line =~ /\S/) {
2129         $line =~ s/\s*$//; # trim trailing spaces
2130         print "$line\n";
2131       }
2132     }
2133   }
2134
2135   # Close file.
2136   print "\\page}\n";
2137   select STDOUT;
2138   close TEXT;
2139 }
2140
2141 sub word_hlp {
2142   my ($w, $docode) = @_;
2143   my $wtype, $wmajt;
2144
2145   return undef if $w eq '' || $w eq undef;
2146   $wtype = substr($w,0,2);
2147   $wmajt = substr($wtype,0,1);
2148   $w = substr($w,2);
2149   $w =~ s/\\/\\\\/g;
2150   $w =~ s/\{/\\\{/g;
2151   $w =~ s/\}/\\\}/g;
2152   $w =~ s/<.*>// if $wmajt eq "w"; # remove web links
2153   substr($w,0,length($w)-1) =~ s/-/\\\'AD/g if $wmajt ne "x"; #nonbreakhyphens
2154   if ($wmajt eq "n" || $wtype eq "e " || $wtype eq "w ") {
2155     return $w;
2156   } elsif ($wtype eq "sp") {
2157     return ' ';
2158   } elsif ($wtype eq "da") {
2159     return "\\'96";
2160   } elsif ($wmajt eq "c" || $wtype eq "wc") {
2161     $w =~ s/ /\\\'A0/g; # make spaces non-breaking
2162     return $docode ? "{\\f1 ${w}}" : $w;
2163   } elsif ($wtype eq "es") {
2164     return "{\\i ${w}";
2165   } elsif ($wtype eq "ee") {
2166     return "${w}}";
2167   } elsif ($wtype eq "eo") {
2168     return "{\\i ${w}}";
2169   } elsif ($wtype eq "x ") {
2170     return "{\\uldb ";
2171   } elsif ($wtype eq "xe") {
2172     $w = &hlp_sectkw($w);
2173     return "}{\\v ${w}}";
2174   } elsif ($wmajt eq "i") {
2175     return "\001";
2176   } else {
2177     die "panic in word_hlp: $wtype$w\n";
2178   }
2179 }
2180
2181 sub hlp_menu {
2182   my ($topitem) = @_;
2183   my $item, $kword, $i, $mpname, $title;
2184
2185   $item = $tstruct_next{$topitem};
2186   print "\\li360\\fi-360\n";
2187   while ($item) {
2188     $title = "";
2189     $mpname = $tstruct_pname{$item};
2190     foreach $i (@$mpname) {
2191       $ww = &word_hlp($i, 0);
2192       $title .= $ww unless $ww eq "\001";
2193     }
2194     $kword = &hlp_sectkw($item);
2195     print "{\\uldb ${item}: $title}{\\v $kword}\\par\\sb0\n";
2196     $item = $tstruct_mnext{$item};
2197   }
2198   print "\\pard\\sb120\n";
2199 }
2200
2201 sub hlp_sectkw {
2202   my ($node) = @_;
2203   $node =~ tr/A-Z/a-z/;
2204   $node =~ tr/- ./___/;
2205   $node;
2206 }
2207
2208 sub hlp_keywords {
2209   my ($node) = @_;
2210   my $pfx = "K{\\footnote ";
2211   my $done = 0;
2212   foreach $i (0..$#itags) {
2213     (print $pfx,$hlp_index[$i]), $pfx = ";\n", $done++
2214         if $idxnodes{$node,$itags[$i]};
2215   }
2216   print "}\n" if $done;
2217 }
2218
2219 # Make tree structures. $tstruct_* is top-level and global.
2220 sub add_item {
2221   my ($item, $level) = @_;
2222   my $i;
2223
2224   $tstruct_pname{$item} = $pname;
2225   $tstruct_next{$tstruct_previtem} = $item;
2226   $tstruct_prev{$item} = $tstruct_previtem;
2227   $tstruct_level{$item} = $level;
2228   $tstruct_up{$item} = $tstruct_last[$level-1];
2229   $tstruct_mnext{$tstruct_last[$level]} = $item;
2230   $tstruct_last[$level] = $item;
2231   for ($i=$level+1; $i<$MAXLEVEL; $i++) { $tstruct_last[$i] = undef; }
2232   $tstruct_previtem = $item;
2233   push @nodes, $item;
2234 }
2235
2236 # PostScript font metric data. Used for line breaking.
2237 sub font_metrics {
2238   @timesr = (
2239      250,   0,   0,   0,   0,   0,   0,   0,
2240        0,   0,   0,   0,   0,   0,   0,   0,
2241        0,   0,   0,   0,   0,   0,   0,   0,
2242        0,   0,   0,   0,   0,   0,   0,   0,
2243      250, 333, 408, 500, 500, 833, 778, 333,
2244      333, 333, 500, 564, 250, 333, 250, 278,
2245      500, 500, 500, 500, 500, 500, 500, 500,
2246      500, 500, 278, 278, 564, 564, 564, 444,
2247      921, 722, 667, 667, 722, 611, 556, 722,
2248      722, 333, 389, 722, 611, 889, 722, 722,
2249      556, 722, 667, 556, 611, 722, 722, 944,
2250      722, 722, 611, 333, 278, 333, 469, 500,
2251      333, 444, 500, 444, 500, 444, 333, 500,
2252      500, 278, 278, 500, 278, 778, 500, 500,
2253      500, 500, 333, 389, 278, 500, 500, 722,
2254      500, 500, 444, 480, 200, 480, 541,   0,
2255        0,   0,   0,   0,   0,   0,   0,   0,
2256        0,   0,   0,   0,   0,   0,   0,   0,
2257        0,   0,   0,   0,   0,   0,   0,   0,
2258        0,   0,   0,   0,   0,   0,   0,   0,
2259        0, 333, 500, 500, 167, 500, 500, 500,
2260      500, 180, 444, 500, 333, 333, 556, 556,
2261        0, 500, 500, 500, 250,   0, 453, 350,
2262      333, 444, 444, 500,1000,1000,   0, 444,
2263        0, 333, 333, 333, 333, 333, 333, 333,
2264      333,   0, 333, 333,   0, 333, 333, 333,
2265     1000,   0,   0,   0,   0,   0,   0,   0,
2266        0,   0,   0,   0,   0,   0,   0,   0,
2267        0, 889,   0, 276,   0,   0,   0,   0,
2268      611, 722, 889, 310,   0,   0,   0,   0,
2269        0, 667,   0,   0,   0, 278,   0,   0,
2270      278, 500, 722, 500,   0,   0,   0,   0
2271   );
2272   @timesi = (
2273      250,   0,   0,   0,   0,   0,   0,   0,
2274        0,   0,   0,   0,   0,   0,   0,   0,
2275        0,   0,   0,   0,   0,   0,   0,   0,
2276        0,   0,   0,   0,   0,   0,   0,   0,
2277      250, 333, 420, 500, 500, 833, 778, 333,
2278      333, 333, 500, 675, 250, 333, 250, 278,
2279      500, 500, 500, 500, 500, 500, 500, 500,
2280      500, 500, 333, 333, 675, 675, 675, 500,
2281      920, 611, 611, 667, 722, 611, 611, 722,
2282      722, 333, 444, 667, 556, 833, 667, 722,
2283      611, 722, 611, 500, 556, 722, 611, 833,
2284      611, 556, 556, 389, 278, 389, 422, 500,
2285      333, 500, 500, 444, 500, 444, 278, 500,
2286      500, 278, 278, 444, 278, 722, 500, 500,
2287      500, 500, 389, 389, 278, 500, 444, 667,
2288      444, 444, 389, 400, 275, 400, 541,   0,
2289        0,   0,   0,   0,   0,   0,   0,   0,
2290        0,   0,   0,   0,   0,   0,   0,   0,
2291        0,   0,   0,   0,   0,   0,   0,   0,
2292        0,   0,   0,   0,   0,   0,   0,   0,
2293        0, 389, 500, 500, 167, 500, 500, 500,
2294      500, 214, 556, 500, 333, 333, 500, 500,
2295        0, 500, 500, 500, 250,   0, 523, 350,
2296      333, 556, 556, 500, 889,1000,   0, 500,
2297        0, 333, 333, 333, 333, 333, 333, 333,
2298      333,   0, 333, 333,   0, 333, 333, 333,
2299      889,   0,   0,   0,   0,   0,   0,   0,
2300        0,   0,   0,   0,   0,   0,   0,   0,
2301        0, 889,   0, 276,   0,   0,   0,   0,
2302      556, 722, 944, 310,   0,   0,   0,   0,
2303        0, 667,   0,   0,   0, 278,   0,   0,
2304      278, 500, 667, 500,   0,   0,   0,   0
2305   );
2306   @courr = (
2307      600,   0,   0,   0,   0,   0,   0,   0,
2308        0,   0,   0,   0,   0,   0,   0,   0,
2309        0,   0,   0,   0,   0,   0,   0,   0,
2310        0,   0,   0,   0,   0,   0,   0,   0,
2311      600, 600, 600, 600, 600, 600, 600, 600,
2312      600, 600, 600, 600, 600, 600, 600, 600,
2313      600, 600, 600, 600, 600, 600, 600, 600,
2314      600, 600, 600, 600, 600, 600, 600, 600,
2315      600, 600, 600, 600, 600, 600, 600, 600,
2316      600, 600, 600, 600, 600, 600, 600, 600,
2317      600, 600, 600, 600, 600, 600, 600, 600,
2318      600, 600, 600, 600, 600, 600, 600, 600,
2319      600, 600, 600, 600, 600, 600, 600, 600,
2320      600, 600, 600, 600, 600, 600, 600, 600,
2321      600, 600, 600, 600, 600, 600, 600, 600,
2322      600, 600, 600, 600, 600, 600, 600,   0,
2323        0,   0,   0,   0,   0,   0,   0,   0,
2324        0,   0,   0,   0,   0,   0,   0,   0,
2325        0,   0,   0,   0,   0,   0,   0,   0,
2326        0,   0,   0,   0,   0,   0,   0,   0,
2327        0, 600, 600, 600, 600, 600, 600, 600,
2328      600, 600, 600, 600, 600, 600, 600, 600,
2329        0, 600, 600, 600, 600,   0, 600, 600,
2330      600, 600, 600, 600, 600, 600,   0, 600,
2331        0, 600, 600, 600, 600, 600, 600, 600,
2332      600,   0, 600, 600,   0, 600, 600, 600,
2333      600,   0,   0,   0,   0,   0,   0,   0,
2334        0,   0,   0,   0,   0,   0,   0,   0,
2335        0, 600,   0, 600,   0,   0,   0,   0,
2336      600, 600, 600, 600,   0,   0,   0,   0,
2337        0, 600,   0,   0,   0, 600,   0,   0,
2338      600, 600, 600, 600,   0,   0,   0,   0
2339   );
2340 }
2341
2342 #
2343 # This produces documentation intermediate paragraph format; this is
2344 # basically the digested output of the front end.  Intended for use
2345 # by future backends, instead of putting it all in the same script.
2346 #
2347 sub write_dip {
2348   open(PARAS, "> nasmdoc.dip");
2349   foreach $k (keys(%metadata)) {
2350       print PARAS 'meta :', $k, "\n";
2351       print PARAS $metadata{$k},"\n";
2352   }
2353   for ($para = 0; $para <= $#pnames; $para++) {
2354       print PARAS $pflags[$para], "\n";
2355       print PARAS join("\037", @{$pnames[$para]}, "\n");
2356   }
2357   foreach $k (@itags) {
2358       print PARAS 'indx :', $k, "\n";
2359       print PARAS join("\037", @{$idxmap{$k}}), "\n";
2360   }
2361   close(PARAS);
2362 }
2363