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 $filesetTabs 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 $fileset 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 } SS { SSmacro $args subsection } 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 and .SS macros. # # Arguments: # name - Section name. # style - Type of section (optional) proc SHmacro {argList {style section}} { 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 set tag H3 if {[string compare "subsection" $level] == 0} { set tag H4 } puts -nonewline $file "<$tag>" 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 }