1##############################################################################
2# man2html2.tcl --
3#
4# This file defines procedures that are used during the second pass of the man
5# page to html conversion process. It is sourced by man2html.tcl.
6#
7# Copyright (c) 1996 by Sun Microsystems, Inc.
8#
9# $Id: man2html2.tcl,v 1.13 2007/12/13 15:28:40 dgp Exp $
10#
11
12package require Tcl 8.4
13
14# Global variables used by these scripts:
15#
16# NAME_file -	array indexed by NAME and containing file names used for
17#		hyperlinks.
18#
19# textState -	state variable defining action of 'text' proc.
20#
21# nestStk -	stack oriented list containing currently active HTML tags (UL,
22#		OL, DL). Local to 'nest' proc.
23#
24# inDT -	set by 'TPmacro', cleared by 'newline'. Used to insert the
25#		tag while in a dictionary list <DL>.
26#
27# curFont -	Name of special font that is currently in use. Null means the
28#		default paragraph font is being used.
29#
30# file -	Where to output the generated HTML.
31#
32# fontStart -	Array to map font names to starting sequences.
33#
34# fontEnd -	Array to map font names to ending sequences.
35#
36# noFillCount -	Non-zero means don't fill the next $noFillCount lines: force a
37#		line break at each newline. Zero means filling is enabled, so
38#		don't output line breaks for each newline.
39#
40# footer -	info inserted at bottom of each page. Normally read from the
41#		xref.tcl file
42
43##############################################################################
44# initGlobals --
45#
46# This procedure is invoked to set the initial values of all of the global
47# variables, before processing a man page.
48#
49# Arguments:
50# None.
51
52proc initGlobals {} {
53    global file noFillCount textState
54    global fontStart fontEnd curFont inPRE charCnt inTable
55
56    nest init
57    set inPRE 0
58    set inTable 0
59    set textState 0
60    set curFont ""
61    set fontStart(Code) "<B>"
62    set fontStart(Emphasis) "<I>"
63    set fontEnd(Code) "</B>"
64    set fontEnd(Emphasis) "</I>"
65    set noFillCount 0
66    set charCnt 0
67    setTabs 0.5i
68}
69
70##############################################################################
71# beginFont --
72#
73# Arranges for future text to use a special font, rather than the default
74# paragraph font.
75#
76# Arguments:
77# font -		Name of new font to use.
78
79proc beginFont font {
80    global curFont file fontStart
81
82    if {$curFont eq $font} {
83	return
84    }
85    endFont
86    puts -nonewline $file $fontStart($font)
87    set curFont $font
88}
89
90##############################################################################
91# endFont --
92#
93# Reverts to the default font for the paragraph type.
94#
95# Arguments:
96# None.
97
98proc endFont {} {
99    global curFont file fontEnd
100
101    if {$curFont ne ""} {
102	puts -nonewline $file $fontEnd($curFont)
103	set curFont ""
104    }
105}
106
107##############################################################################
108# text --
109#
110# This procedure adds text to the current paragraph. If this is the first text
111# in the paragraph then header information for the paragraph is output before
112# the text.
113#
114# Arguments:
115# string -		Text to output in the paragraph.
116
117proc text string {
118    global file textState inDT charCnt inTable
119
120    set pos [string first "\t" $string]
121    if {$pos >= 0} {
122    	text [string range $string 0 [expr $pos-1]]
123    	tab
124    	text [string range $string [expr $pos+1] end]
125	return
126    }
127    if {$inTable} {
128	if {$inTable == 1} {
129	    puts -nonewline $file <TR>
130	    set inTable 2
131	}
132	puts -nonewline $file <TD>
133    }
134    incr charCnt [string length $string]
135    regsub -all {&} $string {\&amp;}  string
136    regsub -all {<} $string {\&lt;}  string
137    regsub -all {>} $string {\&gt;}  string
138    regsub -all \"  $string {\&quot;}  string
139    switch -exact -- $textState {
140	REF {
141	    if {$inDT eq ""} {
142		set string [insertRef $string]
143	    }
144	}
145	SEE {
146	    global NAME_file
147	    foreach i [split $string] {
148		if {![regexp -nocase {^[a-z_]+} [string trim $i] i]} {
149# 		    puts "Warning: $i in SEE ALSO not found"
150		    continue
151		}
152		if {![catch { set ref $NAME_file($i) }]} {
153		    regsub $i $string "<A HREF=\"$ref.html\">$i</A>" string
154		}
155	    }
156	}
157    }
158    puts -nonewline $file "$string"
159    if {$inTable} {
160	puts -nonewline $file </TD>
161    }
162}
163
164##############################################################################
165# insertRef --
166#
167# Arguments:
168# string -		Text to output in the paragraph.
169
170proc insertRef string {
171    global NAME_file self
172    set path {}
173    if {![catch { set ref $NAME_file([string trim $string]) }]} {
174	if {"$ref.html" ne $self} {
175	    set string "<A HREF=\"${path}$ref.html\">$string</A>"
176#	    puts "insertRef: $self $ref.html ---$string--"
177	}
178    }
179    return $string
180}
181
182##############################################################################
183# macro --
184#
185# This procedure is invoked to process macro invocations that start with "."
186# (instead of ').
187#
188# Arguments:
189# name -		The name of the macro (without the ".").
190# args -		Any additional arguments to the macro.
191
192proc macro {name args} {
193    switch $name {
194	AP {
195	    if {[llength $args] != 3} {
196		puts stderr "Bad .AP macro: .$name [join $args " "]"
197	    }
198	    setTabs {1.25i 2.5i 3.75i}
199	    TPmacro {}
200	    font B
201	    text "[lindex $args 0]  "
202	    font I
203	    text "[lindex $args 1]"
204	    font R
205	    text " ([lindex $args 2])"
206	    newline
207	}
208	AS {}				;# next page and previous page
209	br {
210	    lineBreak
211	}
212	BS {}
213	BE {}
214	CE {
215	    global file noFillCount inPRE
216	    puts $file </PRE></BLOCKQUOTE>
217	    set inPRE 0
218	}
219	CS {				;# code section
220	    global file noFillCount inPRE
221	    puts -nonewline $file <BLOCKQUOTE><PRE>
222	    set inPRE 1
223	}
224	DE {
225	    global file noFillCount inTable
226	    puts $file </TABLE></BLOCKQUOTE>
227	    set inTable 0
228	    set noFillCount 0
229	}
230	DS {
231	    global file noFillCount inTable
232	    puts -nonewline $file {<BLOCKQUOTE><TABLE BORDER="0">}
233	    set noFillCount 10000000
234	    set inTable 1
235	}
236	fi {
237	    global noFillCount
238	    set noFillCount 0
239	}
240	IP {
241	    IPmacro $args
242	}
243	LP {
244	    nest decr
245	    nest incr
246	    newPara
247	}
248	ne {
249	}
250	nf {
251	    global noFillCount
252	    set noFillCount 1000000
253	}
254	OP {
255	    global inDT file inPRE
256	    if {[llength $args] != 3} {
257		puts stderr "Bad .OP macro: .$name [join $args " "]"
258	    }
259	    nest para DL DT
260	    set inPRE 1
261	    puts -nonewline $file <PRE>
262	    setTabs 4c
263	    text "Command-Line Name:"
264	    tab
265	    font B
266	    set x [lindex $args 0]
267	    regsub -all {\\-} $x - x
268	    text $x
269	    newline
270	    font R
271	    text "Database Name:"
272	    tab
273	    font B
274	    text [lindex $args 1]
275	    newline
276	    font R
277	    text "Database Class:"
278	    tab
279	    font B
280	    text [lindex $args 2]
281	    font R
282	    puts -nonewline $file </PRE>
283	    set inDT "\n<DD>"			;# next newline writes inDT
284	    set inPRE 0
285	    newline
286	}
287	PP {
288	    nest decr
289	    nest incr
290	    newPara
291	}
292	RE {
293	    nest decr
294	}
295	RS {
296	    nest incr
297	}
298	SE {
299	    global noFillCount textState inPRE file
300
301	    font R
302	    puts -nonewline $file </PRE>
303	    set inPRE 0
304	    set noFillCount 0
305	    nest reset
306	    newPara
307	    text "See the "
308	    font B
309	    set temp $textState
310	    set textState REF
311	    if {[llength $args] > 0} {
312		text [lindex $args 0]
313	    } else {
314		text options
315	    }
316	    set textState $temp
317	    font R
318	    text " manual entry for detailed descriptions of the above options."
319	}
320	SH {
321	    SHmacro $args
322	}
323	SS {
324	    SHmacro $args subsection
325	}
326	SO {
327	    global noFillCount inPRE file
328
329	    SHmacro "STANDARD OPTIONS"
330	    setTabs {4c 8c 12c}
331	    set noFillCount 1000000
332	    puts -nonewline $file <PRE>
333	    set inPRE 1
334	    font B
335	}
336	so {
337	    if {$args ne "man.macros"} {
338		puts stderr "Unknown macro: .$name [join $args " "]"
339	    }
340	}
341	sp {					;# needs work
342	    if {$args eq ""} {
343		set count 1
344	    } else {
345		set count [lindex $args 0]
346	    }
347	    while {$count > 0} {
348		lineBreak
349		incr count -1
350	    }
351	}
352	ta {
353	    setTabs $args
354	}
355	TH {
356	    THmacro $args
357	}
358	TP {
359	    TPmacro $args
360	}
361	UL {					;# underline
362	    global file
363	    puts -nonewline $file "<B><U>"
364	    text [lindex $args 0]
365	    puts -nonewline $file "</U></B>"
366	    if {[llength $args] == 2} {
367		text [lindex $args 1]
368	    }
369	}
370	VE {
371#	    global file
372#	    puts -nonewline $file "</FONT>"
373	}
374	VS {
375#	    global file
376#	    if {[llength $args] > 0} {
377#		puts -nonewline $file "<BR>"
378#	    }
379#	    puts -nonewline $file "<FONT COLOR=\"GREEN\">"
380	}
381	QW {
382	    puts -nonewline $file "&\#147;"
383	    text [lindex $args 0]
384	    puts -nonewline $file "&\#148;"
385	    if {[llength $args] > 1} {
386		text [lindex $args 1]
387	    }
388	}
389	PQ {
390	    puts -nonewline $file "(&\#147;"
391	    if {[lindex $args 0] eq {\N'34'}} {
392		puts -nonewline $file \"
393	    } else {
394		text [lindex $args 0]
395	    }
396	    puts -nonewline $file "&\#148;"
397	    if {[llength $args] > 1} {
398		text [lindex $args 1]
399	    }
400	    puts -nonewline $file ")"
401	    if {[llength $args] > 2} {
402		text [lindex $args 2]
403	    }
404	}
405	QR {
406	    puts -nonewline $file "&\#147;"
407	    text [lindex $args 0]
408	    puts -nonewline $file "&\#148;&\#150;&\#147;"
409	    text [lindex $args 1]
410	    puts -nonewline $file "&\#148;"
411	    if {[llength $args] > 2} {
412		text [lindex $args 2]
413	    }
414	}
415	MT {
416	    puts -nonewline $file "&\#147;&\#148;"
417	}
418	default {
419	    puts stderr "Unknown macro: .$name [join $args " "]"
420	}
421    }
422
423#	global nestStk; puts "$name [format "%-20s" $args] $nestStk"
424#	flush stdout; flush stderr
425}
426
427##############################################################################
428# font --
429#
430# This procedure is invoked to handle font changes in the text being output.
431#
432# Arguments:
433# type -		Type of font: R, I, B, or S.
434
435proc font type {
436    global textState
437    switch $type {
438	P -
439	R {
440	    endFont
441	    if {$textState eq "REF"} {
442		set textState INSERT
443	    }
444	}
445	B {
446	    beginFont Code
447	    if {$textState eq "INSERT"} {
448		set textState REF
449	    }
450	}
451	I {
452	    beginFont Emphasis
453	}
454	S {
455	}
456	default {
457	    puts stderr "Unknown font: $type"
458	}
459    }
460}
461
462##############################################################################
463# formattedText --
464#
465# Insert a text string that may also have \fB-style font changes and a few
466# other backslash sequences in it.
467#
468# Arguments:
469# text -		Text to insert.
470
471proc formattedText text {
472#	puts "formattedText: $text"
473    while {$text ne ""} {
474	set index [string first \\ $text]
475	if {$index < 0} {
476	    text $text
477	    return
478	}
479	text [string range $text 0 [expr $index-1]]
480	set c [string index $text [expr $index+1]]
481	switch -- $c {
482	    f {
483		font [string index $text [expr $index+2]]
484		set text [string range $text [expr $index+3] end]
485	    }
486	    e {
487		text \\
488		set text [string range $text [expr $index+2] end]
489	    }
490	    - {
491		dash
492		set text [string range $text [expr $index+2] end]
493	    }
494	    | {
495		set text [string range $text [expr $index+2] end]
496	    }
497	    default {
498		puts stderr "Unknown sequence: \\$c"
499		set text [string range $text [expr $index+2] end]
500	    }
501	}
502    }
503}
504
505##############################################################################
506# dash --
507#
508# This procedure is invoked to handle dash characters ("\-" in troff). It
509# outputs a special dash character.
510#
511# Arguments:
512# None.
513
514proc dash {} {
515    global textState charCnt
516    if {$textState eq "NAME"} {
517    	set textState 0
518    }
519    incr charCnt
520    text "-"
521}
522
523##############################################################################
524# tab --
525#
526# This procedure is invoked to handle tabs in the troff input.
527#
528# Arguments:
529# None.
530
531proc tab {} {
532    global inPRE charCnt tabString file
533#	? charCnt
534    if {$inPRE == 1} {
535	set pos [expr $charCnt % [string length $tabString] ]
536	set spaces [string first "1" [string range $tabString $pos end] ]
537	text [format "%*s" [incr spaces] " "]
538    } else {
539#	puts "tab: found tab outside of <PRE> block"
540    }
541}
542
543##############################################################################
544# setTabs --
545#
546# This procedure handles the ".ta" macro, which sets tab stops.
547#
548# Arguments:
549# tabList -	List of tab stops, each consisting of a number
550#			followed by "i" (inch) or "c" (cm).
551
552proc setTabs {tabList} {
553    global file breakPending tabString
554
555    # puts "setTabs: --$tabList--"
556    set last 0
557    set tabString {}
558    set charsPerInch 14.
559    set numTabs [llength $tabList]
560    foreach arg $tabList {
561	if {[string match +* $arg]} {
562	    set relative 1
563	    set arg [string range $arg 1 end]
564	} else {
565	    set relative 0
566	}
567	# Always operate in relative mode for "measurement" mode
568	if {[regexp {^\\w'(.*)'u$} $arg content]} {
569	    set distance [string length $content]
570	} else {
571	    if {[scan $arg "%f%s" distance units] != 2} {
572		puts stderr "bad distance \"$arg\""
573		return 0
574	    }
575	    switch -- $units {
576		c {
577		    set distance [expr {$distance * $charsPerInch / 2.54}]
578		}
579		i {
580		    set distance [expr {$distance * $charsPerInch}]
581		}
582		default {
583		    puts stderr "bad units in distance \"$arg\""
584		    continue
585		}
586	    }
587	}
588	# ? distance
589	if {$relative} {
590	    append tabString [format "%*s1" [expr {round($distance-1)}] " "]
591	    set last [expr {$last + $distance}]
592	} else {
593	    append tabString [format "%*s1" [expr {round($distance-$last-1)}] " "]
594	    set last $distance
595	}
596    }
597    # puts "setTabs: --$tabString--"
598}
599
600##############################################################################
601# lineBreak --
602#
603# Generates a line break in the HTML output.
604#
605# Arguments:
606# None.
607
608proc lineBreak {} {
609    global file inPRE
610    puts $file "<BR>"
611}
612
613##############################################################################
614# newline --
615#
616# This procedure is invoked to handle newlines in the troff input. It outputs
617# either a space character or a newline character, depending on fill mode.
618#
619# Arguments:
620# None.
621
622proc newline {} {
623    global noFillCount file inDT inPRE charCnt inTable
624
625    if {$inDT ne ""} {
626    	puts $file "\n$inDT"
627    	set inDT {}
628    } elseif {$inTable} {
629	if {$inTable > 1} {
630	    puts $file </tr>
631	    set inTable 1
632	}
633    } elseif {$noFillCount == 0 || $inPRE == 1} {
634	puts $file {}
635    } else {
636	lineBreak
637	incr noFillCount -1
638    }
639    set charCnt 0
640}
641
642##############################################################################
643# char --
644#
645# This procedure is called to handle a special character.
646#
647# Arguments:
648# name -		Special character named in troff \x or \(xx construct.
649
650proc char name {
651    global file charCnt
652
653    incr charCnt
654#	puts "char: $name"
655    switch -exact $name {
656	\\0 {					;#  \0
657	    puts -nonewline $file " "
658	}
659	\\\\ {					;#  \
660	    puts -nonewline $file "\\"
661	}
662	\\(+- { 				;#  +/-
663	    puts -nonewline $file "&#177;"
664	}
665	\\% {}					;#  \%
666	\\| {					;#  \|
667	}
668	default {
669	    puts stderr "Unknown character: $name"
670	}
671    }
672}
673
674##############################################################################
675# macro2 --
676#
677# This procedure handles macros that are invoked with a leading "'" character
678# instead of space. Right now it just generates an error diagnostic.
679#
680# Arguments:
681# name -		The name of the macro (without the ".").
682# args -		Any additional arguments to the macro.
683
684proc macro2 {name args} {
685    puts stderr "Unknown macro: '$name [join $args " "]"
686}
687
688##############################################################################
689# SHmacro --
690#
691# Subsection head; handles the .SH and .SS macros.
692#
693# Arguments:
694# name -		Section name.
695# style -		Type of section (optional)
696
697proc SHmacro {argList {style section}} {
698    global file noFillCount textState charCnt
699
700    set args [join $argList " "]
701    if {[llength $argList] < 1} {
702	puts stderr "Bad .SH macro: .$name $args"
703    }
704
705    set noFillCount 0
706    nest reset
707
708    set tag H3
709    if {$style eq "subsection"} {
710	set tag H4
711    }
712    puts -nonewline $file "<$tag>"
713    text $args
714    puts $file "</$tag>"
715
716#	? args textState
717
718    # control what the text proc does with text
719
720    switch $args {
721	NAME {set textState NAME}
722	DESCRIPTION {set textState INSERT}
723	INTRODUCTION {set textState INSERT}
724	"WIDGET-SPECIFIC OPTIONS" {set textState INSERT}
725	"SEE ALSO" {set textState SEE}
726	KEYWORDS {set textState 0}
727    }
728    set charCnt 0
729}
730
731##############################################################################
732# IPmacro --
733#
734# This procedure is invoked to handle ".IP" macros, which may take any of the
735# following forms:
736#
737# .IP [1]			Translate to a "1Step" paragraph.
738# .IP [x] (x > 1)		Translate to a "Step" paragraph.
739# .IP				Translate to a "Bullet" paragraph.
740# .IP \(bu			Translate to a "Bullet" paragraph.
741# .IP text count		Translate to a FirstBody paragraph with
742#				special indent and tab stop based on "count",
743#				and tab after "text".
744#
745# Arguments:
746# argList -		List of arguments to the .IP macro.
747#
748# HTML limitations: 'count' in '.IP text count' is ignored.
749
750proc IPmacro argList {
751    global file
752
753    setTabs 0.5i
754    set length [llength $argList]
755    if {$length == 0} {
756    	nest para UL LI
757	return
758    }
759    # Special case for alternative mechanism for declaring bullets
760    if {[lindex $argList 0] eq "\\(bu"} {
761	nest para UL LI
762	return
763    }
764    if {[regexp {^\[\d+\]$} [lindex $argList 0]]} {
765    	nest para OL LI
766	return
767    }
768    nest para DL DT
769    formattedText [lindex $argList 0]
770    puts $file "\n<DD>"
771    return
772}
773
774##############################################################################
775# TPmacro --
776#
777# This procedure is invoked to handle ".TP" macros, which may take any of the
778# following forms:
779#
780# .TP x		Translate to an indented paragraph with the specified indent
781# 			(in 100 twip units).
782# .TP		Translate to an indented paragraph with default indent.
783#
784# Arguments:
785# argList -		List of arguments to the .IP macro.
786#
787# HTML limitations: 'x' in '.TP x' is ignored.
788
789proc TPmacro {argList} {
790    global inDT
791    nest para DL DT
792    set inDT "\n<DD>"			;# next newline writes inDT
793    setTabs 0.5i
794}
795
796##############################################################################
797# THmacro --
798#
799# This procedure handles the .TH macro. It generates the non-scrolling header
800# section for a given man page, and enters information into the table of
801# contents. The .TH macro has the following form:
802#
803# .TH name section date footer header
804#
805# Arguments:
806# argList -		List of arguments to the .TH macro.
807
808proc THmacro {argList} {
809    global file
810
811    if {[llength $argList] != 5} {
812	set args [join $argList " "]
813	puts stderr "Bad .TH macro: .$name $args"
814    }
815    set name  [lindex $argList 0]		;# Tcl_UpVar
816    set page  [lindex $argList 1]		;# 3
817    set vers  [lindex $argList 2]		;# 7.4
818    set lib   [lindex $argList 3]		;# Tcl
819    set pname [lindex $argList 4]		;# {Tcl Library Procedures}
820
821    puts -nonewline $file "<HTML><HEAD><TITLE>"
822    text "$lib - $name ($page)"
823    puts $file "</TITLE></HEAD><BODY>\n"
824
825    puts -nonewline $file "<H1><CENTER>"
826    text $pname
827    puts $file "</CENTER></H1>\n"
828}
829
830##############################################################################
831# newPara --
832#
833# This procedure sets the left and hanging indents for a line. Indents are
834# specified in units of inches or centimeters, and are relative to the current
835# nesting level and left margin.
836#
837# Arguments:
838# None
839
840proc newPara {} {
841    global file nestStk
842
843    if {[lindex $nestStk end] ne "NEW"} {
844	nest decr
845    }
846    puts -nonewline $file "<P>"
847}
848
849##############################################################################
850# nest --
851#
852# This procedure takes care of inserting the tags associated with the IP, TP,
853# RS, RE, LP and PP macros. Only 'nest para' takes arguments.
854#
855# Arguments:
856# op -				operation: para, incr, decr, reset, init
857# listStart -		begin list tag: OL, UL, DL.
858# listItem -		item tag:       LI, LI, DT.
859
860proc nest {op {listStart "NEW"} {listItem ""} } {
861    global file nestStk inDT charCnt
862#	puts "nest: $op $listStart $listItem"
863    switch $op {
864	para {
865	    set top [lindex $nestStk end]
866	    if {$top eq "NEW"} {
867		set nestStk [lreplace $nestStk end end $listStart]
868		puts $file "<$listStart>"
869	    } elseif {$top ne $listStart} {
870		puts stderr "nest para: bad stack"
871		exit 1
872	    }
873	    puts $file "\n<$listItem>"
874	    set charCnt 0
875	}
876	incr {
877	   lappend nestStk NEW
878	}
879	decr {
880	    if {[llength $nestStk] == 0} {
881		puts stderr "nest error: nest length is zero"
882		set nestStk NEW
883	    }
884	    set tag [lindex $nestStk end]
885	    if {$tag ne "NEW"} {
886		puts $file "</$tag>"
887	    }
888	    set nestStk [lreplace $nestStk end end]
889	}
890	reset {
891	    while {[llength $nestStk] > 0} {
892		nest decr
893	    }
894	    set nestStk NEW
895	}
896	init {
897	    set nestStk NEW
898	    set inDT {}
899	}
900    }
901    set charCnt 0
902}
903
904##############################################################################
905# do --
906#
907# This is the toplevel procedure that translates a man page to HTML. It runs
908# the man2tcl program to turn the man page into a script, then it evals that
909# script.
910#
911# Arguments:
912# fileName -		Name of the file to translate.
913
914proc do fileName {
915    global file self html_dir package footer
916    set self "[file tail $fileName].html"
917    set file [open "$html_dir/$package/$self" w]
918    puts "  Pass 2 -- $fileName"
919    flush stdout
920    initGlobals
921    if {[catch { eval [exec man2tcl [glob $fileName]] } msg]} {
922	global errorInfo
923	puts stderr $msg
924	puts "in"
925	puts stderr $errorInfo
926	exit 1
927    }
928    nest reset
929    puts $file $footer
930    puts $file "</BODY></HTML>"
931    close $file
932}
933