# 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 {\&lt;}  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

 }