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 {\&} 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 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 "±" 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