blob: fa57b03595d5df4789a4718a0375ec36adc7832a (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
|
#!/bin/sh
# \
exec tclsh "$0" ${1+"$@"}
package require Tcl 8.4
# 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
}
|
