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