Fix various problems with man2html converter reported by AKu

Also updated to use [package require Tcl 8.4]

1 files changed, 90 insertions, 81 deletions

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
 }
-