diff options
author | William Joye <wjoye@cfa.harvard.edu> | 2018-01-02 21:03:49 (GMT) |
---|---|---|
committer | William Joye <wjoye@cfa.harvard.edu> | 2018-01-02 21:03:49 (GMT) |
commit | 914501b5b992e7b6c7e0a4c958712a8ba9cab41c (patch) | |
tree | edbc059b9557d5fdb79e5a5c47889bc54708da53 /tcl8.6/tools/man2html.tcl | |
parent | f88c190a01bc7f57e79dfaf91a3c0c48c2031549 (diff) | |
download | blt-914501b5b992e7b6c7e0a4c958712a8ba9cab41c.zip blt-914501b5b992e7b6c7e0a4c958712a8ba9cab41c.tar.gz blt-914501b5b992e7b6c7e0a4c958712a8ba9cab41c.tar.bz2 |
upgrade to tcl/tk 8.6.8
Diffstat (limited to 'tcl8.6/tools/man2html.tcl')
-rw-r--r-- | tcl8.6/tools/man2html.tcl | 185 |
1 files changed, 185 insertions, 0 deletions
diff --git a/tcl8.6/tools/man2html.tcl b/tcl8.6/tools/man2html.tcl new file mode 100644 index 0000000..2d03ab6 --- /dev/null +++ b/tcl8.6/tools/man2html.tcl @@ -0,0 +1,185 @@ +#!/bin/sh +# \ +exec tclsh "$0" ${1+"$@"} + +# man2html.tcl -- +# +# This file contains procedures that work in conjunction with the +# man2tcl program to generate a HTML files from Tcl manual entries. +# +# Copyright (c) 1996 by Sun Microsystems, Inc. + + +# sarray - +# +# Save an array to a file so that it can be sourced. +# +# Arguments: +# file - Name of the output file +# args - Name of the arrays to save +# +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 +} + + +# footer -- +# +# Builds footer info for HTML pages +# +# Arguments: +# packages - List of packages to link to. + +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"] +} + + +# doDir -- +# +# Given a directory as argument, translate all the man pages in +# that directory. +# +# Arguments: +# dir - Name of the directory. + +proc doDir dir { + foreach f [lsort [glob -directory $dir "*.\[13n\]"]] { + do $f ;# defined in man2html1.tcl & man2html2.tcl + } +} + + +# main -- +# +# Main code for converting Tcl manual pages to HTML. +# +# Arguments: +# argv - List of arguments to this script. + +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 + + if {[llength $argv] < 2} { + puts stderr "usage: $::argv0 html_dir tcl_dir packages..." + puts stderr "usage: $::argv0 -clean html_dir" + 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]] + + #### need to add glob capability to packages #### + + # 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 + + 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 { + file mkdir $html_dir/$package + + # 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 "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 + + # 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 + # + 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 + } +} + + +if [catch { main $argv } result] { + global errorInfo + puts stderr $result + puts stderr "in" + puts stderr $errorInfo +} |