# 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. # # $Id: man2html2.tcl,v 1.8 2005/04/06 09:52:00 dkf Exp $ # package require Tcl 8.4 # 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
tag while in a dictionary list
. # # 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) "" set fontStart(Emphasis) "" set fontEnd(Code) "" set fontEnd(Emphasis) "" 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 eq $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 ne ""} { 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 eq ""} { 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 "$i" 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" ne $self} { set string "$string" # 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 set inPRE 0 } CS { ;# code section global file noFillCount inPRE puts -nonewline $file
	    set inPRE 1
	}
	DE {
	    global file noFillCount inPRE
	    puts $file 
set inPRE 0 set noFillCount 0 } DS { global file noFillCount inPRE puts -nonewline $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 } SS { SHmacro $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 ne "man.macros"} {
		puts stderr "Unknown macro: .$name [join $args " "]"
	    }
	}
	sp {					;# needs work
	    if {$args eq ""} {
		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 eq "REF"} { set textState INSERT } } B { beginFont Code if {$textState eq "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 ne ""} { 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 eq "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
 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 {[string match +* $arg]} {
	    set relative 1
	    set arg [string range $arg 1 end]
	} else {
	    set relative 0
	}
	# Always operate in relative mode for "measurement" mode
	if {[regexp {^\\w'(.*)'u$} $arg content]} {
	    set distance [string length $content]
	} else {
	    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
	if {$relative} {
	    append tabString [format "%*s1" [expr {round($distance-1)}] " "]
	    set last [expr {$last + $distance}]
	} else {
	    append tabString [format "%*s1" [expr {round($distance-$last-1)}] " "]
	    set last $distance
	}
    }
    # 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 ne ""} { 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 {$style eq "subsection"} { 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 \(bu 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 } # Special case for alternative mechanism for declaring bullets if {[lindex $argList 0] eq "\\(bu"} { nest para UL LI return } if {[regexp {^\[\d+\]$} [lindex $argList 0]]} { nest para OL LI return } nest para DL DT formattedText [lindex $argList 0] puts $file "\n
" return } # 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 "

" text $pname puts $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] ne "NEW"} { nest decr } puts -nonewline $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 eq "NEW"} { set nestStk [lreplace $nestStk end end $listStart] puts $file "<$listStart>" } elseif {$top ne $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 ne "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 }