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 | |
---|
12 | package 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 | |
---|
52 | proc 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 | |
---|
79 | proc 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 | |
---|
98 | proc 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 | |
---|
117 | proc 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 {\&} string |
---|
136 | regsub -all {<} $string {\<} string |
---|
137 | regsub -all {>} $string {\>} string |
---|
138 | regsub -all \" $string {\"} 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 | |
---|
170 | proc 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 | |
---|
192 | proc 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 | |
---|
435 | proc 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 | |
---|
471 | proc 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 | |
---|
514 | proc 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 | |
---|
531 | proc 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 | |
---|
552 | proc 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 | |
---|
608 | proc 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 | |
---|
622 | proc 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 | |
---|
650 | proc 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 "±" |
---|
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 | |
---|
684 | proc 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 | |
---|
697 | proc 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 | |
---|
750 | proc 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 | |
---|
789 | proc 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 | |
---|
808 | proc 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 | |
---|
840 | proc 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 | |
---|
860 | proc 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 | |
---|
914 | proc 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 | } |
---|