diff options
Diffstat (limited to 'tools/man2html2.tcl')
| -rw-r--r-- | tools/man2html2.tcl | 871 |
1 files changed, 871 insertions, 0 deletions
diff --git a/tools/man2html2.tcl b/tools/man2html2.tcl new file mode 100644 index 0000000..789b4db --- /dev/null +++ b/tools/man2html2.tcl @@ -0,0 +1,871 @@ +# man2html2.tcl -- +# +# This file defines procedures that are used during the second pass of the +# man page to html conversion process. It is sourced by man2html.tcl. +# +# Copyright (c) 1996 by Sun Microsystems, Inc. +# +# SCCS: @(#) man2html2.tcl 1.2 96/03/21 10:48:30 +# + +# Global variables used by these scripts: +# +# NAME_file - array indexed by NAME and containing file names used +# for hyperlinks. +# +# textState - state variable defining action of 'text' proc. +# +# nestStk - stack oriented list containing currently active +# HTML tags (UL, OL, DL). Local to 'nest' proc. +# +# inDT - set by 'TPmacro', cleared by 'newline'. Used to insert +# the <DT> tag while in a dictionary list <DL>. +# +# curFont - Name of special font that is currently in +# use. Null means the default paragraph font +# is being used. +# +# file - Where to output the generated HTML. +# +# fontStart - Array to map font names to starting sequences. +# +# fontEnd - Array to map font names to ending sequences. +# +# noFillCount - Non-zero means don't fill the next $noFillCount +# lines: force a line break at each newline. Zero +# means filling is enabled, so don't output line +# breaks for each newline. +# +# footer - info inserted at bottom of each page. Normally read +# from the xref.tcl file + +# initGlobals -- +# +# This procedure is invoked to set the initial values of all of the +# global variables, before processing a man page. +# +# Arguments: +# None. + +proc initGlobals {} { + global file noFillCount textState + global fontStart fontEnd curFont inPRE charCnt + + nest init + set inPRE 0 + set textState 0 + set curFont "" + set fontStart(Code) "<B>" + set fontStart(Emphasis) "<I>" + set fontEnd(Code) "</B>" + set fontEnd(Emphasis) "</I>" + set noFillCount 0 + set charCnt 0 + setTabs 0.5i +} + + +# beginFont -- +# +# Arranges for future text to use a special font, rather than +# the default paragraph font. +# +# Arguments: +# font - Name of new font to use. + +proc beginFont font { + global curFont file fontStart + + if {$curFont == $font} { + return + } + endFont + puts -nonewline $file $fontStart($font) + set curFont $font +} + + +# endFont -- +# +# Reverts to the default font for the paragraph type. +# +# Arguments: +# None. + +proc endFont {} { + global curFont file fontEnd + + if {$curFont != ""} { + puts -nonewline $file $fontEnd($curFont) + set curFont "" + } +} + + + +# text -- +# +# This procedure adds text to the current paragraph. If this is +# the first text in the paragraph then header information for the +# paragraph is output before the text. +# +# Arguments: +# string - Text to output in the paragraph. + +proc text string { + global file textState inDT charCnt + + set pos [string first "\t" $string] + if {$pos >= 0} { + text [string range $string 0 [expr $pos-1]] + tab + text [string range $string [expr $pos+1] end] + return + } + incr charCnt [string length $string] + regsub -all {&} $string {\&} string + regsub -all {<} $string {\<} string + regsub -all {>} $string {\>} string + regsub -all {"} $string {\"} string + switch $textState { + REF { + if {$inDT == {}} { + set string [insertRef $string] + } + } + SEE { + global NAME_file + foreach i [split $string] { + if ![regexp -nocase {^[a-z_]+} [string trim $i] i ] { +# puts "Warning: $i in SEE ALSO not found" + continue + } + if ![catch {set ref $NAME_file($i)} ] { + regsub $i $string "<A HREF=\"$ref.html\">$i</A>" string + } + } + } + } + puts -nonewline $file "$string" +} + + + +# insertRef -- +# +# +# Arguments: +# string - Text to output in the paragraph. + +proc insertRef string { + global NAME_file self + set path {} + if ![catch {set ref $NAME_file([string trim $string])} ] { + if {"$ref.html" != $self} { + set string "<A HREF=\"${path}$ref.html\">$string</A>" +# puts "insertRef: $self $ref.html ---$string--" + } + } + return $string +} + + + +# macro -- +# +# This procedure is invoked to process macro invocations that start +# with "." (instead of '). +# +# Arguments: +# name - The name of the macro (without the "."). +# args - Any additional arguments to the macro. + +proc macro {name args} { + switch $name { + AP { + if {[llength $args] != 3} { + puts stderr "Bad .AP macro: .$name [join $args " "]" + } + setTabs {1.25i 2.5i 3.75i} + TPmacro {} + font B + text "[lindex $args 0] " + font I + text "[lindex $args 1]" + font R + text " ([lindex $args 2])" + newline + } + AS {} ;# next page and previous page + br { + lineBreak + } + BS {} + BE {} + CE { + global file noFillCount inPRE + puts $file </PRE></BLOCKQUOTE> + set inPRE 0 + } + CS { ;# code section + global file noFillCount inPRE + puts -nonewline $file <BLOCKQUOTE><PRE> + set inPRE 1 + } + DE { + global file noFillCount inPRE + puts $file </PRE></BLOCKQUOTE> + set inPRE 0 + set noFillCount 0 + } + DS { + global file noFillCount inPRE + puts -nonewline $file <BLOCKQUOTE><PRE> + 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 <PRE> + 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 </PRE> + set inDT "\n<DD>" ;# 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 </PRE> + 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 <PRE> + 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 "<B><U>" + text [lindex $args 0] + puts -nonewline $file "</U></B>" + if {[llength $args] == 2} { + text [lindex $args 1] + } + } + VE { +# global file +# puts -nonewline $file "</FONT>" + } + VS { +# global file +# if {[llength $args] > 0} { +# puts -nonewline $file "<BR>" +# } +# puts -nonewline $file "<FONT COLOR=\"GREEN\">" + } + 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 of <PRE> block" + } +} + + +# 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 "<BR>" +} + + + +# 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 "<H3>" + text $args + puts $file "</H3>" + +# ? 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<DD>" + 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<DD>" ;# 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 "<HTML><HEAD><TITLE>" + text "$lib - $name ($page)" + puts $file "</TITLE></HEAD><BODY>\n" + + puts -nonewline $file "<H1><CENTER>" + text $pname + puts $file "</CENTER></H1>\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 "<P>" +} + + + +# 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 "</$tag>" + } + 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 "</BODY></HTML>" + close $file +} + + + |