Fix various problems with man2html converter reported by AKu

Also updated to use [package require Tcl 8.4]

4 files changed, 135 insertions, 124 deletions

diff --git a/ChangeLog b/ChangeLog
index 0c452b2..2c1e364 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2004-11-24  Donal K. Fellows  <donal.k.fellows@man.ac.uk>
+
+	* tools/man2html.tcl, tools/man2html1.tcl: Update to use Tcl 8.4.
+	* tools/man2html2.tcl: Fix broken .SS handling.
+
 2004-11-23  Donal K. Fellows  <donal.k.fellows@man.ac.uk>
 
 	* unix/Makefile.in: Add (commented-out) code to integrate tclConfig.h
diff --git a/tools/man2html.tcl b/tools/man2html.tcl
index 6f44aaa..386396f 100644
--- a/tools/man2html.tcl
+++ b/tools/man2html.tcl
@@ -1,6 +1,8 @@
-#!/proj/tcl/install/5.x-sparc/bin/tclsh7.5
+#!/bin/sh
+# \
+exec tclsh "$0" ${1+"$@"}
 
-if [catch {
+package require Tcl 8.4
 
 # man2html.tcl --
 #
@@ -12,7 +14,6 @@ if [catch {
 # SCCS: @(#) man2html.tcl 1.5 96/04/11 20:21:43
 #
 
-set homeDir /home/rjohnson/Projects/tools/generic
 
 # sarray -
 #
@@ -26,7 +27,7 @@ proc sarray {file args} {
     set file [open $file w]
     foreach a $args {
 	upvar $a array
-	if ![array exists array] {
+	if {![array exists array]} {
 	    puts "sarray: \"$a\" isn't an array"
 	    break
 	}	
@@ -40,13 +41,12 @@ proc sarray {file args} {
 }
 
 
-
 # footer --
 #
 # Builds footer info for HTML pages
 #
 # Arguments:
-# None
+# packages -		List of packages to link to.
 
 proc footer {packages} {
     lappend f "<HR>"
@@ -64,8 +64,6 @@ proc footer {packages} {
 }
 
 
-
-
 # doDir --
 #
 # Given a directory as argument, translate all the man pages in
@@ -81,101 +79,112 @@ proc doDir dir {
 }
 
 
-if {$argc < 2} {
-    puts stderr "usage: $argv0 html_dir tcl_dir packages..."
-    puts stderr "usage: $argv0 -clean html_dir"
-    exit 1
-}
-	
-if {[lindex $argv 0] == "-clean"} {
-    set html_dir [lindex $argv 1]
-    puts -nonewline "recursively remove: $html_dir? "
-    flush stdout
-    if {[gets stdin] == "y"} {
-	puts "removing: $html_dir"
-	exec rm -r $html_dir
-    }
-    exit 0
-}
-
-set html_dir [lindex $argv 0]
-set tcl_dir  [lindex $argv 1]
-set packages [lrange $argv 2 end]
-
-#### need to add glob capability to packages ####
+# main --
+#
+# Main code for converting Tcl manual pages to HTML.
+#
+# Arguments:
+# argv -		List of arguments to this script.
 
-# make sure there are doc directories for each package
+proc main {argv} {
+    global html_dir
+    # Global vars used in man2html1.tcl and man2html2.tcl
+    global NAME_file KEY_file lib state curFile file inDT textState nestStk
+    global curFont fontStart fontEnd noFillCount footer
 
-foreach i $packages {
-    if ![file exists $tcl_dir/$i/doc] {
-	puts stderr "Error: doc directory for package $i is missing"
+    if {[llength $argv] < 2} {
+	puts stderr "usage: $::argv0 html_dir tcl_dir packages..."
+	puts stderr "usage: $::argv0 -clean html_dir"
 	exit 1
     }
-    if ![file isdirectory $tcl_dir/$i/doc] {
-	puts stderr "Error: $tcl_dir/$i/doc is not a directory"
-	exit 1
+
+    if {[lindex $argv 0] eq "-clean"} {
+	set html_dir [lindex $argv 1]
+	puts -nonewline "recursively remove: $html_dir? "
+	flush stdout
+	if {[gets stdin] eq "y"} {
+	    puts "removing: $html_dir"
+	    file delete -force $html_dir
+	}
+	exit 0
     }
-}
 
+    set html_dir [lindex $argv 0]
+    set tcl_dir  [lindex $argv 1]
+    set packages [lrange $argv 2 end]
+    set homeDir  [file dirname [info script]]
 
-# we want to start with a clean sheet
+    #### need to add glob capability to packages ####
 
-if [file exists $html_dir] {
-    puts stderr "Error: HTML directory already exists"
-    exit 1
-} else {
-    exec mkdir $html_dir
-}
+    # make sure there are doc directories for each package
+
+    foreach i $packages {
+	if {![file exists $tcl_dir/$i/doc]} {
+	    puts stderr "Error: doc directory for package $i is missing"
+	    exit 1
+	}
+	if {![file isdirectory $tcl_dir/$i/doc]} {
+	    puts stderr "Error: $tcl_dir/$i/doc is not a directory"
+	    exit 1
+	}
+    }
+
+    # we want to start with a clean sheet
 
-set footer [footer $packages]
+    if {[file exists $html_dir]} {
+	puts stderr "Error: HTML directory already exists"
+	exit 1
+    } else {
+	file mkdir $html_dir
+    }
 
+    set footer [footer $packages]
 
-# make the hyperlink arrays and contents.html for all packages
-	
-foreach package $packages {
-    global homeDir
-    exec mkdir $html_dir/$package
+    # make the hyperlink arrays and contents.html for all packages
+
+    foreach package $packages {
+	file mkdir $html_dir/$package
     
-    # build hyperlink database arrays: NAME_file and KEY_file
-    #
-    puts "\nScanning man pages in $tcl_dir/$package/doc..."
-    source $homeDir/man2html1.tcl
+	# build hyperlink database arrays: NAME_file and KEY_file
+	#
+	puts "\nScanning man pages in $tcl_dir/$package/doc..."
+	uplevel \#0 [list source $homeDir/man2html1.tcl]
     
-    doDir $tcl_dir/$package/doc
-
-    # clean up the NAME_file and KEY_file database arrays
-    #
-    catch {unset KEY_file()}
-    foreach name [lsort [array names NAME_file]] {
-	set file_name $NAME_file($name)
-	if {[llength $file_name] > 1} {
-	    set file_name [lsort $file_name]
-	    puts stdout "Warning: '$name' multiply defined in: $file_name; using last"
-	    set NAME_file($name) [lindex $file_name end]
+	doDir $tcl_dir/$package/doc
+
+	# clean up the NAME_file and KEY_file database arrays
+	#
+	catch {unset KEY_file()}
+	foreach name [lsort [array names NAME_file]] {
+	    set file_name $NAME_file($name)
+	    if {[llength $file_name] > 1} {
+		set file_name [lsort $file_name]
+		puts "Warning: '$name' multiply defined in: $file_name;\
+			using last"
+		set NAME_file($name) [lindex $file_name end]
+	    }
 	}
-    }
-#   sarray $html_dir/$package/xref.tcl NAME_file KEY_file
+	# sarray $html_dir/$package/xref.tcl NAME_file KEY_file
 
-    # build the contents file from NAME_file
-    #
-    puts "\nGenerating contents.html for $package"
-    doContents $html_dir/$package/contents.html $lib ;# defined in man2html1.tcl
+	# build the contents file from NAME_file
+	#
+	puts "\nGenerating contents.html for $package"
+	doContents $html_dir/$package/contents.html $lib ;# defined in man2html1.tcl
 
-    # now translate the man pages to HTML pages
-    #
-    source $homeDir/man2html2.tcl
-    puts "\nBuilding html pages from man pages in $tcl_dir/$package/doc..."
-    doDir $tcl_dir/$package/doc
+	# now translate the man pages to HTML pages
+	#
+	uplevel \#0 [list source $homeDir/man2html2.tcl]
+	puts "\nBuilding html pages from man pages in $tcl_dir/$package/doc..."
+	doDir $tcl_dir/$package/doc
 
-    unset NAME_file
+	unset NAME_file
+    }
 }
 
-	
 
-} result] {
+if [catch { main $argv } result] {
     global errorInfo
     puts stderr $result
     puts stderr "in"
     puts stderr $errorInfo
 }
-
diff --git a/tools/man2html1.tcl b/tools/man2html1.tcl
index 0adc61e..59dc396 100644
--- a/tools/man2html1.tcl
+++ b/tools/man2html1.tcl
@@ -8,6 +8,8 @@
 # SCCS: @(#) man2html1.tcl 1.2 96/03/21 10:48:29
 #
 
+package require Tcl 8.4
+
 # Global variables used by these scripts:
 #
 # state -	state variable that controls action of text proc.
@@ -27,7 +29,6 @@
 # inDT -	in dictionary term. 
 
 
-
 # text --
 #
 # This procedure adds entries to the hypertext arrays NAME_file
@@ -39,7 +40,6 @@
 # Arguments:
 # string -		Text to index.
 
-
 proc text string {
     global state curFile NAME_file KEY_file inDT
 
@@ -80,7 +80,7 @@ proc macro {name args} {
 
 	    switch $args {
 		NAME {
-		    if {$state == "INIT" } {
+		    if {$state eq "INIT"} {
 			set state NAME
 		    }
 		}
@@ -100,8 +100,8 @@ proc macro {name args} {
 	    set inDT 0
 	    set state INIT
 	    if {[llength $args] != 5} {
-		    set args [join $args " "]
-		    puts stderr "Bad .TH macro: .$name $args"
+		set args [join $args " "]
+		puts stderr "Bad .TH macro: .$name $args"
 	    }
 	    set lib [lindex $args 3]				;# Tcl or Tk
 	}
@@ -109,7 +109,6 @@ proc macro {name args} {
 }
 
 
-
 # dash --
 #
 # This procedure is invoked to handle dash characters ("\-" in
@@ -120,13 +119,12 @@ proc macro {name args} {
 
 proc dash {} {
     global state
-    if {$state == "NAME"} {
+    if {$state eq "NAME"} {
 	set state DASH
     }
 }
 
 
-
 # newline --
 #
 # This procedure is invoked to handle newlines in the troff input.
@@ -141,8 +139,6 @@ proc newline {} {
 }
 
 
-
-
 # initGlobals, tab, font, char, macro2 --
 #
 # These procedures do nothing during the first pass. 
@@ -184,14 +180,14 @@ proc doListing {file pattern} {
 	return
     }
     incr max_len
-    set ncols [expr 90/$max_len]
-    set nrows [expr int( ceil( [llength $type] / $ncols. ) ) ]
+    set ncols [expr {90/$max_len}]
+    set nrows [expr {int(ceil([llength $type] / double($ncols)))} ]
 
 #	? max_len ncols nrows
 
     set index 0
     foreach f $type {
-	lappend row([expr $index % $nrows]) $f
+	lappend row([expr {$index % $nrows}]) $f
 	incr index
     }
 
@@ -215,8 +211,9 @@ proc doListing {file pattern} {
 #
 # Arguments:
 # file -		name of the contents file.
-# packageName -	string used in the title and sub-heads of the HTML page. Normally
-#				name of the package without version numbers.
+# packageName -		string used in the title and sub-heads of the HTML
+#			page. Normally name of the package without version
+#			numbers.
 
 proc doContents {file packageName} {
     global footer
@@ -239,8 +236,6 @@ proc doContents {file packageName} {
 }
 
 
-
-
 # do --
 #
 # This is the toplevel procedure that searches a man page
@@ -266,4 +261,3 @@ proc do fileName {
 	exit 1
     }
 }
-
diff --git a/tools/man2html2.tcl b/tools/man2html2.tcl
index 3e1344e..d206cbd 100644
--- a/tools/man2html2.tcl
+++ b/tools/man2html2.tcl
@@ -5,9 +5,11 @@
 #
 # Copyright (c) 1996 by Sun Microsystems, Inc.
 #
-# $Id: man2html2.tcl,v 1.6 2004/07/06 09:27:31 dkf Exp $
+# $Id: man2html2.tcl,v 1.7 2004/11/24 11:24:34 dkf Exp $
 #
 
+package require Tcl 8.4
+
 # Global variables used by these scripts:
 #
 # NAME_file -	array indexed by NAME and containing file names used
@@ -76,7 +78,7 @@ proc initGlobals {} {
 proc beginFont font {
     global curFont file fontStart
 
-    if {$curFont == $font} {
+    if {$curFont eq $font} {
 	return
     }
     endFont
@@ -95,9 +97,9 @@ proc beginFont font {
 proc endFont {} {
     global curFont file fontEnd
 
-    if {$curFont != ""} {
-    puts -nonewline $file $fontEnd($curFont)
-    set curFont ""
+    if {$curFont ne ""} {
+	puts -nonewline $file $fontEnd($curFont)
+	set curFont ""
     }
 }
 
@@ -129,7 +131,7 @@ proc text string {
     regsub -all \"  $string {\&quot;}  string
     switch $textState {
 	REF { 
-	    if {$inDT == {}} {
+	    if {$inDT eq ""} {
 		set string [insertRef $string]
 	    }
 	}
@@ -161,7 +163,7 @@ proc insertRef string {
     global NAME_file self
     set path {}
     if ![catch {set ref $NAME_file([string trim $string])} ] {
-	if {"$ref.html" != $self} {
+	if {"$ref.html" ne $self} {
 	    set string "<A HREF=\"${path}$ref.html\">$string</A>"
 #	    puts "insertRef: $self $ref.html ---$string--"
 	}
@@ -308,7 +310,7 @@ proc macro {name args} {
 	    SHmacro $args
 	}
 	SS {
-	    SSmacro $args subsection
+	    SHmacro $args subsection
 	}
 	SO {
 	    global noFillCount inPRE file
@@ -321,12 +323,12 @@ proc macro {name args} {
 	    font B
 	}
 	so {
-	    if {$args != "man.macros"} {
+	    if {$args ne "man.macros"} {
 		puts stderr "Unknown macro: .$name [join $args " "]"
 	    }
 	}
 	sp {					;# needs work
-	    if {$args == ""} {
+	    if {$args eq ""} {
 		set count 1
 	    } else {
 		set count [lindex $args 0]
@@ -389,13 +391,13 @@ proc font type {
 	P -
 	R {
 	    endFont
-	    if {$textState == "REF"} {
+	    if {$textState eq "REF"} {
 		set textState INSERT
 	    }
 	}
 	B {
 	    beginFont Code
-	    if {$textState == "INSERT"} {
+	    if {$textState eq "INSERT"} {
 		set textState REF
 	    }
 	}
@@ -422,7 +424,7 @@ proc font type {
 
 proc formattedText text {
 #	puts "formattedText: $text"
-    while {$text != ""} {
+    while {$text ne ""} {
 	set index [string first \\ $text]
 	if {$index < 0} {
 	    text $text
@@ -466,7 +468,7 @@ proc formattedText text {
 
 proc dash {} {
     global textState charCnt
-    if {$textState == "NAME"} {
+    if {$textState eq "NAME"} {
     	set textState 0
     }
     incr charCnt
@@ -579,7 +581,7 @@ proc lineBreak {} {
 proc newline {} {
     global noFillCount file inDT inPRE charCnt
 
-    if {$inDT != {} } {
+    if {$inDT ne ""} {
     	puts $file "\n$inDT"
     	set inDT {}
     } elseif {$noFillCount == 0 || $inPRE == 1} {
@@ -661,7 +663,7 @@ proc SHmacro {argList {style section}} {
     nest reset
 
     set tag H3
-    if {[string compare "subsection" $level] == 0} {
+    if {$style eq "subsection"} {
 	set tag H4
     }
     puts -nonewline $file "<$tag>"
@@ -691,11 +693,12 @@ proc SHmacro {argList {style section}} {
 # of the following forms:
 #
 # .IP [1]			Translate to a "1Step" paragraph.
-# .IP [x] (x > 1)	Translate to a "Step" 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".
+# .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.
@@ -802,7 +805,7 @@ proc THmacro {argList} {
 proc newPara {} {
     global file nestStk
 	
-    if {[lindex $nestStk end] != "NEW" } {
+    if {[lindex $nestStk end] ne "NEW"} {
 	nest decr    
     }
     puts -nonewline $file "<P>"
@@ -820,16 +823,16 @@ proc newPara {} {
 # listStart -		begin list tag: OL, UL, DL.
 # listItem -		item tag:       LI, LI, DT.
 
-proc nest {op {listStart "NEW"} {listItem {} } } {
+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" } {
+	    if {$top eq "NEW"} {
 		set nestStk [lreplace $nestStk end end $listStart]
 		puts $file "<$listStart>"
-	    } elseif {$top != $listStart} {
+	    } elseif {$top ne $listStart} {
 		puts stderr "nest para: bad stack"
 		exit 1
 	    }
@@ -845,7 +848,7 @@ proc nest {op {listStart "NEW"} {listItem {} } } {
 		set nestStk NEW
 	    }
 	    set tag [lindex $nestStk end]
-	    if {$tag != "NEW"} {
+	    if {$tag ne "NEW"} {
 		puts $file "</$tag>"
 	    }
 	    set nestStk [lreplace $nestStk end end]