if [catch {
set homeDir /home/rjohnson/Projects/tools/generic
proc sarray {file args} {
set file [open $file w]
foreach a $args {
upvar $a array
if ![array exists array] {
puts "sarray: \"$a\" isn't an array"
break
}
foreach name [lsort [array names array]] {
regsub -all " " $name "\\ " name1
puts $file "set ${a}($name1) \{$array($name)\}"
}
}
close $file
}
proc footer {packages} {
lappend f "<HR>"
set h {[}
foreach package $packages {
lappend h "<A HREF=\"../$package/contents.html\">$package</A>"
lappend h "|"
}
lappend f [join [lreplace $h end end {]} ] " "]
lappend f "<HR>"
lappend f "<PRE>Copyright © 1989-1994 The Regents of the University of California."
lappend f "Copyright © 1994-1996 Sun Microsystems, Inc."
lappend f "</PRE>"
return [join $f "\n"]
}
proc doDir dir {
foreach f [lsort [glob -directory $dir "*.\[13n\]"]] {
do $f ; }
}
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]
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
}
}
if [file exists $html_dir] {
puts stderr "Error: HTML directory already exists"
exit 1
} else {
exec mkdir $html_dir
}
set footer [footer $packages]
foreach package $packages {
global homeDir
exec mkdir $html_dir/$package
puts "\nScanning man pages in $tcl_dir/$package/doc..."
source $homeDir/man2html1.tcl
doDir $tcl_dir/$package/doc
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]
}
}
puts "\nGenerating contents.html for $package"
doContents $html_dir/$package/contents.html $lib ;
source $homeDir/man2html2.tcl
puts "\nBuilding html pages from man pages in $tcl_dir/$package/doc..."
doDir $tcl_dir/$package/doc
unset NAME_file
}
} result] {
global errorInfo
puts stderr $result
puts stderr "in"
puts stderr $errorInfo
}