merged tcl 8.1 branch back into the main trunk

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 {\&amp;}  string
+    regsub -all {<} $string {\&lt;}  string
+    regsub -all {>} $string {\&gt;}  string
+    regsub -all {"} $string {\&quot;}  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 "&#177;"
+	}
+	\\% {}					;#  \%
+	\\| {					;#  \|
+	}
+	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
+}
+
+
+