sl@0: set inPRE 1
sl@0: }
sl@0: DE {
sl@0: global file noFillCount inPRE
sl@0: puts $file sl@0: set noFillCount 10000000 sl@0: set inPRE 1 sl@0: } sl@0: fi { sl@0: global noFillCount sl@0: set noFillCount 0 sl@0: } sl@0: IP { sl@0: IPmacro $args sl@0: } sl@0: LP { sl@0: nest decr sl@0: nest incr sl@0: newPara sl@0: } sl@0: ne { sl@0: } sl@0: nf { sl@0: global noFillCount sl@0: set noFillCount 1000000 sl@0: } sl@0: OP { sl@0: global inDT file inPRE sl@0: if {[llength $args] != 3} { sl@0: puts stderr "Bad .OP macro: .$name [join $args " "]" sl@0: } sl@0: nest para DL DT sl@0: set inPRE 1 sl@0: puts -nonewline $filesl@0: setTabs 4c sl@0: text "Command-Line Name:" sl@0: tab sl@0: font B sl@0: set x [lindex $args 0] sl@0: regsub -all {\\-} $x - x sl@0: text $x sl@0: newline sl@0: font R sl@0: text "Database Name:" sl@0: tab sl@0: font B sl@0: text [lindex $args 1] sl@0: newline sl@0: font R sl@0: text "Database Class:" sl@0: tab sl@0: font B sl@0: text [lindex $args 2] sl@0: font R sl@0: puts -nonewline $filesl@0: set inDT "\n- " ;# next newline writes inDT sl@0: set inPRE 0 sl@0: newline sl@0: } sl@0: PP { sl@0: nest decr sl@0: nest incr sl@0: newPara sl@0: } sl@0: RE { sl@0: nest decr sl@0: } sl@0: RS { sl@0: nest incr sl@0: } sl@0: SE { sl@0: global noFillCount textState inPRE file sl@0: sl@0: font R sl@0: puts -nonewline $file sl@0: set inPRE 0 sl@0: set noFillCount 0 sl@0: nest reset sl@0: newPara sl@0: text "See the " sl@0: font B sl@0: set temp $textState sl@0: set textState REF sl@0: text options sl@0: set textState $temp sl@0: font R sl@0: text " manual entry for detailed descriptions of the above options." sl@0: } sl@0: SH { sl@0: SHmacro $args sl@0: } sl@0: SO { sl@0: global noFillCount inPRE file sl@0: sl@0: SHmacro "STANDARD OPTIONS" sl@0: setTabs {4c 8c 12c} sl@0: set noFillCount 1000000 sl@0: puts -nonewline $file
sl@0: set inPRE 1 sl@0: font B sl@0: } sl@0: so { sl@0: if {$args != "man.macros"} { sl@0: puts stderr "Unknown macro: .$name [join $args " "]" sl@0: } sl@0: } sl@0: sp { ;# needs work sl@0: if {$args == ""} { sl@0: set count 1 sl@0: } else { sl@0: set count [lindex $args 0] sl@0: } sl@0: while {$count > 0} { sl@0: lineBreak sl@0: incr count -1 sl@0: } sl@0: } sl@0: ta { sl@0: setTabs $args sl@0: } sl@0: TH { sl@0: THmacro $args sl@0: } sl@0: TP { sl@0: TPmacro $args sl@0: } sl@0: UL { ;# underline sl@0: global file sl@0: puts -nonewline $file "" sl@0: text [lindex $args 0] sl@0: puts -nonewline $file "" sl@0: if {[llength $args] == 2} { sl@0: text [lindex $args 1] sl@0: } sl@0: } sl@0: VE { sl@0: # global file sl@0: # puts -nonewline $file "" sl@0: } sl@0: VS { sl@0: # global file sl@0: # if {[llength $args] > 0} { sl@0: # puts -nonewline $file "
" sl@0: # } sl@0: # puts -nonewline $file "" sl@0: } sl@0: default { sl@0: puts stderr "Unknown macro: .$name [join $args " "]" sl@0: } sl@0: } sl@0: sl@0: # global nestStk; puts "$name [format "%-20s" $args] $nestStk" sl@0: # flush stdout; flush stderr sl@0: } sl@0: sl@0: sl@0: # font -- sl@0: # sl@0: # This procedure is invoked to handle font changes in the text sl@0: # being output. sl@0: # sl@0: # Arguments: sl@0: # type - Type of font: R, I, B, or S. sl@0: sl@0: proc font type { sl@0: global textState sl@0: switch $type { sl@0: P - sl@0: R { sl@0: endFont sl@0: if {$textState == "REF"} { sl@0: set textState INSERT sl@0: } sl@0: } sl@0: B { sl@0: beginFont Code sl@0: if {$textState == "INSERT"} { sl@0: set textState REF sl@0: } sl@0: } sl@0: I { sl@0: beginFont Emphasis sl@0: } sl@0: S { sl@0: } sl@0: default { sl@0: puts stderr "Unknown font: $type" sl@0: } sl@0: } sl@0: } sl@0: sl@0: sl@0: sl@0: # formattedText -- sl@0: # sl@0: # Insert a text string that may also have \fB-style font changes sl@0: # and a few other backslash sequences in it. sl@0: # sl@0: # Arguments: sl@0: # text - Text to insert. sl@0: sl@0: proc formattedText text { sl@0: # puts "formattedText: $text" sl@0: while {$text != ""} { sl@0: set index [string first \\ $text] sl@0: if {$index < 0} { sl@0: text $text sl@0: return sl@0: } sl@0: text [string range $text 0 [expr $index-1]] sl@0: set c [string index $text [expr $index+1]] sl@0: switch -- $c { sl@0: f { sl@0: font [string index $text [expr $index+2]] sl@0: set text [string range $text [expr $index+3] end] sl@0: } sl@0: e { sl@0: text \\ sl@0: set text [string range $text [expr $index+2] end] sl@0: } sl@0: - { sl@0: dash sl@0: set text [string range $text [expr $index+2] end] sl@0: } sl@0: | { sl@0: set text [string range $text [expr $index+2] end] sl@0: } sl@0: default { sl@0: puts stderr "Unknown sequence: \\$c" sl@0: set text [string range $text [expr $index+2] end] sl@0: } sl@0: } sl@0: } sl@0: } sl@0: sl@0: sl@0: sl@0: # dash -- sl@0: # sl@0: # This procedure is invoked to handle dash characters ("\-" in sl@0: # troff). It outputs a special dash character. sl@0: # sl@0: # Arguments: sl@0: # None. sl@0: sl@0: proc dash {} { sl@0: global textState charCnt sl@0: if {$textState == "NAME"} { sl@0: set textState 0 sl@0: } sl@0: incr charCnt sl@0: text "-" sl@0: } sl@0: sl@0: sl@0: # tab -- sl@0: # sl@0: # This procedure is invoked to handle tabs in the troff input. sl@0: # Right now it does nothing. sl@0: # sl@0: # Arguments: sl@0: # None. sl@0: sl@0: proc tab {} { sl@0: global inPRE charCnt tabString sl@0: # ? charCnt sl@0: if {$inPRE == 1} { sl@0: set pos [expr $charCnt % [string length $tabString] ] sl@0: set spaces [string first "1" [string range $tabString $pos end] ] sl@0: text [format "%*s" [incr spaces] " "] sl@0: } else { sl@0: # puts "tab: found tab outside ofblock" sl@0: } sl@0: } sl@0: sl@0: sl@0: # setTabs -- sl@0: # sl@0: # This procedure handles the ".ta" macro, which sets tab stops. sl@0: # sl@0: # Arguments: sl@0: # tabList - List of tab stops, each consisting of a number sl@0: # followed by "i" (inch) or "c" (cm). sl@0: sl@0: proc setTabs {tabList} { sl@0: global file breakPending tabString sl@0: sl@0: # puts "setTabs: --$tabList--" sl@0: set last 0 sl@0: set tabString {} sl@0: set charsPerInch 14. sl@0: set numTabs [llength $tabList] sl@0: foreach arg $tabList { sl@0: if {[scan $arg "%f%s" distance units] != 2} { sl@0: puts stderr "bad distance \"$arg\"" sl@0: return 0 sl@0: } sl@0: switch -- $units { sl@0: c { sl@0: set distance [expr $distance * $charsPerInch / 2.54 ] sl@0: } sl@0: i { sl@0: set distance [expr $distance * $charsPerInch] sl@0: } sl@0: default { sl@0: puts stderr "bad units in distance \"$arg\"" sl@0: continue sl@0: } sl@0: } sl@0: # ? distance sl@0: lappend tabString [format "%*s1" [expr round($distance-$last-1)] " "] sl@0: set last $distance sl@0: } sl@0: set tabString [join $tabString {}] sl@0: # puts "setTabs: --$tabString--" sl@0: } sl@0: sl@0: sl@0: sl@0: # lineBreak -- sl@0: # sl@0: # Generates a line break in the HTML output. sl@0: # sl@0: # Arguments: sl@0: # None. sl@0: sl@0: proc lineBreak {} { sl@0: global file inPRE sl@0: puts $file "
" sl@0: } sl@0: sl@0: sl@0: sl@0: # newline -- sl@0: # sl@0: # This procedure is invoked to handle newlines in the troff input. sl@0: # It outputs either a space character or a newline character, depending sl@0: # on fill mode. sl@0: # sl@0: # Arguments: sl@0: # None. sl@0: sl@0: proc newline {} { sl@0: global noFillCount file inDT inPRE charCnt sl@0: sl@0: if {$inDT != {} } { sl@0: puts $file "\n$inDT" sl@0: set inDT {} sl@0: } elseif {$noFillCount == 0 || $inPRE == 1} { sl@0: puts $file {} sl@0: } else { sl@0: lineBreak sl@0: incr noFillCount -1 sl@0: } sl@0: set charCnt 0 sl@0: } sl@0: sl@0: sl@0: sl@0: # char -- sl@0: # sl@0: # This procedure is called to handle a special character. sl@0: # sl@0: # Arguments: sl@0: # name - Special character named in troff \x or \(xx construct. sl@0: sl@0: proc char name { sl@0: global file charCnt sl@0: sl@0: incr charCnt sl@0: # puts "char: $name" sl@0: switch -exact $name { sl@0: \\0 { ;# \0 sl@0: puts -nonewline $file " " sl@0: } sl@0: \\\\ { ;# \ sl@0: puts -nonewline $file "\\" sl@0: } sl@0: \\(+- { ;# +/- sl@0: puts -nonewline $file "±" sl@0: } sl@0: \\% {} ;# \% sl@0: \\| { ;# \| sl@0: } sl@0: default { sl@0: puts stderr "Unknown character: $name" sl@0: } sl@0: } sl@0: } sl@0: sl@0: sl@0: # macro2 -- sl@0: # sl@0: # This procedure handles macros that are invoked with a leading "'" sl@0: # character instead of space. Right now it just generates an sl@0: # error diagnostic. sl@0: # sl@0: # Arguments: sl@0: # name - The name of the macro (without the "."). sl@0: # args - Any additional arguments to the macro. sl@0: sl@0: proc macro2 {name args} { sl@0: puts stderr "Unknown macro: '$name [join $args " "]" sl@0: } sl@0: sl@0: sl@0: sl@0: # SHmacro -- sl@0: # sl@0: # Subsection head; handles the .SH macro. sl@0: # sl@0: # Arguments: sl@0: # name - Section name. sl@0: sl@0: proc SHmacro argList { sl@0: global file noFillCount textState charCnt sl@0: sl@0: set args [join $argList " "] sl@0: if {[llength $argList] < 1} { sl@0: puts stderr "Bad .SH macro: .$name $args" sl@0: } sl@0: sl@0: set noFillCount 0 sl@0: nest reset sl@0: sl@0: puts -nonewline $file "" sl@0: text $args sl@0: puts $file "
" sl@0: sl@0: # ? args textState sl@0: sl@0: # control what the text proc does with text sl@0: sl@0: switch $args { sl@0: NAME {set textState NAME} sl@0: DESCRIPTION {set textState INSERT} sl@0: INTRODUCTION {set textState INSERT} sl@0: "WIDGET-SPECIFIC OPTIONS" {set textState INSERT} sl@0: "SEE ALSO" {set textState SEE} sl@0: KEYWORDS {set textState 0} sl@0: } sl@0: set charCnt 0 sl@0: } sl@0: sl@0: sl@0: sl@0: # IPmacro -- sl@0: # sl@0: # This procedure is invoked to handle ".IP" macros, which may take any sl@0: # of the following forms: sl@0: # sl@0: # .IP [1] Translate to a "1Step" paragraph. sl@0: # .IP [x] (x > 1) Translate to a "Step" paragraph. sl@0: # .IP Translate to a "Bullet" paragraph. sl@0: # .IP text count Translate to a FirstBody paragraph with special sl@0: # indent and tab stop based on "count", and tab after sl@0: # "text". sl@0: # sl@0: # Arguments: sl@0: # argList - List of arguments to the .IP macro. sl@0: # sl@0: # HTML limitations: 'count' in '.IP text count' is ignored. sl@0: sl@0: proc IPmacro argList { sl@0: global file sl@0: sl@0: setTabs 0.5i sl@0: set length [llength $argList] sl@0: if {$length == 0} { sl@0: nest para UL LI sl@0: return sl@0: } sl@0: if {$length == 1} { sl@0: nest para OL LI sl@0: return sl@0: } sl@0: if {$length > 1} { sl@0: nest para DL DT sl@0: formattedText [lindex $argList 0] sl@0: puts $file "\n- " sl@0: return sl@0: } sl@0: puts stderr "Bad .IP macro: .IP [join $argList " "]" sl@0: } sl@0: sl@0: sl@0: # TPmacro -- sl@0: # sl@0: # This procedure is invoked to handle ".TP" macros, which may take any sl@0: # of the following forms: sl@0: # sl@0: # .TP x Translate to an indented paragraph with the sl@0: # specified indent (in 100 twip units). sl@0: # .TP Translate to an indented paragraph with sl@0: # default indent. sl@0: # sl@0: # Arguments: sl@0: # argList - List of arguments to the .IP macro. sl@0: # sl@0: # HTML limitations: 'x' in '.TP x' is ignored. sl@0: sl@0: sl@0: proc TPmacro {argList} { sl@0: global inDT sl@0: nest para DL DT sl@0: set inDT "\n
- " ;# next newline writes inDT sl@0: setTabs 0.5i sl@0: } sl@0: sl@0: sl@0: sl@0: # THmacro -- sl@0: # sl@0: # This procedure handles the .TH macro. It generates the non-scrolling sl@0: # header section for a given man page, and enters information into the sl@0: # table of contents. The .TH macro has the following form: sl@0: # sl@0: # .TH name section date footer header sl@0: # sl@0: # Arguments: sl@0: # argList - List of arguments to the .TH macro. sl@0: sl@0: proc THmacro {argList} { sl@0: global file sl@0: sl@0: if {[llength $argList] != 5} { sl@0: set args [join $argList " "] sl@0: puts stderr "Bad .TH macro: .$name $args" sl@0: } sl@0: set name [lindex $argList 0] ;# Tcl_UpVar sl@0: set page [lindex $argList 1] ;# 3 sl@0: set vers [lindex $argList 2] ;# 7.4 sl@0: set lib [lindex $argList 3] ;# Tcl sl@0: set pname [lindex $argList 4] ;# {Tcl Library Procedures} sl@0: sl@0: puts -nonewline $file "
" sl@0: text "$lib - $name ($page)" sl@0: puts $file " \n" sl@0: sl@0: puts -nonewline $file "\n" sl@0: } sl@0: sl@0: sl@0: sl@0: # newPara -- sl@0: # sl@0: # This procedure sets the left and hanging indents for a line. sl@0: # Indents are specified in units of inches or centimeters, and are sl@0: # relative to the current nesting level and left margin. sl@0: # sl@0: # Arguments: sl@0: # None sl@0: sl@0: proc newPara {} { sl@0: global file nestStk sl@0: sl@0: if {[lindex $nestStk end] != "NEW" } { sl@0: nest decr sl@0: } sl@0: puts -nonewline $file "
" sl@0: text $pname sl@0: puts $file " " sl@0: } sl@0: sl@0: sl@0: sl@0: # nest -- sl@0: # sl@0: # This procedure takes care of inserting the tags associated with the sl@0: # IP, TP, RS, RE, LP and PP macros. Only 'nest para' takes arguments. sl@0: # sl@0: # Arguments: sl@0: # op - operation: para, incr, decr, reset, init sl@0: # listStart - begin list tag: OL, UL, DL. sl@0: # listItem - item tag: LI, LI, DT. sl@0: sl@0: proc nest {op {listStart "NEW"} {listItem {} } } { sl@0: global file nestStk inDT charCnt sl@0: # puts "nest: $op $listStart $listItem" sl@0: switch $op { sl@0: para { sl@0: set top [lindex $nestStk end] sl@0: if {$top == "NEW" } { sl@0: set nestStk [lreplace $nestStk end end $listStart] sl@0: puts $file "<$listStart>" sl@0: } elseif {$top != $listStart} { sl@0: puts stderr "nest para: bad stack" sl@0: exit 1 sl@0: } sl@0: puts $file "\n<$listItem>" sl@0: set charCnt 0 sl@0: } sl@0: incr { sl@0: lappend nestStk NEW sl@0: } sl@0: decr { sl@0: if {[llength $nestStk] == 0} { sl@0: puts stderr "nest error: nest length is zero" sl@0: set nestStk NEW sl@0: } sl@0: set tag [lindex $nestStk end] sl@0: if {$tag != "NEW"} { sl@0: puts $file "" sl@0: } sl@0: set nestStk [lreplace $nestStk end end] sl@0: } sl@0: reset { sl@0: while {[llength $nestStk] > 0} { sl@0: nest decr sl@0: } sl@0: set nestStk NEW sl@0: } sl@0: init { sl@0: set nestStk NEW sl@0: set inDT {} sl@0: } sl@0: } sl@0: set charCnt 0 sl@0: } sl@0: sl@0: sl@0: sl@0: # do -- sl@0: # sl@0: # This is the toplevel procedure that translates a man page sl@0: # to Frame. It runs the man2tcl program to turn the man page sl@0: # into a script, then it evals that script. sl@0: # sl@0: # Arguments: sl@0: # fileName - Name of the file to translate. sl@0: sl@0: proc do fileName { sl@0: global file self html_dir package footer sl@0: set self "[file tail $fileName].html" sl@0: set file [open "$html_dir/$package/$self" w] sl@0: puts " Pass 2 -- $fileName" sl@0: flush stdout sl@0: initGlobals sl@0: if [catch {eval [exec man2tcl [glob $fileName]]} msg] { sl@0: global errorInfo sl@0: puts stderr $msg sl@0: puts "in" sl@0: puts stderr $errorInfo sl@0: exit 1 sl@0: } sl@0: nest reset sl@0: puts $file $footer sl@0: puts $file "" sl@0: close $file sl@0: } sl@0: sl@0: sl@0: