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