util/src/TclTk/tcl8.6.12/tools/man2html.tcl

   1 #!/bin/sh
   2 # \
   3 exec tclsh "$0" ${1+"$@"}
   4
   5 # man2html.tcl --
   6 #
   7 # This file contains procedures that work in conjunction with the
   8 # man2tcl program to generate a HTML files from Tcl manual entries.
   9 #
  10 # Copyright (c) 1996 Sun Microsystems, Inc.
  11
  12
  13 # sarray -
  14 #
  15 # Save an array to a file so that it can be sourced.
  16 #
  17 # Arguments:
  18 # file -                Name of the output file
  19 # args -                Name of the arrays to save
  20 #
  21 proc sarray {file args} {
  22     set file [open $file w]
  23     foreach a $args {
  24         upvar $a array
  25         if {![array exists array]} {
  26             puts "sarray: \"$a\" isn't an array"
  27             break
  28         }
  29
  30         foreach name [lsort [array names array]] {
  31             regsub -all " " $name "\\ " name1
  32             puts $file "set ${a}($name1) \{$array($name)\}"
  33         }
  34     }
  35     close $file
  36 }
  37
  38
  39 # footer --
  40 #
  41 # Builds footer info for HTML pages
  42 #
  43 # Arguments:
  44 # packages -            List of packages to link to.
  45
  46 proc footer {packages} {
  47     lappend f "<HR>"
  48     set h {[}
  49     foreach package $packages {
  50         lappend h "<A HREF=\"../$package/contents.html\">$package</A>"
  51         lappend h "|"
  52     }
  53     lappend f [join [lreplace $h end end {]} ] " "]
  54     lappend f "<HR>"
  55     lappend f "<PRE>Copyright &#169; 1989-1994 The Regents of the University of California."
  56     lappend f "Copyright &#169; 1994-1996 Sun Microsystems, Inc."
  57     lappend f "</PRE>"
  58     return [join $f "\n"]
  59 }
  60
  61
  62 # doDir --
  63 #
  64 # Given a directory as argument, translate all the man pages in
  65 # that directory.
  66 #
  67 # Arguments:
  68 # dir -                 Name of the directory.
  69
  70 proc doDir dir {
  71     foreach f [lsort [glob -directory $dir "*.\[13n\]"]] {
  72         do $f   ;# defined in man2html1.tcl & man2html2.tcl
  73     }
  74 }
  75
  76
  77 # main --
  78 #
  79 # Main code for converting Tcl manual pages to HTML.
  80 #
  81 # Arguments:
  82 # argv -                List of arguments to this script.
  83
  84 proc main {argv} {
  85     global html_dir
  86     # Global vars used in man2html1.tcl and man2html2.tcl
  87     global NAME_file KEY_file lib state curFile file inDT textState nestStk
  88     global curFont fontStart fontEnd noFillCount footer
  89
  90     if {[llength $argv] < 2} {
  91         puts stderr "usage: $::argv0 html_dir tcl_dir packages..."
  92         puts stderr "usage: $::argv0 -clean html_dir"
  93         exit 1
  94     }
  95
  96     if {[lindex $argv 0] eq "-clean"} {
  97         set html_dir [lindex $argv 1]
  98         puts -nonewline "recursively remove: $html_dir? "
  99         flush stdout
 100         if {[gets stdin] eq "y"} {
 101             puts "removing: $html_dir"
 102             file delete -force $html_dir
 103         }
 104         exit 0
 105     }
 106
 107     set html_dir [lindex $argv 0]
 108     set tcl_dir  [lindex $argv 1]
 109     set packages [lrange $argv 2 end]
 110     set homeDir  [file dirname [info script]]
 111
 112     #### need to add glob capability to packages ####
 113
 114     # make sure there are doc directories for each package
 115
 116     foreach i $packages {
 117         if {![file exists $tcl_dir/$i/doc]} {
 118             puts stderr "Error: doc directory for package $i is missing"
 119             exit 1
 120         }
 121         if {![file isdirectory $tcl_dir/$i/doc]} {
 122             puts stderr "Error: $tcl_dir/$i/doc is not a directory"
 123             exit 1
 124         }
 125     }
 126
 127     # we want to start with a clean sheet
 128
 129     if {[file exists $html_dir]} {
 130         puts stderr "Error: HTML directory already exists"
 131         exit 1
 132     } else {
 133         file mkdir $html_dir
 134     }
 135
 136     set footer [footer $packages]
 137
 138     # make the hyperlink arrays and contents.html for all packages
 139
 140     foreach package $packages {
 141         file mkdir $html_dir/$package
 142
 143         # build hyperlink database arrays: NAME_file and KEY_file
 144         #
 145         puts "\nScanning man pages in $tcl_dir/$package/doc..."
 146         uplevel \#0 [list source $homeDir/man2html1.tcl]
 147
 148         doDir $tcl_dir/$package/doc
 149
 150         # clean up the NAME_file and KEY_file database arrays
 151         #
 152         catch {unset KEY_file()}
 153         foreach name [lsort [array names NAME_file]] {
 154             set file_name $NAME_file($name)
 155             if {[llength $file_name] > 1} {
 156                 set file_name [lsort $file_name]
 157                 puts "Warning: '$name' multiply defined in: $file_name;\
 158                         using last"
 159                 set NAME_file($name) [lindex $file_name end]
 160             }
 161         }
 162         # sarray $html_dir/$package/xref.tcl NAME_file KEY_file
 163
 164         # build the contents file from NAME_file
 165         #
 166         puts "\nGenerating contents.html for $package"
 167         doContents $html_dir/$package/contents.html $lib ;# defined in man2html1.tcl
 168
 169         # now translate the man pages to HTML pages
 170         #
 171         uplevel \#0 [list source $homeDir/man2html2.tcl]
 172         puts "\nBuilding html pages from man pages in $tcl_dir/$package/doc..."
 173         doDir $tcl_dir/$package/doc
 174
 175         unset NAME_file
 176     }
 177 }
 178
 179
 180 if [catch { main $argv } result] {
 181     global errorInfo
 182     puts stderr $result
 183     puts stderr "in"
 184     puts stderr $errorInfo
 185 }