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 {\&} string 131 regsub -all {<} $string {\<} string 132 regsub -all {>} $string {\>} string 133 regsub -all \" $string {\"} 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 "±" 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