1# man2html1.tcl --
2#
3# This file defines procedures that are used during the first pass of the
4# man page to html conversion process. It is sourced by h.tcl.
5#
6# Copyright (c) 1996 by Sun Microsystems, Inc.
7#
8# SCCS: @(#) man2html1.tcl 1.2 96/03/21 10:48:29
9#
10
11# Global variables used by these scripts:
12#
13# state -	state variable that controls action of text proc.
14#
15# curFile -	tail of current man page.
16#
17# file -	file pointer; for both xref.tcl and contents.html
18#
19# NAME_file -	array indexed by NAME and containing file names used
20#		for hyperlinks.
21#
22# KEY_file -	array indexed by KEYWORD and containing file names used
23#		for hyperlinks.
24#
25# lib -		contains package name. Used to label section in contents.html
26#
27# inDT -	in dictionary term.
28
29
30
31# text --
32#
33# This procedure adds entries to the hypertext arrays NAME_file
34# and KEY_file.
35#
36# DT: might do this: if first word of $dt matches $name and [llength $name==1]
37# 	and [llength $dt > 1], then add to NAME_file.
38#
39# Arguments:
40# string -		Text to index.
41
42
43proc text string {
44    global state curFile NAME_file KEY_file inDT
45
46    switch $state {
47	NAME {
48	    foreach i [split $string ","] {
49		lappend NAME_file([string trim $i]) $curFile
50	    }
51	}
52	KEY {
53	    foreach i [split $string ","] {
54		lappend KEY_file([string trim $i]) $curFile
55	    }
56	}
57	DT -
58	OFF -
59	DASH {}
60	default {
61	    puts stderr "text: unknown state: $state"
62	}
63    }
64}
65
66
67# macro --
68#
69# This procedure is invoked to process macro invocations that start
70# with "." (instead of ').
71#
72# Arguments:
73# name -	The name of the macro (without the ".").
74# args -	Any additional arguments to the macro.
75
76proc macro {name args} {
77    switch $name {
78	SH {
79	    global state
80
81	    switch $args {
82		NAME {
83		    if {$state == "INIT" } {
84			set state NAME
85		    }
86		}
87		DESCRIPTION {set state DT}
88		INTRODUCTION {set state DT}
89		KEYWORDS {set state KEY}
90		default {set state OFF}
91	    }
92
93	}
94	TP {
95	    global inDT
96	    set inDT 1
97	}
98	TH {
99	    global lib state inDT
100	    set inDT 0
101	    set state INIT
102	    if {[llength $args] != 5} {
103		    set args [join $args " "]
104		    puts stderr "Bad .TH macro: .$name $args"
105	    }
106	    set lib [lindex $args 3]				;# Tcl or Tk
107	}
108    }
109}
110
111
112
113# dash --
114#
115# This procedure is invoked to handle dash characters ("\-" in
116# troff).  It only function in pass1 is to terminate the NAME state.
117#
118# Arguments:
119# None.
120
121proc dash {} {
122    global state
123    if {$state == "NAME"} {
124	set state DASH
125    }
126}
127
128
129
130# newline --
131#
132# This procedure is invoked to handle newlines in the troff input.
133# It's only purpose is to terminate a DT (dictionary term).
134#
135# Arguments:
136# None.
137
138proc newline {} {
139    global inDT
140    set inDT 0
141}
142
143
144
145
146# initGlobals, tab, font, char, macro2 --
147#
148# These procedures do nothing during the first pass.
149#
150# Arguments:
151# None.
152
153proc initGlobals {} {}
154proc tab {} {}
155proc font type {}
156proc char name {}
157proc macro2 {name args} {}
158
159
160# doListing --
161#
162# Writes an ls like list to a file. Searches NAME_file for entries
163# that match the input pattern.
164#
165# Arguments:
166# file -		Output file pointer.
167# pattern -		glob style match pattern
168
169proc doListing {file pattern} {
170    global NAME_file
171
172    set max_len 0
173    foreach name [lsort [array names NAME_file]] {
174	set ref $NAME_file($name)
175	    if [string match $pattern $ref] {
176		lappend type $name
177		if {[string length $name] > $max_len} {
178		set max_len [string length $name]
179	    }
180	}
181    }
182    if [catch {llength $type} ] {
183	puts stderr "       doListing: no names matched pattern ($pattern)"
184	return
185    }
186    incr max_len
187    set ncols [expr 90/$max_len]
188    set nrows [expr int( ceil( [llength $type] / $ncols. ) ) ]
189
190#	? max_len ncols nrows
191
192    set index 0
193    foreach f $type {
194	lappend row([expr $index % $nrows]) $f
195	incr index
196    }
197
198    puts -nonewline $file "<PRE>"
199    for {set i 0} {$i<$nrows} {incr i} {
200	foreach name $row($i) {
201	    set str [format "%-*s" $max_len $name]
202	    regsub $name $str "<A HREF=\"$NAME_file($name).html\">$name</A>" str
203	    puts -nonewline $file $str
204	}
205	puts $file {}
206    }
207    puts $file "</PRE>"
208}
209
210
211# doContents --
212#
213# Generates a HTML contents file using the NAME_file array
214# as its input database.
215#
216# Arguments:
217# file -		name of the contents file.
218# packageName -	string used in the title and sub-heads of the HTML page. Normally
219#				name of the package without version numbers.
220
221proc doContents {file packageName} {
222    global footer
223
224    set file [open $file w]
225
226    puts $file "<HTML><HEAD><TITLE>$packageName Manual</TITLE></HEAD><BODY>"
227    puts $file "<H3>$packageName</H3>"
228    doListing $file "*.1"
229
230    puts $file "<HR><H3>$packageName Commands</H3>"
231    doListing $file "*.n"
232
233    puts $file "<HR><H3>$packageName Library</H3>"
234    doListing $file "*.3"
235
236    puts $file $footer
237    puts $file "</BODY></HTML>"
238    close $file
239}
240
241
242
243
244# do --
245#
246# This is the toplevel procedure that searches a man page
247# for hypertext links.  It builds a data base consisting of
248# two arrays: NAME_file and KEY file. It runs the man2tcl
249# program to turn the man page into a script, then it evals
250# that script.
251#
252# Arguments:
253# fileName -		Name of the file to scan.
254
255proc do fileName {
256    global curFile
257    set curFile [file tail $fileName]
258    set file stdout
259    puts "  Pass 1 -- $fileName"
260    flush stdout
261    if [catch {eval [exec man2tcl [glob $fileName]]} msg] {
262	global errorInfo
263	puts stderr $msg
264	puts "in"
265	puts $errorInfo
266	exit 1
267    }
268}
269
270