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