sl@0: #!/proj/tcl/install/5.x-sparc/bin/tclsh7.5
sl@0: 
sl@0: if [catch {
sl@0: 
sl@0: # man2html.tcl --
sl@0: #
sl@0: # This file contains procedures that work in conjunction with the
sl@0: # man2tcl program to generate a HTML files from Tcl manual entries.
sl@0: #
sl@0: # Copyright (c) 1996 by Sun Microsystems, Inc.
sl@0: #
sl@0: # SCCS: @(#) man2html.tcl 1.5 96/04/11 20:21:43
sl@0: #
sl@0: 
sl@0: set homeDir /home/rjohnson/Projects/tools/generic
sl@0: 
sl@0: # sarray -
sl@0: #
sl@0: # Save an array to a file so that it can be sourced.
sl@0: #
sl@0: # Arguments:
sl@0: # file -		Name of the output file
sl@0: # args -		Name of the arrays to save
sl@0: #
sl@0: proc sarray {file args} {
sl@0:     set file [open $file w]
sl@0:     foreach a $args {
sl@0: 	upvar $a array
sl@0: 	if ![array exists array] {
sl@0: 	    puts "sarray: \"$a\" isn't an array"
sl@0: 	    break
sl@0: 	}	
sl@0:     
sl@0: 	foreach name [lsort [array names array]] {
sl@0: 	    regsub -all " " $name "\\ " name1
sl@0: 	    puts $file "set ${a}($name1) \{$array($name)\}"
sl@0: 	}
sl@0:     }
sl@0:     close $file
sl@0: }
sl@0: 
sl@0: 
sl@0: 
sl@0: # footer --
sl@0: #
sl@0: # Builds footer info for HTML pages
sl@0: #
sl@0: # Arguments:
sl@0: # None
sl@0: 
sl@0: proc footer {packages} {
sl@0:     lappend f "<HR>"
sl@0:     set h {[}
sl@0:     foreach package $packages {
sl@0: 	lappend h "<A HREF=\"../$package/contents.html\">$package</A>"
sl@0: 	lappend h "|"
sl@0:     }
sl@0:     lappend f [join [lreplace $h end end {]} ] " "]
sl@0:     lappend f "<HR>"
sl@0:     lappend f "<PRE>Copyright &#169; 1989-1994 The Regents of the University of California."
sl@0:     lappend f "Copyright &#169; 1994-1996 Sun Microsystems, Inc."
sl@0:     lappend f "</PRE>"
sl@0:     return [join $f "\n"]
sl@0: }
sl@0: 
sl@0: 
sl@0: 
sl@0: 
sl@0: # doDir --
sl@0: #
sl@0: # Given a directory as argument, translate all the man pages in
sl@0: # that directory.
sl@0: #
sl@0: # Arguments:
sl@0: # dir -			Name of the directory.
sl@0: 
sl@0: proc doDir dir {
sl@0:     foreach f [lsort [glob -directory $dir "*.\[13n\]"]] {
sl@0: 	do $f	;# defined in man2html1.tcl & man2html2.tcl
sl@0:     }
sl@0: }
sl@0: 
sl@0: 
sl@0: if {$argc < 2} {
sl@0:     puts stderr "usage: $argv0 html_dir tcl_dir packages..."
sl@0:     puts stderr "usage: $argv0 -clean html_dir"
sl@0:     exit 1
sl@0: }
sl@0: 	
sl@0: if {[lindex $argv 0] == "-clean"} {
sl@0:     set html_dir [lindex $argv 1]
sl@0:     puts -nonewline "recursively remove: $html_dir? "
sl@0:     flush stdout
sl@0:     if {[gets stdin] == "y"} {
sl@0: 	puts "removing: $html_dir"
sl@0: 	exec rm -r $html_dir
sl@0:     }
sl@0:     exit 0
sl@0: }
sl@0: 
sl@0: set html_dir [lindex $argv 0]
sl@0: set tcl_dir  [lindex $argv 1]
sl@0: set packages [lrange $argv 2 end]
sl@0: 
sl@0: #### need to add glob capability to packages ####
sl@0: 
sl@0: # make sure there are doc directories for each package
sl@0: 
sl@0: foreach i $packages {
sl@0:     if ![file exists $tcl_dir/$i/doc] {
sl@0: 	puts stderr "Error: doc directory for package $i is missing"
sl@0: 	exit 1
sl@0:     }
sl@0:     if ![file isdirectory $tcl_dir/$i/doc] {
sl@0: 	puts stderr "Error: $tcl_dir/$i/doc is not a directory"
sl@0: 	exit 1
sl@0:     }
sl@0: }
sl@0: 
sl@0: 
sl@0: # we want to start with a clean sheet
sl@0: 
sl@0: if [file exists $html_dir] {
sl@0:     puts stderr "Error: HTML directory already exists"
sl@0:     exit 1
sl@0: } else {
sl@0:     exec mkdir $html_dir
sl@0: }
sl@0: 
sl@0: set footer [footer $packages]
sl@0: 
sl@0: 
sl@0: # make the hyperlink arrays and contents.html for all packages
sl@0: 	
sl@0: foreach package $packages {
sl@0:     global homeDir
sl@0:     exec mkdir $html_dir/$package
sl@0:     
sl@0:     # build hyperlink database arrays: NAME_file and KEY_file
sl@0:     #
sl@0:     puts "\nScanning man pages in $tcl_dir/$package/doc..."
sl@0:     source $homeDir/man2html1.tcl
sl@0:     
sl@0:     doDir $tcl_dir/$package/doc
sl@0: 
sl@0:     # clean up the NAME_file and KEY_file database arrays
sl@0:     #
sl@0:     catch {unset KEY_file()}
sl@0:     foreach name [lsort [array names NAME_file]] {
sl@0: 	set file_name $NAME_file($name)
sl@0: 	if {[llength $file_name] > 1} {
sl@0: 	    set file_name [lsort $file_name]
sl@0: 	    puts stdout "Warning: '$name' multiply defined in: $file_name; using last"
sl@0: 	    set NAME_file($name) [lindex $file_name end]
sl@0: 	}
sl@0:     }
sl@0: #   sarray $html_dir/$package/xref.tcl NAME_file KEY_file
sl@0: 
sl@0:     # build the contents file from NAME_file
sl@0:     #
sl@0:     puts "\nGenerating contents.html for $package"
sl@0:     doContents $html_dir/$package/contents.html $lib ;# defined in man2html1.tcl
sl@0: 
sl@0:     # now translate the man pages to HTML pages
sl@0:     #
sl@0:     source $homeDir/man2html2.tcl
sl@0:     puts "\nBuilding html pages from man pages in $tcl_dir/$package/doc..."
sl@0:     doDir $tcl_dir/$package/doc
sl@0: 
sl@0:     unset NAME_file
sl@0: }
sl@0: 
sl@0: 	
sl@0: 
sl@0: } result] {
sl@0:     global errorInfo
sl@0:     puts stderr $result
sl@0:     puts stderr "in"
sl@0:     puts stderr $errorInfo
sl@0: }
sl@0: