|
sl@0
|
1 |
#!/bin/sh
|
|
sl@0
|
2 |
# The next line is executed by /bin/sh, but not tcl \
|
|
sl@0
|
3 |
exec tclsh8.4 "$0" ${1+"$@"}
|
|
sl@0
|
4 |
|
|
sl@0
|
5 |
package require Tcl 8.4
|
|
sl@0
|
6 |
|
|
sl@0
|
7 |
# Convert Ousterhout format man pages into highly crosslinked
|
|
sl@0
|
8 |
# hypertext.
|
|
sl@0
|
9 |
#
|
|
sl@0
|
10 |
# Along the way detect many unmatched font changes and other odd
|
|
sl@0
|
11 |
# things.
|
|
sl@0
|
12 |
#
|
|
sl@0
|
13 |
# Note well, this program is a hack rather than a piece of software
|
|
sl@0
|
14 |
# engineering. In that sense it's probably a good example of things
|
|
sl@0
|
15 |
# that a scripting language, like Tcl, can do well. It is offered as
|
|
sl@0
|
16 |
# an example of how someone might convert a specific set of man pages
|
|
sl@0
|
17 |
# into hypertext, not as a general solution to the problem. If you
|
|
sl@0
|
18 |
# try to use this, you'll be very much on your own.
|
|
sl@0
|
19 |
#
|
|
sl@0
|
20 |
# Copyright (c) 1995-1997 Roger E. Critchlow Jr
|
|
sl@0
|
21 |
#
|
|
sl@0
|
22 |
# The authors hereby grant permission to use, copy, modify, distribute,
|
|
sl@0
|
23 |
# and license this software and its documentation for any purpose, provided
|
|
sl@0
|
24 |
# that existing copyright notices are retained in all copies and that this
|
|
sl@0
|
25 |
# notice is included verbatim in any distributions. No written agreement,
|
|
sl@0
|
26 |
# license, or royalty fee is required for any of the authorized uses.
|
|
sl@0
|
27 |
# Modifications to this software may be copyrighted by their authors
|
|
sl@0
|
28 |
# and need not follow the licensing terms described here, provided that
|
|
sl@0
|
29 |
# the new terms are clearly indicated on the first page of each file where
|
|
sl@0
|
30 |
# they apply.
|
|
sl@0
|
31 |
#
|
|
sl@0
|
32 |
# IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
|
|
sl@0
|
33 |
# FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
|
|
sl@0
|
34 |
# ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
|
|
sl@0
|
35 |
# DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
|
|
sl@0
|
36 |
# POSSIBILITY OF SUCH DAMAGE.
|
|
sl@0
|
37 |
#
|
|
sl@0
|
38 |
# THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
|
|
sl@0
|
39 |
# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
|
|
sl@0
|
40 |
# FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE
|
|
sl@0
|
41 |
# IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
|
|
sl@0
|
42 |
# NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
|
|
sl@0
|
43 |
# MODIFICATIONS.
|
|
sl@0
|
44 |
#
|
|
sl@0
|
45 |
# Revisions:
|
|
sl@0
|
46 |
# May 15, 1995 - initial release
|
|
sl@0
|
47 |
# May 16, 1995 - added a back to home link to toplevel table of
|
|
sl@0
|
48 |
# contents.
|
|
sl@0
|
49 |
# May 18, 1995 - broke toplevel table of contents into separate
|
|
sl@0
|
50 |
# pages for each section, and broke long table of contents
|
|
sl@0
|
51 |
# into a one page for each man page.
|
|
sl@0
|
52 |
# Mar 10, 1996 - updated for tcl7.5b3/tk4.1b3
|
|
sl@0
|
53 |
# Apr 14, 1996 - incorporated command line parsing from Tom Tromey,
|
|
sl@0
|
54 |
# <tromey@creche.cygnus.com> -- thanks Tom.
|
|
sl@0
|
55 |
# - updated for tcl7.5/tk4.1 final release.
|
|
sl@0
|
56 |
# - converted to same copyright as the man pages.
|
|
sl@0
|
57 |
# Sep 14, 1996 - made various modifications for tcl7.6b1/tk4.2b1
|
|
sl@0
|
58 |
# Oct 18, 1996 - added tcl7.6/tk4.2 to the list of distributions.
|
|
sl@0
|
59 |
# Oct 22, 1996 - major hacking on indentation code and elsewhere.
|
|
sl@0
|
60 |
# Mar 4, 1997 -
|
|
sl@0
|
61 |
# May 28, 1997 - added tcl8.0b1/tk8.0b1 to the list of distributions
|
|
sl@0
|
62 |
# - cleaned source for tclsh8.0 execution
|
|
sl@0
|
63 |
# - renamed output files for windoze installation
|
|
sl@0
|
64 |
# - added spaces to tables
|
|
sl@0
|
65 |
# Oct 24, 1997 - moved from 8.0b1 to 8.0 release
|
|
sl@0
|
66 |
#
|
|
sl@0
|
67 |
|
|
sl@0
|
68 |
set Version "0.32"
|
|
sl@0
|
69 |
|
|
sl@0
|
70 |
proc parse_command_line {} {
|
|
sl@0
|
71 |
global argv Version
|
|
sl@0
|
72 |
|
|
sl@0
|
73 |
# These variables determine where the man pages come from and where
|
|
sl@0
|
74 |
# the converted pages go to.
|
|
sl@0
|
75 |
global tcltkdir tkdir tcldir webdir build_tcl build_tk
|
|
sl@0
|
76 |
|
|
sl@0
|
77 |
# Set defaults based on original code.
|
|
sl@0
|
78 |
set tcltkdir ../..
|
|
sl@0
|
79 |
set tkdir {}
|
|
sl@0
|
80 |
set tcldir {}
|
|
sl@0
|
81 |
set webdir ../html
|
|
sl@0
|
82 |
set build_tcl 0
|
|
sl@0
|
83 |
set build_tk 0
|
|
sl@0
|
84 |
# Default search version is a glob pattern
|
|
sl@0
|
85 |
set useversion {{,[8-9].[0-9]{,.[0-9]{,[0-9]}}}}
|
|
sl@0
|
86 |
|
|
sl@0
|
87 |
# Handle arguments a la GNU:
|
|
sl@0
|
88 |
# --version
|
|
sl@0
|
89 |
# --useversion=<version>
|
|
sl@0
|
90 |
# --help
|
|
sl@0
|
91 |
# --srcdir=/path
|
|
sl@0
|
92 |
# --htmldir=/path
|
|
sl@0
|
93 |
|
|
sl@0
|
94 |
foreach option $argv {
|
|
sl@0
|
95 |
switch -glob -- $option {
|
|
sl@0
|
96 |
--version {
|
|
sl@0
|
97 |
puts "tcltk-man-html $Version"
|
|
sl@0
|
98 |
exit 0
|
|
sl@0
|
99 |
}
|
|
sl@0
|
100 |
|
|
sl@0
|
101 |
--help {
|
|
sl@0
|
102 |
puts "usage: tcltk-man-html \[OPTION\] ...\n"
|
|
sl@0
|
103 |
puts " --help print this help, then exit"
|
|
sl@0
|
104 |
puts " --version print version number, then exit"
|
|
sl@0
|
105 |
puts " --srcdir=DIR find tcl and tk source below DIR"
|
|
sl@0
|
106 |
puts " --htmldir=DIR put generated HTML in DIR"
|
|
sl@0
|
107 |
puts " --tcl build tcl help"
|
|
sl@0
|
108 |
puts " --tk build tk help"
|
|
sl@0
|
109 |
puts " --useversion version of tcl/tk to search for"
|
|
sl@0
|
110 |
exit 0
|
|
sl@0
|
111 |
}
|
|
sl@0
|
112 |
|
|
sl@0
|
113 |
--srcdir=* {
|
|
sl@0
|
114 |
# length of "--srcdir=" is 9.
|
|
sl@0
|
115 |
set tcltkdir [string range $option 9 end]
|
|
sl@0
|
116 |
}
|
|
sl@0
|
117 |
|
|
sl@0
|
118 |
--htmldir=* {
|
|
sl@0
|
119 |
# length of "--htmldir=" is 10
|
|
sl@0
|
120 |
set webdir [string range $option 10 end]
|
|
sl@0
|
121 |
}
|
|
sl@0
|
122 |
|
|
sl@0
|
123 |
--useversion=* {
|
|
sl@0
|
124 |
# length of "--useversion=" is 13
|
|
sl@0
|
125 |
set useversion [string range $option 13 end]
|
|
sl@0
|
126 |
}
|
|
sl@0
|
127 |
|
|
sl@0
|
128 |
--tcl {
|
|
sl@0
|
129 |
set build_tcl 1
|
|
sl@0
|
130 |
}
|
|
sl@0
|
131 |
|
|
sl@0
|
132 |
--tk {
|
|
sl@0
|
133 |
set build_tk 1
|
|
sl@0
|
134 |
}
|
|
sl@0
|
135 |
|
|
sl@0
|
136 |
default {
|
|
sl@0
|
137 |
puts stderr "tcltk-man-html: unrecognized option -- `$option'"
|
|
sl@0
|
138 |
exit 1
|
|
sl@0
|
139 |
}
|
|
sl@0
|
140 |
}
|
|
sl@0
|
141 |
}
|
|
sl@0
|
142 |
|
|
sl@0
|
143 |
if {!$build_tcl && !$build_tk} {set build_tcl 1; set build_tk 1}
|
|
sl@0
|
144 |
|
|
sl@0
|
145 |
if {$build_tcl} {
|
|
sl@0
|
146 |
# Find Tcl.
|
|
sl@0
|
147 |
set tcldir [lindex [lsort [glob -nocomplain -tails -type d \
|
|
sl@0
|
148 |
-directory $tcltkdir tcl$useversion]] end]
|
|
sl@0
|
149 |
if {$tcldir == ""} then {
|
|
sl@0
|
150 |
puts stderr "tcltk-man-html: couldn't find Tcl below $tcltkdir"
|
|
sl@0
|
151 |
exit 1
|
|
sl@0
|
152 |
}
|
|
sl@0
|
153 |
puts "using Tcl source directory $tcldir"
|
|
sl@0
|
154 |
}
|
|
sl@0
|
155 |
|
|
sl@0
|
156 |
if {$build_tk} {
|
|
sl@0
|
157 |
# Find Tk.
|
|
sl@0
|
158 |
set tkdir [lindex [lsort [glob -nocomplain -tails -type d \
|
|
sl@0
|
159 |
-directory $tcltkdir tk$useversion]] end]
|
|
sl@0
|
160 |
if {$tkdir == ""} then {
|
|
sl@0
|
161 |
puts stderr "tcltk-man-html: couldn't find Tk below $tcltkdir"
|
|
sl@0
|
162 |
exit 1
|
|
sl@0
|
163 |
}
|
|
sl@0
|
164 |
puts "using Tk source directory $tkdir"
|
|
sl@0
|
165 |
}
|
|
sl@0
|
166 |
|
|
sl@0
|
167 |
# the title for the man pages overall
|
|
sl@0
|
168 |
global overall_title
|
|
sl@0
|
169 |
set overall_title ""
|
|
sl@0
|
170 |
if {$build_tcl} {append overall_title "[capitalize $tcldir]"}
|
|
sl@0
|
171 |
if {$build_tcl && $build_tk} {append overall_title "/"}
|
|
sl@0
|
172 |
if {$build_tk} {append overall_title "[capitalize $tkdir]"}
|
|
sl@0
|
173 |
append overall_title " Manual"
|
|
sl@0
|
174 |
}
|
|
sl@0
|
175 |
|
|
sl@0
|
176 |
proc capitalize {string} {
|
|
sl@0
|
177 |
return [string toupper $string 0]
|
|
sl@0
|
178 |
}
|
|
sl@0
|
179 |
|
|
sl@0
|
180 |
##
|
|
sl@0
|
181 |
##
|
|
sl@0
|
182 |
##
|
|
sl@0
|
183 |
set manual(report-level) 1
|
|
sl@0
|
184 |
|
|
sl@0
|
185 |
proc manerror {msg} {
|
|
sl@0
|
186 |
global manual
|
|
sl@0
|
187 |
set name {}
|
|
sl@0
|
188 |
set subj {}
|
|
sl@0
|
189 |
if {[info exists manual(name)]} {
|
|
sl@0
|
190 |
set name $manual(name)
|
|
sl@0
|
191 |
}
|
|
sl@0
|
192 |
if {[info exists manual(section)] && [string length $manual(section)]} {
|
|
sl@0
|
193 |
puts stderr "$name: $manual(section): $msg"
|
|
sl@0
|
194 |
} else {
|
|
sl@0
|
195 |
puts stderr "$name: $msg"
|
|
sl@0
|
196 |
}
|
|
sl@0
|
197 |
}
|
|
sl@0
|
198 |
|
|
sl@0
|
199 |
proc manreport {level msg} {
|
|
sl@0
|
200 |
global manual
|
|
sl@0
|
201 |
if {$level < $manual(report-level)} {
|
|
sl@0
|
202 |
manerror $msg
|
|
sl@0
|
203 |
}
|
|
sl@0
|
204 |
}
|
|
sl@0
|
205 |
|
|
sl@0
|
206 |
proc fatal {msg} {
|
|
sl@0
|
207 |
global manual
|
|
sl@0
|
208 |
manerror $msg
|
|
sl@0
|
209 |
exit 1
|
|
sl@0
|
210 |
}
|
|
sl@0
|
211 |
##
|
|
sl@0
|
212 |
## parsing
|
|
sl@0
|
213 |
##
|
|
sl@0
|
214 |
proc unquote arg {
|
|
sl@0
|
215 |
return [string map [list \" {}] $arg]
|
|
sl@0
|
216 |
}
|
|
sl@0
|
217 |
|
|
sl@0
|
218 |
proc parse-directive {line codename restname} {
|
|
sl@0
|
219 |
upvar $codename code $restname rest
|
|
sl@0
|
220 |
return [regexp {^(\.[.a-zA-Z0-9]*) *(.*)} $line all code rest]
|
|
sl@0
|
221 |
}
|
|
sl@0
|
222 |
|
|
sl@0
|
223 |
proc process-text {text} {
|
|
sl@0
|
224 |
global manual
|
|
sl@0
|
225 |
# preprocess text
|
|
sl@0
|
226 |
set text [string map [list \
|
|
sl@0
|
227 |
{\&} "\t" \
|
|
sl@0
|
228 |
{&} {&} \
|
|
sl@0
|
229 |
{\\} {\} \
|
|
sl@0
|
230 |
{\e} {\} \
|
|
sl@0
|
231 |
{\ } { } \
|
|
sl@0
|
232 |
{\|} { } \
|
|
sl@0
|
233 |
{\0} { } \
|
|
sl@0
|
234 |
{\%} {} \
|
|
sl@0
|
235 |
"\\\n" "\n" \
|
|
sl@0
|
236 |
\" {"} \
|
|
sl@0
|
237 |
{<} {<} \
|
|
sl@0
|
238 |
{>} {>} \
|
|
sl@0
|
239 |
{\(+-} {±} \
|
|
sl@0
|
240 |
{\fP} {\fR} \
|
|
sl@0
|
241 |
{\.} . \
|
|
sl@0
|
242 |
{\(bu} {•} \
|
|
sl@0
|
243 |
] $text]
|
|
sl@0
|
244 |
regsub -all {\\o'o\^'} $text {\ô} text; # o-circumflex in re_syntax.n
|
|
sl@0
|
245 |
regsub -all {\\-\\\|\\-} $text -- text; # two hyphens
|
|
sl@0
|
246 |
regsub -all -- {\\-\\\^\\-} $text -- text; # two hyphens
|
|
sl@0
|
247 |
regsub -all {\\-} $text - text; # a hyphen
|
|
sl@0
|
248 |
regsub -all "\\\\\n" $text "\\\\n" text; # backslashed newline
|
|
sl@0
|
249 |
while {[string first "\\" $text] >= 0} {
|
|
sl@0
|
250 |
# C R
|
|
sl@0
|
251 |
if {[regsub {^([^\\]*)\\fC([^\\]*)\\fR(.*)$} $text \
|
|
sl@0
|
252 |
{\1<TT>\2</TT>\3} text]} continue
|
|
sl@0
|
253 |
# B R
|
|
sl@0
|
254 |
if {[regsub {^([^\\]*)\\fB([^\\]*)\\fR(.*)$} $text \
|
|
sl@0
|
255 |
{\1<B>\2</B>\3} text]} continue
|
|
sl@0
|
256 |
# B I
|
|
sl@0
|
257 |
if {[regsub {^([^\\]*)\\fB([^\\]*)\\fI(.*)$} $text \
|
|
sl@0
|
258 |
{\1<B>\2</B>\\fI\3} text]} continue
|
|
sl@0
|
259 |
# I R
|
|
sl@0
|
260 |
if {[regsub {^([^\\]*)\\fI([^\\]*)\\fR(.*)$} $text \
|
|
sl@0
|
261 |
{\1<I>\2</I>\3} text]} continue
|
|
sl@0
|
262 |
# I B
|
|
sl@0
|
263 |
if {[regsub {^([^\\]*)\\fI([^\\]*)\\fB(.*)$} $text \
|
|
sl@0
|
264 |
{\1<I>\2</I>\\fB\3} text]} continue
|
|
sl@0
|
265 |
# B B, I I, R R
|
|
sl@0
|
266 |
if {[regsub {^([^\\]*)\\fB([^\\]*)\\fB(.*)$} $text \
|
|
sl@0
|
267 |
{\1\\fB\2\3} ntext]
|
|
sl@0
|
268 |
|| [regsub {^([^\\]*)\\fI([^\\]*)\\fI(.*)$} $text \
|
|
sl@0
|
269 |
{\1\\fI\2\3} ntext]
|
|
sl@0
|
270 |
|| [regsub {^([^\\]*)\\fR([^\\]*)\\fR(.*)$} $text \
|
|
sl@0
|
271 |
{\1\\fR\2\3} ntext]} {
|
|
sl@0
|
272 |
manerror "process-text: impotent font change: $text"
|
|
sl@0
|
273 |
set text $ntext
|
|
sl@0
|
274 |
continue
|
|
sl@0
|
275 |
}
|
|
sl@0
|
276 |
# unrecognized
|
|
sl@0
|
277 |
manerror "process-text: uncaught backslash: $text"
|
|
sl@0
|
278 |
set text [string map [list "\\" "#92;"] $text]
|
|
sl@0
|
279 |
}
|
|
sl@0
|
280 |
return $text
|
|
sl@0
|
281 |
}
|
|
sl@0
|
282 |
##
|
|
sl@0
|
283 |
## pass 2 text input and matching
|
|
sl@0
|
284 |
##
|
|
sl@0
|
285 |
proc open-text {} {
|
|
sl@0
|
286 |
global manual
|
|
sl@0
|
287 |
set manual(text-length) [llength $manual(text)]
|
|
sl@0
|
288 |
set manual(text-pointer) 0
|
|
sl@0
|
289 |
}
|
|
sl@0
|
290 |
proc more-text {} {
|
|
sl@0
|
291 |
global manual
|
|
sl@0
|
292 |
return [expr {$manual(text-pointer) < $manual(text-length)}]
|
|
sl@0
|
293 |
}
|
|
sl@0
|
294 |
proc next-text {} {
|
|
sl@0
|
295 |
global manual
|
|
sl@0
|
296 |
if {[more-text]} {
|
|
sl@0
|
297 |
set text [lindex $manual(text) $manual(text-pointer)]
|
|
sl@0
|
298 |
incr manual(text-pointer)
|
|
sl@0
|
299 |
return $text
|
|
sl@0
|
300 |
}
|
|
sl@0
|
301 |
manerror "read past end of text"
|
|
sl@0
|
302 |
error "fatal"
|
|
sl@0
|
303 |
}
|
|
sl@0
|
304 |
proc is-a-directive {line} {
|
|
sl@0
|
305 |
return [string match .* $line]
|
|
sl@0
|
306 |
}
|
|
sl@0
|
307 |
proc split-directive {line opname restname} {
|
|
sl@0
|
308 |
upvar $opname op $restname rest
|
|
sl@0
|
309 |
set op [string range $line 0 2]
|
|
sl@0
|
310 |
set rest [string trim [string range $line 3 end]]
|
|
sl@0
|
311 |
}
|
|
sl@0
|
312 |
proc next-op-is {op restname} {
|
|
sl@0
|
313 |
global manual
|
|
sl@0
|
314 |
upvar $restname rest
|
|
sl@0
|
315 |
if {[more-text]} {
|
|
sl@0
|
316 |
set text [lindex $manual(text) $manual(text-pointer)]
|
|
sl@0
|
317 |
if {[string equal -length 3 $text $op]} {
|
|
sl@0
|
318 |
set rest [string range $text 4 end]
|
|
sl@0
|
319 |
incr manual(text-pointer)
|
|
sl@0
|
320 |
return 1
|
|
sl@0
|
321 |
}
|
|
sl@0
|
322 |
}
|
|
sl@0
|
323 |
return 0
|
|
sl@0
|
324 |
}
|
|
sl@0
|
325 |
proc backup-text {n} {
|
|
sl@0
|
326 |
global manual
|
|
sl@0
|
327 |
if {$manual(text-pointer)-$n >= 0} {
|
|
sl@0
|
328 |
incr manual(text-pointer) -$n
|
|
sl@0
|
329 |
}
|
|
sl@0
|
330 |
}
|
|
sl@0
|
331 |
proc match-text args {
|
|
sl@0
|
332 |
global manual
|
|
sl@0
|
333 |
set nargs [llength $args]
|
|
sl@0
|
334 |
if {$manual(text-pointer) + $nargs > $manual(text-length)} {
|
|
sl@0
|
335 |
return 0
|
|
sl@0
|
336 |
}
|
|
sl@0
|
337 |
set nback 0
|
|
sl@0
|
338 |
foreach arg $args {
|
|
sl@0
|
339 |
if {![more-text]} {
|
|
sl@0
|
340 |
backup-text $nback
|
|
sl@0
|
341 |
return 0
|
|
sl@0
|
342 |
}
|
|
sl@0
|
343 |
set arg [string trim $arg]
|
|
sl@0
|
344 |
set targ [string trim [lindex $manual(text) $manual(text-pointer)]]
|
|
sl@0
|
345 |
if {[string equal $arg $targ]} {
|
|
sl@0
|
346 |
incr nback
|
|
sl@0
|
347 |
incr manual(text-pointer)
|
|
sl@0
|
348 |
continue
|
|
sl@0
|
349 |
}
|
|
sl@0
|
350 |
if {[regexp {^@(\w+)$} $arg all name]} {
|
|
sl@0
|
351 |
upvar $name var
|
|
sl@0
|
352 |
set var $targ
|
|
sl@0
|
353 |
incr nback
|
|
sl@0
|
354 |
incr manual(text-pointer)
|
|
sl@0
|
355 |
continue
|
|
sl@0
|
356 |
}
|
|
sl@0
|
357 |
if {[regexp -nocase {^(\.[A-Z][A-Z])@(\w+)$} $arg all op name]\
|
|
sl@0
|
358 |
&& [string equal $op [lindex $targ 0]]} {
|
|
sl@0
|
359 |
upvar $name var
|
|
sl@0
|
360 |
set var [lrange $targ 1 end]
|
|
sl@0
|
361 |
incr nback
|
|
sl@0
|
362 |
incr manual(text-pointer)
|
|
sl@0
|
363 |
continue
|
|
sl@0
|
364 |
}
|
|
sl@0
|
365 |
backup-text $nback
|
|
sl@0
|
366 |
return 0
|
|
sl@0
|
367 |
}
|
|
sl@0
|
368 |
return 1
|
|
sl@0
|
369 |
}
|
|
sl@0
|
370 |
proc expand-next-text {n} {
|
|
sl@0
|
371 |
global manual
|
|
sl@0
|
372 |
return [join [lrange $manual(text) $manual(text-pointer) \
|
|
sl@0
|
373 |
[expr {$manual(text-pointer)+$n-1}]] \n\n]
|
|
sl@0
|
374 |
}
|
|
sl@0
|
375 |
##
|
|
sl@0
|
376 |
## pass 2 output
|
|
sl@0
|
377 |
##
|
|
sl@0
|
378 |
proc man-puts {text} {
|
|
sl@0
|
379 |
global manual
|
|
sl@0
|
380 |
lappend manual(output-$manual(wing-file)-$manual(name)) $text
|
|
sl@0
|
381 |
}
|
|
sl@0
|
382 |
|
|
sl@0
|
383 |
##
|
|
sl@0
|
384 |
## build hypertext links to tables of contents
|
|
sl@0
|
385 |
##
|
|
sl@0
|
386 |
proc long-toc {text} {
|
|
sl@0
|
387 |
global manual
|
|
sl@0
|
388 |
set here M[incr manual(section-toc-n)]
|
|
sl@0
|
389 |
set there L[incr manual(long-toc-n)]
|
|
sl@0
|
390 |
lappend manual(section-toc) \
|
|
sl@0
|
391 |
"<DD><A HREF=\"$manual(name).htm#$here\" NAME=\"$there\">$text</A>"
|
|
sl@0
|
392 |
return "<A NAME=\"$here\">$text</A>"
|
|
sl@0
|
393 |
}
|
|
sl@0
|
394 |
proc option-toc {name class switch} {
|
|
sl@0
|
395 |
global manual
|
|
sl@0
|
396 |
if {[string equal $manual(section) "WIDGET-SPECIFIC OPTIONS"]} {
|
|
sl@0
|
397 |
# link the defined option into the long table of contents
|
|
sl@0
|
398 |
set link [long-toc "$switch, $name, $class"]
|
|
sl@0
|
399 |
regsub -- "$switch, $name, $class" $link "$switch" link
|
|
sl@0
|
400 |
return $link
|
|
sl@0
|
401 |
} elseif {[string equal $manual(name):$manual(section) \
|
|
sl@0
|
402 |
"options:DESCRIPTION"]} {
|
|
sl@0
|
403 |
# link the defined standard option to the long table of
|
|
sl@0
|
404 |
# contents and make a target for the standard option references
|
|
sl@0
|
405 |
# from other man pages.
|
|
sl@0
|
406 |
set first [lindex $switch 0]
|
|
sl@0
|
407 |
set here M$first
|
|
sl@0
|
408 |
set there L[incr manual(long-toc-n)]
|
|
sl@0
|
409 |
set manual(standard-option-$first) "<A HREF=\"$manual(name).htm#$here\">$switch, $name, $class</A>"
|
|
sl@0
|
410 |
lappend manual(section-toc) "<DD><A HREF=\"$manual(name).htm#$here\" NAME=\"$there\">$switch, $name, $class</A>"
|
|
sl@0
|
411 |
return "<A NAME=\"$here\">$switch</A>"
|
|
sl@0
|
412 |
} else {
|
|
sl@0
|
413 |
error "option-toc in $manual(name) section $manual(section)"
|
|
sl@0
|
414 |
}
|
|
sl@0
|
415 |
}
|
|
sl@0
|
416 |
proc std-option-toc {name} {
|
|
sl@0
|
417 |
global manual
|
|
sl@0
|
418 |
if {[info exists manual(standard-option-$name)]} {
|
|
sl@0
|
419 |
lappend manual(section-toc) <DD>$manual(standard-option-$name)
|
|
sl@0
|
420 |
return $manual(standard-option-$name)
|
|
sl@0
|
421 |
}
|
|
sl@0
|
422 |
set here M[incr manual(section-toc-n)]
|
|
sl@0
|
423 |
set there L[incr manual(long-toc-n)]
|
|
sl@0
|
424 |
set other M$name
|
|
sl@0
|
425 |
lappend manual(section-toc) "<DD><A HREF=\"options.htm#$other\">$name</A>"
|
|
sl@0
|
426 |
return "<A HREF=\"options.htm#$other\">$name</A>"
|
|
sl@0
|
427 |
}
|
|
sl@0
|
428 |
##
|
|
sl@0
|
429 |
## process the widget option section
|
|
sl@0
|
430 |
## in widget and options man pages
|
|
sl@0
|
431 |
##
|
|
sl@0
|
432 |
proc output-widget-options {rest} {
|
|
sl@0
|
433 |
global manual
|
|
sl@0
|
434 |
man-puts <DL>
|
|
sl@0
|
435 |
lappend manual(section-toc) <DL>
|
|
sl@0
|
436 |
backup-text 1
|
|
sl@0
|
437 |
set para {}
|
|
sl@0
|
438 |
while {[next-op-is .OP rest]} {
|
|
sl@0
|
439 |
switch -exact [llength $rest] {
|
|
sl@0
|
440 |
3 { foreach {switch name class} $rest { break } }
|
|
sl@0
|
441 |
5 {
|
|
sl@0
|
442 |
set switch [lrange $rest 0 2]
|
|
sl@0
|
443 |
set name [lindex $rest 3]
|
|
sl@0
|
444 |
set class [lindex $rest 4]
|
|
sl@0
|
445 |
}
|
|
sl@0
|
446 |
default {
|
|
sl@0
|
447 |
fatal "bad .OP $rest"
|
|
sl@0
|
448 |
}
|
|
sl@0
|
449 |
}
|
|
sl@0
|
450 |
if {![regexp {^(<.>)([-\w ]+)(</.>)$} $switch all oswitch switch cswitch]} {
|
|
sl@0
|
451 |
if {![regexp {^(<.>)([-\w ]+) or ([-\w ]+)(</.>)$} $switch all oswitch switch1 switch2 cswitch]} {
|
|
sl@0
|
452 |
error "not Switch: $switch"
|
|
sl@0
|
453 |
} else {
|
|
sl@0
|
454 |
set switch "$switch1$cswitch or $oswitch$switch2"
|
|
sl@0
|
455 |
}
|
|
sl@0
|
456 |
}
|
|
sl@0
|
457 |
if {![regexp {^(<.>)([\w]*)(</.>)$} $name all oname name cname]} {
|
|
sl@0
|
458 |
error "not Name: $name"
|
|
sl@0
|
459 |
}
|
|
sl@0
|
460 |
if {![regexp {^(<.>)([\w]*)(</.>)$} $class all oclass class cclass]} {
|
|
sl@0
|
461 |
error "not Class: $class"
|
|
sl@0
|
462 |
}
|
|
sl@0
|
463 |
man-puts "$para<DT>Command-Line Name: $oswitch[option-toc $name $class $switch]$cswitch"
|
|
sl@0
|
464 |
man-puts "<DT>Database Name: $oname$name$cname"
|
|
sl@0
|
465 |
man-puts "<DT>Database Class: $oclass$class$cclass"
|
|
sl@0
|
466 |
man-puts <DD>[next-text]
|
|
sl@0
|
467 |
set para <P>
|
|
sl@0
|
468 |
}
|
|
sl@0
|
469 |
man-puts </DL>
|
|
sl@0
|
470 |
lappend manual(section-toc) </DL>
|
|
sl@0
|
471 |
}
|
|
sl@0
|
472 |
|
|
sl@0
|
473 |
##
|
|
sl@0
|
474 |
## process .RS lists
|
|
sl@0
|
475 |
##
|
|
sl@0
|
476 |
proc output-RS-list {} {
|
|
sl@0
|
477 |
global manual
|
|
sl@0
|
478 |
if {[next-op-is .IP rest]} {
|
|
sl@0
|
479 |
output-IP-list .RS .IP $rest
|
|
sl@0
|
480 |
if {[match-text .RE .sp .RS @rest .IP @rest2]} {
|
|
sl@0
|
481 |
man-puts <P>$rest
|
|
sl@0
|
482 |
output-IP-list .RS .IP $rest2
|
|
sl@0
|
483 |
}
|
|
sl@0
|
484 |
if {[match-text .RE .sp .RS @rest .RE]} {
|
|
sl@0
|
485 |
man-puts <P>$rest
|
|
sl@0
|
486 |
return
|
|
sl@0
|
487 |
}
|
|
sl@0
|
488 |
if {[next-op-is .RE rest]} {
|
|
sl@0
|
489 |
return
|
|
sl@0
|
490 |
}
|
|
sl@0
|
491 |
}
|
|
sl@0
|
492 |
man-puts <DL><DD>
|
|
sl@0
|
493 |
while {[more-text]} {
|
|
sl@0
|
494 |
set line [next-text]
|
|
sl@0
|
495 |
if {[is-a-directive $line]} {
|
|
sl@0
|
496 |
split-directive $line code rest
|
|
sl@0
|
497 |
switch -exact $code {
|
|
sl@0
|
498 |
.RE {
|
|
sl@0
|
499 |
break
|
|
sl@0
|
500 |
}
|
|
sl@0
|
501 |
.SH - .SS {
|
|
sl@0
|
502 |
manerror "unbalanced .RS at section end"
|
|
sl@0
|
503 |
backup-text 1
|
|
sl@0
|
504 |
break
|
|
sl@0
|
505 |
}
|
|
sl@0
|
506 |
default {
|
|
sl@0
|
507 |
output-directive $line
|
|
sl@0
|
508 |
}
|
|
sl@0
|
509 |
}
|
|
sl@0
|
510 |
} else {
|
|
sl@0
|
511 |
man-puts $line
|
|
sl@0
|
512 |
}
|
|
sl@0
|
513 |
}
|
|
sl@0
|
514 |
man-puts </DL>
|
|
sl@0
|
515 |
}
|
|
sl@0
|
516 |
|
|
sl@0
|
517 |
##
|
|
sl@0
|
518 |
## process .IP lists which may be plain indents,
|
|
sl@0
|
519 |
## numeric lists, or definition lists
|
|
sl@0
|
520 |
##
|
|
sl@0
|
521 |
proc output-IP-list {context code rest} {
|
|
sl@0
|
522 |
global manual
|
|
sl@0
|
523 |
if {![string length $rest]} {
|
|
sl@0
|
524 |
# blank label, plain indent, no contents entry
|
|
sl@0
|
525 |
man-puts <DL><DD>
|
|
sl@0
|
526 |
while {[more-text]} {
|
|
sl@0
|
527 |
set line [next-text]
|
|
sl@0
|
528 |
if {[is-a-directive $line]} {
|
|
sl@0
|
529 |
split-directive $line code rest
|
|
sl@0
|
530 |
if {[string equal $code ".IP"] && [string equal $rest {}]} {
|
|
sl@0
|
531 |
man-puts "<P>"
|
|
sl@0
|
532 |
continue
|
|
sl@0
|
533 |
}
|
|
sl@0
|
534 |
if {[lsearch {.br .DS .RS} $code] >= 0} {
|
|
sl@0
|
535 |
output-directive $line
|
|
sl@0
|
536 |
} else {
|
|
sl@0
|
537 |
backup-text 1
|
|
sl@0
|
538 |
break
|
|
sl@0
|
539 |
}
|
|
sl@0
|
540 |
} else {
|
|
sl@0
|
541 |
man-puts $line
|
|
sl@0
|
542 |
}
|
|
sl@0
|
543 |
}
|
|
sl@0
|
544 |
man-puts </DL>
|
|
sl@0
|
545 |
} else {
|
|
sl@0
|
546 |
# labelled list, make contents
|
|
sl@0
|
547 |
if {
|
|
sl@0
|
548 |
[string compare $context ".SH"] &&
|
|
sl@0
|
549 |
[string compare $context ".SS"]
|
|
sl@0
|
550 |
} then {
|
|
sl@0
|
551 |
man-puts <P>
|
|
sl@0
|
552 |
}
|
|
sl@0
|
553 |
man-puts <DL>
|
|
sl@0
|
554 |
lappend manual(section-toc) <DL>
|
|
sl@0
|
555 |
backup-text 1
|
|
sl@0
|
556 |
set accept_RE 0
|
|
sl@0
|
557 |
set para {}
|
|
sl@0
|
558 |
while {[more-text]} {
|
|
sl@0
|
559 |
set line [next-text]
|
|
sl@0
|
560 |
if {[is-a-directive $line]} {
|
|
sl@0
|
561 |
split-directive $line code rest
|
|
sl@0
|
562 |
switch -exact $code {
|
|
sl@0
|
563 |
.IP {
|
|
sl@0
|
564 |
if {$accept_RE} {
|
|
sl@0
|
565 |
output-IP-list .IP $code $rest
|
|
sl@0
|
566 |
continue
|
|
sl@0
|
567 |
}
|
|
sl@0
|
568 |
if {[string equal $manual(section) "ARGUMENTS"] || \
|
|
sl@0
|
569 |
[regexp {^\[\d+\]$} $rest]} {
|
|
sl@0
|
570 |
man-puts "$para<DT>$rest<DD>"
|
|
sl@0
|
571 |
} elseif {[string equal {•} $rest]} {
|
|
sl@0
|
572 |
man-puts "$para<DT><DD>$rest "
|
|
sl@0
|
573 |
} else {
|
|
sl@0
|
574 |
man-puts "$para<DT>[long-toc $rest]<DD>"
|
|
sl@0
|
575 |
}
|
|
sl@0
|
576 |
if {[string equal $manual(name):$manual(section) \
|
|
sl@0
|
577 |
"selection:DESCRIPTION"]} {
|
|
sl@0
|
578 |
if {[match-text .RE @rest .RS .RS]} {
|
|
sl@0
|
579 |
man-puts <DT>[long-toc $rest]<DD>
|
|
sl@0
|
580 |
}
|
|
sl@0
|
581 |
}
|
|
sl@0
|
582 |
}
|
|
sl@0
|
583 |
.sp -
|
|
sl@0
|
584 |
.br -
|
|
sl@0
|
585 |
.DS -
|
|
sl@0
|
586 |
.CS {
|
|
sl@0
|
587 |
output-directive $line
|
|
sl@0
|
588 |
}
|
|
sl@0
|
589 |
.RS {
|
|
sl@0
|
590 |
if {[match-text .RS]} {
|
|
sl@0
|
591 |
output-directive $line
|
|
sl@0
|
592 |
incr accept_RE 1
|
|
sl@0
|
593 |
} elseif {[match-text .CS]} {
|
|
sl@0
|
594 |
output-directive .CS
|
|
sl@0
|
595 |
incr accept_RE 1
|
|
sl@0
|
596 |
} elseif {[match-text .PP]} {
|
|
sl@0
|
597 |
output-directive .PP
|
|
sl@0
|
598 |
incr accept_RE 1
|
|
sl@0
|
599 |
} elseif {[match-text .DS]} {
|
|
sl@0
|
600 |
output-directive .DS
|
|
sl@0
|
601 |
incr accept_RE 1
|
|
sl@0
|
602 |
} else {
|
|
sl@0
|
603 |
output-directive $line
|
|
sl@0
|
604 |
}
|
|
sl@0
|
605 |
}
|
|
sl@0
|
606 |
.PP {
|
|
sl@0
|
607 |
if {[match-text @rest1 .br @rest2 .RS]} {
|
|
sl@0
|
608 |
# yet another nroff kludge as above
|
|
sl@0
|
609 |
man-puts "$para<DT>[long-toc $rest1]"
|
|
sl@0
|
610 |
man-puts "<DT>[long-toc $rest2]<DD>"
|
|
sl@0
|
611 |
incr accept_RE 1
|
|
sl@0
|
612 |
} elseif {[match-text @rest .RE]} {
|
|
sl@0
|
613 |
# gad, this is getting ridiculous
|
|
sl@0
|
614 |
if {!$accept_RE} {
|
|
sl@0
|
615 |
man-puts "</DL><P>$rest<DL>"
|
|
sl@0
|
616 |
backup-text 1
|
|
sl@0
|
617 |
set para {}
|
|
sl@0
|
618 |
break
|
|
sl@0
|
619 |
} else {
|
|
sl@0
|
620 |
man-puts "<P>$rest"
|
|
sl@0
|
621 |
incr accept_RE -1
|
|
sl@0
|
622 |
}
|
|
sl@0
|
623 |
} elseif {$accept_RE} {
|
|
sl@0
|
624 |
output-directive $line
|
|
sl@0
|
625 |
} else {
|
|
sl@0
|
626 |
backup-text 1
|
|
sl@0
|
627 |
break
|
|
sl@0
|
628 |
}
|
|
sl@0
|
629 |
}
|
|
sl@0
|
630 |
.RE {
|
|
sl@0
|
631 |
if {!$accept_RE} {
|
|
sl@0
|
632 |
backup-text 1
|
|
sl@0
|
633 |
break
|
|
sl@0
|
634 |
}
|
|
sl@0
|
635 |
incr accept_RE -1
|
|
sl@0
|
636 |
}
|
|
sl@0
|
637 |
default {
|
|
sl@0
|
638 |
backup-text 1
|
|
sl@0
|
639 |
break
|
|
sl@0
|
640 |
}
|
|
sl@0
|
641 |
}
|
|
sl@0
|
642 |
} else {
|
|
sl@0
|
643 |
man-puts $line
|
|
sl@0
|
644 |
}
|
|
sl@0
|
645 |
set para <P>
|
|
sl@0
|
646 |
}
|
|
sl@0
|
647 |
man-puts "$para</DL>"
|
|
sl@0
|
648 |
lappend manual(section-toc) </DL>
|
|
sl@0
|
649 |
if {$accept_RE} {
|
|
sl@0
|
650 |
manerror "missing .RE in output-IP-list"
|
|
sl@0
|
651 |
}
|
|
sl@0
|
652 |
}
|
|
sl@0
|
653 |
}
|
|
sl@0
|
654 |
##
|
|
sl@0
|
655 |
## handle the NAME section lines
|
|
sl@0
|
656 |
## there's only one line in the NAME section,
|
|
sl@0
|
657 |
## consisting of a comma separated list of names,
|
|
sl@0
|
658 |
## followed by a hyphen and a short description.
|
|
sl@0
|
659 |
##
|
|
sl@0
|
660 |
proc output-name {line} {
|
|
sl@0
|
661 |
global manual
|
|
sl@0
|
662 |
# split name line into pieces
|
|
sl@0
|
663 |
regexp {^([^-]+) - (.*)$} $line all head tail
|
|
sl@0
|
664 |
# output line to manual page untouched
|
|
sl@0
|
665 |
man-puts $line
|
|
sl@0
|
666 |
# output line to long table of contents
|
|
sl@0
|
667 |
lappend manual(section-toc) <DL><DD>$line</DL>
|
|
sl@0
|
668 |
# separate out the names for future reference
|
|
sl@0
|
669 |
foreach name [split $head ,] {
|
|
sl@0
|
670 |
set name [string trim $name]
|
|
sl@0
|
671 |
if {[llength $name] > 1} {
|
|
sl@0
|
672 |
manerror "name has a space: {$name}\nfrom: $line"
|
|
sl@0
|
673 |
}
|
|
sl@0
|
674 |
lappend manual(wing-toc) $name
|
|
sl@0
|
675 |
lappend manual(name-$name) $manual(wing-file)/$manual(name)
|
|
sl@0
|
676 |
}
|
|
sl@0
|
677 |
}
|
|
sl@0
|
678 |
##
|
|
sl@0
|
679 |
## build a cross-reference link if appropriate
|
|
sl@0
|
680 |
##
|
|
sl@0
|
681 |
proc cross-reference {ref} {
|
|
sl@0
|
682 |
global manual
|
|
sl@0
|
683 |
if {[string match Tcl_* $ref]} {
|
|
sl@0
|
684 |
set lref $ref
|
|
sl@0
|
685 |
} elseif {[string match Tk_* $ref]} {
|
|
sl@0
|
686 |
set lref $ref
|
|
sl@0
|
687 |
} elseif {[string equal $ref "Tcl"]} {
|
|
sl@0
|
688 |
set lref $ref
|
|
sl@0
|
689 |
} else {
|
|
sl@0
|
690 |
set lref [string tolower $ref]
|
|
sl@0
|
691 |
}
|
|
sl@0
|
692 |
##
|
|
sl@0
|
693 |
## nothing to reference
|
|
sl@0
|
694 |
##
|
|
sl@0
|
695 |
if {![info exists manual(name-$lref)]} {
|
|
sl@0
|
696 |
foreach name {array file history info interp string trace
|
|
sl@0
|
697 |
after clipboard grab image option pack place selection tk tkwait update winfo wm} {
|
|
sl@0
|
698 |
if {[regexp "^$name \[a-z0-9]*\$" $lref] && \
|
|
sl@0
|
699 |
[info exists manual(name-$name)] && \
|
|
sl@0
|
700 |
[string compare $manual(tail) "$name.n"]} {
|
|
sl@0
|
701 |
return "<A HREF=\"../$manual(name-$name).htm\">$ref</A>"
|
|
sl@0
|
702 |
}
|
|
sl@0
|
703 |
}
|
|
sl@0
|
704 |
if {[lsearch {stdin stdout stderr end} $lref] >= 0} {
|
|
sl@0
|
705 |
# no good place to send these
|
|
sl@0
|
706 |
# tcl tokens?
|
|
sl@0
|
707 |
# also end
|
|
sl@0
|
708 |
}
|
|
sl@0
|
709 |
return $ref
|
|
sl@0
|
710 |
}
|
|
sl@0
|
711 |
##
|
|
sl@0
|
712 |
## would be a self reference
|
|
sl@0
|
713 |
##
|
|
sl@0
|
714 |
foreach name $manual(name-$lref) {
|
|
sl@0
|
715 |
if {[lsearch $name $manual(wing-file)/$manual(name)] >= 0} {
|
|
sl@0
|
716 |
return $ref
|
|
sl@0
|
717 |
}
|
|
sl@0
|
718 |
}
|
|
sl@0
|
719 |
##
|
|
sl@0
|
720 |
## multiple choices for reference
|
|
sl@0
|
721 |
##
|
|
sl@0
|
722 |
if {[llength $manual(name-$lref)] > 1} {
|
|
sl@0
|
723 |
set tcl_i [lsearch -glob $manual(name-$lref) *TclCmd*]
|
|
sl@0
|
724 |
set tcl_ref [lindex $manual(name-$lref) $tcl_i]
|
|
sl@0
|
725 |
set tk_i [lsearch -glob $manual(name-$lref) *TkCmd*]
|
|
sl@0
|
726 |
set tk_ref [lindex $manual(name-$lref) $tk_i]
|
|
sl@0
|
727 |
if {$tcl_i >= 0 && "$manual(wing-file)" == {TclCmd} \
|
|
sl@0
|
728 |
|| "$manual(wing-file)" == {TclLib}} {
|
|
sl@0
|
729 |
return "<A HREF=\"../$tcl_ref.htm\">$ref</A>"
|
|
sl@0
|
730 |
}
|
|
sl@0
|
731 |
if {$tk_i >= 0 && "$manual(wing-file)" == {TkCmd} \
|
|
sl@0
|
732 |
|| "$manual(wing-file)" == {TkLib}} {
|
|
sl@0
|
733 |
return "<A HREF=\"../$tk_ref.htm\">$ref</A>"
|
|
sl@0
|
734 |
}
|
|
sl@0
|
735 |
if {"$lref" == {exit} && "$manual(tail)" == {tclsh.1} && $tcl_i >= 0} {
|
|
sl@0
|
736 |
return "<A HREF=\"../$tcl_ref.htm\">$ref</A>"
|
|
sl@0
|
737 |
}
|
|
sl@0
|
738 |
puts stderr "multiple cross reference to $ref in $manual(name-$lref) from $manual(wing-file)/$manual(tail)"
|
|
sl@0
|
739 |
return $ref
|
|
sl@0
|
740 |
}
|
|
sl@0
|
741 |
##
|
|
sl@0
|
742 |
## exceptions, sigh, to the rule
|
|
sl@0
|
743 |
##
|
|
sl@0
|
744 |
switch $manual(tail) {
|
|
sl@0
|
745 |
canvas.n {
|
|
sl@0
|
746 |
if {$lref == {focus}} {
|
|
sl@0
|
747 |
upvar tail tail
|
|
sl@0
|
748 |
set clue [string first command $tail]
|
|
sl@0
|
749 |
if {$clue < 0 || $clue > 5} {
|
|
sl@0
|
750 |
return $ref
|
|
sl@0
|
751 |
}
|
|
sl@0
|
752 |
}
|
|
sl@0
|
753 |
if {[lsearch {bitmap image text} $lref] >= 0} {
|
|
sl@0
|
754 |
return $ref
|
|
sl@0
|
755 |
}
|
|
sl@0
|
756 |
}
|
|
sl@0
|
757 |
checkbutton.n -
|
|
sl@0
|
758 |
radiobutton.n {
|
|
sl@0
|
759 |
if {[lsearch {image} $lref] >= 0} {
|
|
sl@0
|
760 |
return $ref
|
|
sl@0
|
761 |
}
|
|
sl@0
|
762 |
}
|
|
sl@0
|
763 |
menu.n {
|
|
sl@0
|
764 |
if {[lsearch {checkbutton radiobutton} $lref] >= 0} {
|
|
sl@0
|
765 |
return $ref
|
|
sl@0
|
766 |
}
|
|
sl@0
|
767 |
}
|
|
sl@0
|
768 |
options.n {
|
|
sl@0
|
769 |
if {[lsearch {bitmap image set} $lref] >= 0} {
|
|
sl@0
|
770 |
return $ref
|
|
sl@0
|
771 |
}
|
|
sl@0
|
772 |
}
|
|
sl@0
|
773 |
regexp.n {
|
|
sl@0
|
774 |
if {[lsearch {string} $lref] >= 0} {
|
|
sl@0
|
775 |
return $ref
|
|
sl@0
|
776 |
}
|
|
sl@0
|
777 |
}
|
|
sl@0
|
778 |
source.n {
|
|
sl@0
|
779 |
if {[lsearch {text} $lref] >= 0} {
|
|
sl@0
|
780 |
return $ref
|
|
sl@0
|
781 |
}
|
|
sl@0
|
782 |
}
|
|
sl@0
|
783 |
history.n {
|
|
sl@0
|
784 |
if {[lsearch {exec} $lref] >= 0} {
|
|
sl@0
|
785 |
return $ref
|
|
sl@0
|
786 |
}
|
|
sl@0
|
787 |
}
|
|
sl@0
|
788 |
return.n {
|
|
sl@0
|
789 |
if {[lsearch {error continue break} $lref] >= 0} {
|
|
sl@0
|
790 |
return $ref
|
|
sl@0
|
791 |
}
|
|
sl@0
|
792 |
}
|
|
sl@0
|
793 |
scrollbar.n {
|
|
sl@0
|
794 |
if {[lsearch {set} $lref] >= 0} {
|
|
sl@0
|
795 |
return $ref
|
|
sl@0
|
796 |
}
|
|
sl@0
|
797 |
}
|
|
sl@0
|
798 |
}
|
|
sl@0
|
799 |
##
|
|
sl@0
|
800 |
## return the cross reference
|
|
sl@0
|
801 |
##
|
|
sl@0
|
802 |
return "<A HREF=\"../$manual(name-$lref).htm\">$ref</A>"
|
|
sl@0
|
803 |
}
|
|
sl@0
|
804 |
##
|
|
sl@0
|
805 |
## reference generation errors
|
|
sl@0
|
806 |
##
|
|
sl@0
|
807 |
proc reference-error {msg text} {
|
|
sl@0
|
808 |
global manual
|
|
sl@0
|
809 |
puts stderr "$manual(tail): $msg: {$text}"
|
|
sl@0
|
810 |
return $text
|
|
sl@0
|
811 |
}
|
|
sl@0
|
812 |
##
|
|
sl@0
|
813 |
## insert as many cross references into this text string as are appropriate
|
|
sl@0
|
814 |
##
|
|
sl@0
|
815 |
proc insert-cross-references {text} {
|
|
sl@0
|
816 |
global manual
|
|
sl@0
|
817 |
##
|
|
sl@0
|
818 |
## we identify cross references by:
|
|
sl@0
|
819 |
## ``quotation''
|
|
sl@0
|
820 |
## <B>emboldening</B>
|
|
sl@0
|
821 |
## Tcl_ prefix
|
|
sl@0
|
822 |
## Tk_ prefix
|
|
sl@0
|
823 |
## [a-zA-Z0-9]+ manual entry
|
|
sl@0
|
824 |
## and we avoid messing with already anchored text
|
|
sl@0
|
825 |
##
|
|
sl@0
|
826 |
##
|
|
sl@0
|
827 |
## find where each item lives
|
|
sl@0
|
828 |
##
|
|
sl@0
|
829 |
array set offset [list \
|
|
sl@0
|
830 |
anchor [string first {<A } $text] \
|
|
sl@0
|
831 |
end-anchor [string first {</A>} $text] \
|
|
sl@0
|
832 |
quote [string first {``} $text] \
|
|
sl@0
|
833 |
end-quote [string first {''} $text] \
|
|
sl@0
|
834 |
bold [string first {<B>} $text] \
|
|
sl@0
|
835 |
end-bold [string first {</B>} $text] \
|
|
sl@0
|
836 |
tcl [string first {Tcl_} $text] \
|
|
sl@0
|
837 |
tk [string first {Tk_} $text] \
|
|
sl@0
|
838 |
Tcl1 [string first {Tcl manual entry} $text] \
|
|
sl@0
|
839 |
Tcl2 [string first {Tcl overview manual entry} $text] \
|
|
sl@0
|
840 |
]
|
|
sl@0
|
841 |
##
|
|
sl@0
|
842 |
## accumulate a list
|
|
sl@0
|
843 |
##
|
|
sl@0
|
844 |
foreach name [array names offset] {
|
|
sl@0
|
845 |
if {$offset($name) >= 0} {
|
|
sl@0
|
846 |
set invert($offset($name)) $name
|
|
sl@0
|
847 |
lappend offsets $offset($name)
|
|
sl@0
|
848 |
}
|
|
sl@0
|
849 |
}
|
|
sl@0
|
850 |
##
|
|
sl@0
|
851 |
## if nothing, then we're done.
|
|
sl@0
|
852 |
##
|
|
sl@0
|
853 |
if {![info exists offsets]} {
|
|
sl@0
|
854 |
return $text
|
|
sl@0
|
855 |
}
|
|
sl@0
|
856 |
##
|
|
sl@0
|
857 |
## sort the offsets
|
|
sl@0
|
858 |
##
|
|
sl@0
|
859 |
set offsets [lsort -integer $offsets]
|
|
sl@0
|
860 |
##
|
|
sl@0
|
861 |
## see which we want to use
|
|
sl@0
|
862 |
##
|
|
sl@0
|
863 |
switch -exact $invert([lindex $offsets 0]) {
|
|
sl@0
|
864 |
anchor {
|
|
sl@0
|
865 |
if {$offset(end-anchor) < 0} {
|
|
sl@0
|
866 |
return [reference-error {Missing end anchor} $text]
|
|
sl@0
|
867 |
}
|
|
sl@0
|
868 |
set head [string range $text 0 $offset(end-anchor)]
|
|
sl@0
|
869 |
set tail [string range $text [expr {$offset(end-anchor)+1}] end]
|
|
sl@0
|
870 |
return $head[insert-cross-references $tail]
|
|
sl@0
|
871 |
}
|
|
sl@0
|
872 |
quote {
|
|
sl@0
|
873 |
if {$offset(end-quote) < 0} {
|
|
sl@0
|
874 |
return [reference-error "Missing end quote" $text]
|
|
sl@0
|
875 |
}
|
|
sl@0
|
876 |
if {$invert([lindex $offsets 1]) == "tk"} {
|
|
sl@0
|
877 |
set offsets [lreplace $offsets 1 1]
|
|
sl@0
|
878 |
}
|
|
sl@0
|
879 |
if {$invert([lindex $offsets 1]) == "tcl"} {
|
|
sl@0
|
880 |
set offsets [lreplace $offsets 1 1]
|
|
sl@0
|
881 |
}
|
|
sl@0
|
882 |
switch -exact $invert([lindex $offsets 1]) {
|
|
sl@0
|
883 |
end-quote {
|
|
sl@0
|
884 |
set head [string range $text 0 [expr {$offset(quote)-1}]]
|
|
sl@0
|
885 |
set body [string range $text [expr {$offset(quote)+2}] \
|
|
sl@0
|
886 |
[expr {$offset(end-quote)-1}]]
|
|
sl@0
|
887 |
set tail [string range $text \
|
|
sl@0
|
888 |
[expr {$offset(end-quote)+2}] end]
|
|
sl@0
|
889 |
return "$head``[cross-reference $body]''[insert-cross-references $tail]"
|
|
sl@0
|
890 |
}
|
|
sl@0
|
891 |
bold -
|
|
sl@0
|
892 |
anchor {
|
|
sl@0
|
893 |
set head [string range $text \
|
|
sl@0
|
894 |
0 [expr {$offset(end-quote)+1}]]
|
|
sl@0
|
895 |
set tail [string range $text \
|
|
sl@0
|
896 |
[expr {$offset(end-quote)+2}] end]
|
|
sl@0
|
897 |
return "$head[insert-cross-references $tail]"
|
|
sl@0
|
898 |
}
|
|
sl@0
|
899 |
}
|
|
sl@0
|
900 |
return [reference-error "Uncaught quote case" $text]
|
|
sl@0
|
901 |
}
|
|
sl@0
|
902 |
bold {
|
|
sl@0
|
903 |
if {$offset(end-bold) < 0} { return $text }
|
|
sl@0
|
904 |
if {$invert([lindex $offsets 1]) == "tk"} {
|
|
sl@0
|
905 |
set offsets [lreplace $offsets 1 1]
|
|
sl@0
|
906 |
}
|
|
sl@0
|
907 |
if {$invert([lindex $offsets 1]) == "tcl"} {
|
|
sl@0
|
908 |
set offsets [lreplace $offsets 1 1]
|
|
sl@0
|
909 |
}
|
|
sl@0
|
910 |
switch -exact $invert([lindex $offsets 1]) {
|
|
sl@0
|
911 |
end-bold {
|
|
sl@0
|
912 |
set head [string range $text 0 [expr {$offset(bold)-1}]]
|
|
sl@0
|
913 |
set body [string range $text [expr {$offset(bold)+3}] \
|
|
sl@0
|
914 |
[expr {$offset(end-bold)-1}]]
|
|
sl@0
|
915 |
set tail [string range $text \
|
|
sl@0
|
916 |
[expr {$offset(end-bold)+4}] end]
|
|
sl@0
|
917 |
return "$head<B>[cross-reference $body]</B>[insert-cross-references $tail]"
|
|
sl@0
|
918 |
}
|
|
sl@0
|
919 |
anchor {
|
|
sl@0
|
920 |
set head [string range $text \
|
|
sl@0
|
921 |
0 [expr {$offset(end-bold)+3}]]
|
|
sl@0
|
922 |
set tail [string range $text \
|
|
sl@0
|
923 |
[expr {$offset(end-bold)+4}] end]
|
|
sl@0
|
924 |
return "$head[insert-cross-references $tail]"
|
|
sl@0
|
925 |
}
|
|
sl@0
|
926 |
}
|
|
sl@0
|
927 |
return [reference-error "Uncaught bold case" $text]
|
|
sl@0
|
928 |
}
|
|
sl@0
|
929 |
tk {
|
|
sl@0
|
930 |
set head [string range $text 0 [expr {$offset(tk)-1}]]
|
|
sl@0
|
931 |
set tail [string range $text $offset(tk) end]
|
|
sl@0
|
932 |
if {![regexp {^(Tk_\w+)(.*)$} $tail all body tail]} {
|
|
sl@0
|
933 |
return [reference-error "Tk regexp failed" $text]
|
|
sl@0
|
934 |
}
|
|
sl@0
|
935 |
return $head[cross-reference $body][insert-cross-references $tail]
|
|
sl@0
|
936 |
}
|
|
sl@0
|
937 |
tcl {
|
|
sl@0
|
938 |
set head [string range $text 0 [expr {$offset(tcl)-1}]]
|
|
sl@0
|
939 |
set tail [string range $text $offset(tcl) end]
|
|
sl@0
|
940 |
if {![regexp {^(Tcl_\w+)(.*)$} $tail all body tail]} {
|
|
sl@0
|
941 |
return [reference-error {Tcl regexp failed} $text]
|
|
sl@0
|
942 |
}
|
|
sl@0
|
943 |
return $head[cross-reference $body][insert-cross-references $tail]
|
|
sl@0
|
944 |
}
|
|
sl@0
|
945 |
Tcl1 -
|
|
sl@0
|
946 |
Tcl2 {
|
|
sl@0
|
947 |
set off [lindex $offsets 0]
|
|
sl@0
|
948 |
set head [string range $text 0 [expr {$off-1}]]
|
|
sl@0
|
949 |
set body Tcl
|
|
sl@0
|
950 |
set tail [string range $text [expr {$off+3}] end]
|
|
sl@0
|
951 |
return $head[cross-reference $body][insert-cross-references $tail]
|
|
sl@0
|
952 |
}
|
|
sl@0
|
953 |
end-anchor -
|
|
sl@0
|
954 |
end-bold -
|
|
sl@0
|
955 |
end-quote {
|
|
sl@0
|
956 |
return [reference-error "Out of place $invert([lindex $offsets 0])" $text]
|
|
sl@0
|
957 |
}
|
|
sl@0
|
958 |
}
|
|
sl@0
|
959 |
}
|
|
sl@0
|
960 |
##
|
|
sl@0
|
961 |
## process formatting directives
|
|
sl@0
|
962 |
##
|
|
sl@0
|
963 |
proc output-directive {line} {
|
|
sl@0
|
964 |
global manual
|
|
sl@0
|
965 |
# process format directive
|
|
sl@0
|
966 |
split-directive $line code rest
|
|
sl@0
|
967 |
switch -exact $code {
|
|
sl@0
|
968 |
.BS -
|
|
sl@0
|
969 |
.BE {
|
|
sl@0
|
970 |
# man-puts <HR>
|
|
sl@0
|
971 |
}
|
|
sl@0
|
972 |
.SH - .SS {
|
|
sl@0
|
973 |
# drain any open lists
|
|
sl@0
|
974 |
# announce the subject
|
|
sl@0
|
975 |
set manual(section) $rest
|
|
sl@0
|
976 |
# start our own stack of stuff
|
|
sl@0
|
977 |
set manual($manual(name)-$manual(section)) {}
|
|
sl@0
|
978 |
lappend manual(has-$manual(section)) $manual(name)
|
|
sl@0
|
979 |
if {[string compare .SS $code]} {
|
|
sl@0
|
980 |
man-puts "<H3>[long-toc $manual(section)]</H3>"
|
|
sl@0
|
981 |
} else {
|
|
sl@0
|
982 |
man-puts "<H4>[long-toc $manual(section)]</H4>"
|
|
sl@0
|
983 |
}
|
|
sl@0
|
984 |
# some sections can simply free wheel their way through the text
|
|
sl@0
|
985 |
# some sections can be processed in their own loops
|
|
sl@0
|
986 |
switch -exact $manual(section) {
|
|
sl@0
|
987 |
NAME {
|
|
sl@0
|
988 |
if {[lsearch {CrtImgType.3 CrtItemType.3 CrtPhImgFmt.3} $manual(tail)] >= 0} {
|
|
sl@0
|
989 |
# these manual pages have two NAME sections
|
|
sl@0
|
990 |
if {[info exists manual($manual(tail)-NAME)]} {
|
|
sl@0
|
991 |
return
|
|
sl@0
|
992 |
}
|
|
sl@0
|
993 |
set manual($manual(tail)-NAME) 1
|
|
sl@0
|
994 |
}
|
|
sl@0
|
995 |
set names {}
|
|
sl@0
|
996 |
while {1} {
|
|
sl@0
|
997 |
set line [next-text]
|
|
sl@0
|
998 |
if {[is-a-directive $line]} {
|
|
sl@0
|
999 |
backup-text 1
|
|
sl@0
|
1000 |
output-name [join $names { }]
|
|
sl@0
|
1001 |
return
|
|
sl@0
|
1002 |
} else {
|
|
sl@0
|
1003 |
lappend names [string trim $line]
|
|
sl@0
|
1004 |
}
|
|
sl@0
|
1005 |
}
|
|
sl@0
|
1006 |
}
|
|
sl@0
|
1007 |
SYNOPSIS {
|
|
sl@0
|
1008 |
lappend manual(section-toc) <DL>
|
|
sl@0
|
1009 |
while {1} {
|
|
sl@0
|
1010 |
if {[next-op-is .nf rest]
|
|
sl@0
|
1011 |
|| [next-op-is .br rest]
|
|
sl@0
|
1012 |
|| [next-op-is .fi rest]} {
|
|
sl@0
|
1013 |
continue
|
|
sl@0
|
1014 |
}
|
|
sl@0
|
1015 |
if {[next-op-is .SH rest]
|
|
sl@0
|
1016 |
|| [next-op-is .SS rest]
|
|
sl@0
|
1017 |
|| [next-op-is .BE rest]
|
|
sl@0
|
1018 |
|| [next-op-is .SO rest]} {
|
|
sl@0
|
1019 |
backup-text 1
|
|
sl@0
|
1020 |
break
|
|
sl@0
|
1021 |
}
|
|
sl@0
|
1022 |
if {[next-op-is .sp rest]} {
|
|
sl@0
|
1023 |
#man-puts <P>
|
|
sl@0
|
1024 |
continue
|
|
sl@0
|
1025 |
}
|
|
sl@0
|
1026 |
set more [next-text]
|
|
sl@0
|
1027 |
if {[is-a-directive $more]} {
|
|
sl@0
|
1028 |
manerror "in SYNOPSIS found $more"
|
|
sl@0
|
1029 |
backup-text 1
|
|
sl@0
|
1030 |
break
|
|
sl@0
|
1031 |
} else {
|
|
sl@0
|
1032 |
foreach more [split $more \n] {
|
|
sl@0
|
1033 |
man-puts $more<BR>
|
|
sl@0
|
1034 |
if {[lsearch {TclLib TkLib} $manual(wing-file)] < 0} {
|
|
sl@0
|
1035 |
lappend manual(section-toc) <DD>$more
|
|
sl@0
|
1036 |
}
|
|
sl@0
|
1037 |
}
|
|
sl@0
|
1038 |
}
|
|
sl@0
|
1039 |
}
|
|
sl@0
|
1040 |
lappend manual(section-toc) </DL>
|
|
sl@0
|
1041 |
return
|
|
sl@0
|
1042 |
}
|
|
sl@0
|
1043 |
{SEE ALSO} {
|
|
sl@0
|
1044 |
while {[more-text]} {
|
|
sl@0
|
1045 |
if {[next-op-is .SH rest] || [next-op-is .SS rest]} {
|
|
sl@0
|
1046 |
backup-text 1
|
|
sl@0
|
1047 |
return
|
|
sl@0
|
1048 |
}
|
|
sl@0
|
1049 |
set more [next-text]
|
|
sl@0
|
1050 |
if {[is-a-directive $more]} {
|
|
sl@0
|
1051 |
manerror "$more"
|
|
sl@0
|
1052 |
backup-text 1
|
|
sl@0
|
1053 |
return
|
|
sl@0
|
1054 |
}
|
|
sl@0
|
1055 |
set nmore {}
|
|
sl@0
|
1056 |
foreach cr [split $more ,] {
|
|
sl@0
|
1057 |
set cr [string trim $cr]
|
|
sl@0
|
1058 |
if {![regexp {^<B>.*</B>$} $cr]} {
|
|
sl@0
|
1059 |
set cr <B>$cr</B>
|
|
sl@0
|
1060 |
}
|
|
sl@0
|
1061 |
if {[regexp {^<B>(.*)\([13n]\)</B>$} $cr all name]} {
|
|
sl@0
|
1062 |
set cr <B>$name</B>
|
|
sl@0
|
1063 |
}
|
|
sl@0
|
1064 |
lappend nmore $cr
|
|
sl@0
|
1065 |
}
|
|
sl@0
|
1066 |
man-puts [join $nmore {, }]
|
|
sl@0
|
1067 |
}
|
|
sl@0
|
1068 |
return
|
|
sl@0
|
1069 |
}
|
|
sl@0
|
1070 |
KEYWORDS {
|
|
sl@0
|
1071 |
while {[more-text]} {
|
|
sl@0
|
1072 |
if {[next-op-is .SH rest] || [next-op-is .SS rest]} {
|
|
sl@0
|
1073 |
backup-text 1
|
|
sl@0
|
1074 |
return
|
|
sl@0
|
1075 |
}
|
|
sl@0
|
1076 |
set more [next-text]
|
|
sl@0
|
1077 |
if {[is-a-directive $more]} {
|
|
sl@0
|
1078 |
manerror "$more"
|
|
sl@0
|
1079 |
backup-text 1
|
|
sl@0
|
1080 |
return
|
|
sl@0
|
1081 |
}
|
|
sl@0
|
1082 |
set keys {}
|
|
sl@0
|
1083 |
foreach key [split $more ,] {
|
|
sl@0
|
1084 |
set key [string trim $key]
|
|
sl@0
|
1085 |
lappend manual(keyword-$key) [list $manual(name) $manual(wing-file)/$manual(name).htm]
|
|
sl@0
|
1086 |
set initial [string toupper [string index $key 0]]
|
|
sl@0
|
1087 |
lappend keys "<A href=\"../Keywords/$initial.htm\#$key\">$key</A>"
|
|
sl@0
|
1088 |
}
|
|
sl@0
|
1089 |
man-puts [join $keys {, }]
|
|
sl@0
|
1090 |
}
|
|
sl@0
|
1091 |
return
|
|
sl@0
|
1092 |
}
|
|
sl@0
|
1093 |
}
|
|
sl@0
|
1094 |
if {[next-op-is .IP rest]} {
|
|
sl@0
|
1095 |
output-IP-list $code .IP $rest
|
|
sl@0
|
1096 |
return
|
|
sl@0
|
1097 |
}
|
|
sl@0
|
1098 |
if {[next-op-is .PP rest]} {
|
|
sl@0
|
1099 |
return
|
|
sl@0
|
1100 |
}
|
|
sl@0
|
1101 |
return
|
|
sl@0
|
1102 |
}
|
|
sl@0
|
1103 |
.SO {
|
|
sl@0
|
1104 |
if {[match-text @stuff .SE]} {
|
|
sl@0
|
1105 |
output-directive {.SH STANDARD OPTIONS}
|
|
sl@0
|
1106 |
set opts {}
|
|
sl@0
|
1107 |
foreach line [split $stuff \n] {
|
|
sl@0
|
1108 |
foreach option [split $line \t] {
|
|
sl@0
|
1109 |
lappend opts $option
|
|
sl@0
|
1110 |
}
|
|
sl@0
|
1111 |
}
|
|
sl@0
|
1112 |
man-puts <DL>
|
|
sl@0
|
1113 |
lappend manual(section-toc) <DL>
|
|
sl@0
|
1114 |
foreach option [lsort $opts] {
|
|
sl@0
|
1115 |
man-puts "<DT><B>[std-option-toc $option]</B>"
|
|
sl@0
|
1116 |
}
|
|
sl@0
|
1117 |
man-puts </DL>
|
|
sl@0
|
1118 |
lappend manual(section-toc) </DL>
|
|
sl@0
|
1119 |
} else {
|
|
sl@0
|
1120 |
manerror "unexpected .SO format:\n[expand-next-text 2]"
|
|
sl@0
|
1121 |
}
|
|
sl@0
|
1122 |
}
|
|
sl@0
|
1123 |
.OP {
|
|
sl@0
|
1124 |
output-widget-options $rest
|
|
sl@0
|
1125 |
return
|
|
sl@0
|
1126 |
}
|
|
sl@0
|
1127 |
.IP {
|
|
sl@0
|
1128 |
output-IP-list .IP .IP $rest
|
|
sl@0
|
1129 |
return
|
|
sl@0
|
1130 |
}
|
|
sl@0
|
1131 |
.PP {
|
|
sl@0
|
1132 |
man-puts <P>
|
|
sl@0
|
1133 |
}
|
|
sl@0
|
1134 |
.RS {
|
|
sl@0
|
1135 |
output-RS-list
|
|
sl@0
|
1136 |
return
|
|
sl@0
|
1137 |
}
|
|
sl@0
|
1138 |
.RE {
|
|
sl@0
|
1139 |
manerror "unexpected .RE"
|
|
sl@0
|
1140 |
return
|
|
sl@0
|
1141 |
}
|
|
sl@0
|
1142 |
.br {
|
|
sl@0
|
1143 |
man-puts <BR>
|
|
sl@0
|
1144 |
return
|
|
sl@0
|
1145 |
}
|
|
sl@0
|
1146 |
.DE {
|
|
sl@0
|
1147 |
manerror "unexpected .DE"
|
|
sl@0
|
1148 |
return
|
|
sl@0
|
1149 |
}
|
|
sl@0
|
1150 |
.DS {
|
|
sl@0
|
1151 |
if {[next-op-is .ta rest]} {
|
|
sl@0
|
1152 |
|
|
sl@0
|
1153 |
}
|
|
sl@0
|
1154 |
if {[match-text @stuff .DE]} {
|
|
sl@0
|
1155 |
man-puts <PRE>$stuff</PRE>
|
|
sl@0
|
1156 |
} elseif {[match-text .fi @ul1 @ul2 .nf @stuff .DE]} {
|
|
sl@0
|
1157 |
man-puts "<PRE>[lindex $ul1 1][lindex $ul2 1]\n$stuff</PRE>"
|
|
sl@0
|
1158 |
} else {
|
|
sl@0
|
1159 |
manerror "unexpected .DS format:\n[expand-next-text 2]"
|
|
sl@0
|
1160 |
}
|
|
sl@0
|
1161 |
return
|
|
sl@0
|
1162 |
}
|
|
sl@0
|
1163 |
.CS {
|
|
sl@0
|
1164 |
if {[next-op-is .ta rest]} {
|
|
sl@0
|
1165 |
|
|
sl@0
|
1166 |
}
|
|
sl@0
|
1167 |
if {[match-text @stuff .CE]} {
|
|
sl@0
|
1168 |
man-puts <PRE>$stuff</PRE>
|
|
sl@0
|
1169 |
} else {
|
|
sl@0
|
1170 |
manerror "unexpected .CS format:\n[expand-next-text 2]"
|
|
sl@0
|
1171 |
}
|
|
sl@0
|
1172 |
return
|
|
sl@0
|
1173 |
}
|
|
sl@0
|
1174 |
.CE {
|
|
sl@0
|
1175 |
manerror "unexpected .CE"
|
|
sl@0
|
1176 |
return
|
|
sl@0
|
1177 |
}
|
|
sl@0
|
1178 |
.sp {
|
|
sl@0
|
1179 |
man-puts <P>
|
|
sl@0
|
1180 |
}
|
|
sl@0
|
1181 |
.ta {
|
|
sl@0
|
1182 |
# these are tab stop settings for short tables
|
|
sl@0
|
1183 |
switch -exact $manual(name):$manual(section) {
|
|
sl@0
|
1184 |
{bind:MODIFIERS} -
|
|
sl@0
|
1185 |
{bind:EVENT TYPES} -
|
|
sl@0
|
1186 |
{bind:BINDING SCRIPTS AND SUBSTITUTIONS} -
|
|
sl@0
|
1187 |
{expr:OPERANDS} -
|
|
sl@0
|
1188 |
{expr:MATH FUNCTIONS} -
|
|
sl@0
|
1189 |
{history:DESCRIPTION} -
|
|
sl@0
|
1190 |
{history:HISTORY REVISION} -
|
|
sl@0
|
1191 |
{re_syntax:BRACKET EXPRESSIONS} -
|
|
sl@0
|
1192 |
{switch:DESCRIPTION} -
|
|
sl@0
|
1193 |
{upvar:DESCRIPTION} {
|
|
sl@0
|
1194 |
return; # fix.me
|
|
sl@0
|
1195 |
}
|
|
sl@0
|
1196 |
default {
|
|
sl@0
|
1197 |
manerror "ignoring $line"
|
|
sl@0
|
1198 |
}
|
|
sl@0
|
1199 |
}
|
|
sl@0
|
1200 |
}
|
|
sl@0
|
1201 |
.nf {
|
|
sl@0
|
1202 |
if {[match-text @more .fi]} {
|
|
sl@0
|
1203 |
foreach more [split $more \n] {
|
|
sl@0
|
1204 |
man-puts $more<BR>
|
|
sl@0
|
1205 |
}
|
|
sl@0
|
1206 |
} elseif {[match-text .RS @more .RE .fi]} {
|
|
sl@0
|
1207 |
man-puts <DL><DD>
|
|
sl@0
|
1208 |
foreach more [split $more \n] {
|
|
sl@0
|
1209 |
man-puts $more<BR>
|
|
sl@0
|
1210 |
}
|
|
sl@0
|
1211 |
man-puts </DL>
|
|
sl@0
|
1212 |
} elseif {[match-text .RS @more .RS @more2 .RE .RE .fi]} {
|
|
sl@0
|
1213 |
man-puts <DL><DD>
|
|
sl@0
|
1214 |
foreach more [split $more \n] {
|
|
sl@0
|
1215 |
man-puts $more<BR>
|
|
sl@0
|
1216 |
}
|
|
sl@0
|
1217 |
man-puts <DL><DD>
|
|
sl@0
|
1218 |
foreach more2 [split $more2 \n] {
|
|
sl@0
|
1219 |
man-puts $more2<BR>
|
|
sl@0
|
1220 |
}
|
|
sl@0
|
1221 |
man-puts </DL></DL>
|
|
sl@0
|
1222 |
} elseif {[match-text .RS @more .RS @more2 .RE @more3 .RE .fi]} {
|
|
sl@0
|
1223 |
man-puts <DL><DD>
|
|
sl@0
|
1224 |
foreach more [split $more \n] {
|
|
sl@0
|
1225 |
man-puts $more<BR>
|
|
sl@0
|
1226 |
}
|
|
sl@0
|
1227 |
man-puts <DL><DD>
|
|
sl@0
|
1228 |
foreach more2 [split $more2 \n] {
|
|
sl@0
|
1229 |
man-puts $more2<BR>
|
|
sl@0
|
1230 |
}
|
|
sl@0
|
1231 |
man-puts </DL><DD>
|
|
sl@0
|
1232 |
foreach more3 [split $more3 \n] {
|
|
sl@0
|
1233 |
man-puts $more3<BR>
|
|
sl@0
|
1234 |
}
|
|
sl@0
|
1235 |
man-puts </DL>
|
|
sl@0
|
1236 |
} elseif {[match-text .sp .RS @more .RS @more2 .sp .RE .RE .fi]} {
|
|
sl@0
|
1237 |
man-puts <P><DL><DD>
|
|
sl@0
|
1238 |
foreach more [split $more \n] {
|
|
sl@0
|
1239 |
man-puts $more<BR>
|
|
sl@0
|
1240 |
}
|
|
sl@0
|
1241 |
man-puts <DL><DD>
|
|
sl@0
|
1242 |
foreach more2 [split $more2 \n] {
|
|
sl@0
|
1243 |
man-puts $more2<BR>
|
|
sl@0
|
1244 |
}
|
|
sl@0
|
1245 |
man-puts </DL></DL><P>
|
|
sl@0
|
1246 |
} elseif {[match-text .RS .sp @more .sp .RE .fi]} {
|
|
sl@0
|
1247 |
man-puts <P><DL><DD>
|
|
sl@0
|
1248 |
foreach more [split $more \n] {
|
|
sl@0
|
1249 |
man-puts $more<BR>
|
|
sl@0
|
1250 |
}
|
|
sl@0
|
1251 |
man-puts </DL><P>
|
|
sl@0
|
1252 |
} else {
|
|
sl@0
|
1253 |
manerror "ignoring $line"
|
|
sl@0
|
1254 |
}
|
|
sl@0
|
1255 |
}
|
|
sl@0
|
1256 |
.fi {
|
|
sl@0
|
1257 |
manerror "ignoring $line"
|
|
sl@0
|
1258 |
}
|
|
sl@0
|
1259 |
.na -
|
|
sl@0
|
1260 |
.ad -
|
|
sl@0
|
1261 |
.UL -
|
|
sl@0
|
1262 |
.ne {
|
|
sl@0
|
1263 |
manerror "ignoring $line"
|
|
sl@0
|
1264 |
}
|
|
sl@0
|
1265 |
default {
|
|
sl@0
|
1266 |
manerror "unrecognized format directive: $line"
|
|
sl@0
|
1267 |
}
|
|
sl@0
|
1268 |
}
|
|
sl@0
|
1269 |
}
|
|
sl@0
|
1270 |
##
|
|
sl@0
|
1271 |
## merge copyright listings
|
|
sl@0
|
1272 |
##
|
|
sl@0
|
1273 |
proc merge-copyrights {l1 l2} {
|
|
sl@0
|
1274 |
foreach copyright [concat $l1 $l2] {
|
|
sl@0
|
1275 |
if {[regexp {^Copyright +\(c\) +(\d+) +(by +)?(\w.*)$} $copyright all date by who]} {
|
|
sl@0
|
1276 |
lappend dates($who) $date
|
|
sl@0
|
1277 |
continue
|
|
sl@0
|
1278 |
}
|
|
sl@0
|
1279 |
if {[regexp {^Copyright +\(c\) +(\d+)-(\d+) +(by +)?(\w.*)$} $copyright all from to by who]} {
|
|
sl@0
|
1280 |
for {set date $from} {$date <= $to} {incr date} {
|
|
sl@0
|
1281 |
lappend dates($who) $date
|
|
sl@0
|
1282 |
}
|
|
sl@0
|
1283 |
continue
|
|
sl@0
|
1284 |
}
|
|
sl@0
|
1285 |
if {[regexp {^Copyright +\(c\) +(\d+), *(\d+) +(by +)?(\w.*)$} $copyright all date1 date2 by who]} {
|
|
sl@0
|
1286 |
lappend dates($who) $date1 $date2
|
|
sl@0
|
1287 |
continue
|
|
sl@0
|
1288 |
}
|
|
sl@0
|
1289 |
puts "oops: $copyright"
|
|
sl@0
|
1290 |
}
|
|
sl@0
|
1291 |
foreach who [array names dates] {
|
|
sl@0
|
1292 |
set list [lsort $dates($who)]
|
|
sl@0
|
1293 |
if {[llength $list] == 1 || [lindex $list 0] == [lrange $list end end]} {
|
|
sl@0
|
1294 |
lappend merge "Copyright (c) [lindex $list 0] $who"
|
|
sl@0
|
1295 |
} else {
|
|
sl@0
|
1296 |
lappend merge "Copyright (c) [lindex $list 0]-[lrange $list end end] $who"
|
|
sl@0
|
1297 |
}
|
|
sl@0
|
1298 |
}
|
|
sl@0
|
1299 |
return [lsort $merge]
|
|
sl@0
|
1300 |
}
|
|
sl@0
|
1301 |
|
|
sl@0
|
1302 |
proc makedirhier {dir} {
|
|
sl@0
|
1303 |
if {![file isdirectory $dir] && \
|
|
sl@0
|
1304 |
[catch {file mkdir $dir} error]} {
|
|
sl@0
|
1305 |
return -code error "cannot create directory $dir: $error"
|
|
sl@0
|
1306 |
}
|
|
sl@0
|
1307 |
}
|
|
sl@0
|
1308 |
|
|
sl@0
|
1309 |
##
|
|
sl@0
|
1310 |
## foreach of the man directories specified by args
|
|
sl@0
|
1311 |
## convert manpages into hypertext in the directory
|
|
sl@0
|
1312 |
## specified by html.
|
|
sl@0
|
1313 |
##
|
|
sl@0
|
1314 |
proc make-man-pages {html args} {
|
|
sl@0
|
1315 |
global env manual overall_title tcltkdesc
|
|
sl@0
|
1316 |
makedirhier $html
|
|
sl@0
|
1317 |
set manual(short-toc-n) 1
|
|
sl@0
|
1318 |
set manual(short-toc-fp) [open $html/contents.htm w]
|
|
sl@0
|
1319 |
puts $manual(short-toc-fp) "<HTML><HEAD><TITLE>$overall_title</TITLE></HEAD>"
|
|
sl@0
|
1320 |
puts $manual(short-toc-fp) "<BODY><HR><H3>$overall_title</H3><HR><DL>"
|
|
sl@0
|
1321 |
set manual(merge-copyrights) {}
|
|
sl@0
|
1322 |
foreach arg $args {
|
|
sl@0
|
1323 |
if {$arg == ""} {continue}
|
|
sl@0
|
1324 |
set manual(wing-glob) [lindex $arg 0]
|
|
sl@0
|
1325 |
set manual(wing-name) [lindex $arg 1]
|
|
sl@0
|
1326 |
set manual(wing-file) [lindex $arg 2]
|
|
sl@0
|
1327 |
set manual(wing-description) [lindex $arg 3]
|
|
sl@0
|
1328 |
set manual(wing-copyrights) {}
|
|
sl@0
|
1329 |
makedirhier $html/$manual(wing-file)
|
|
sl@0
|
1330 |
set manual(wing-toc-fp) [open $html/$manual(wing-file)/contents.htm w]
|
|
sl@0
|
1331 |
# whistle
|
|
sl@0
|
1332 |
puts stderr "scanning section $manual(wing-name)"
|
|
sl@0
|
1333 |
# put the entry for this section into the short table of contents
|
|
sl@0
|
1334 |
puts $manual(short-toc-fp) "<DT><A HREF=\"$manual(wing-file)/contents.htm\">$manual(wing-name)</A><DD>$manual(wing-description)"
|
|
sl@0
|
1335 |
# initialize the wing table of contents
|
|
sl@0
|
1336 |
puts $manual(wing-toc-fp) "<HTML><HEAD><TITLE>$manual(wing-name) Manual</TITLE></HEAD>"
|
|
sl@0
|
1337 |
puts $manual(wing-toc-fp) "<BODY><HR><H3>$manual(wing-name)</H3><HR>"
|
|
sl@0
|
1338 |
# initialize the short table of contents for this section
|
|
sl@0
|
1339 |
set manual(wing-toc) {}
|
|
sl@0
|
1340 |
# initialize the man directory for this section
|
|
sl@0
|
1341 |
makedirhier $html/$manual(wing-file)
|
|
sl@0
|
1342 |
# initialize the long table of contents for this section
|
|
sl@0
|
1343 |
set manual(long-toc-n) 1
|
|
sl@0
|
1344 |
# get the manual pages for this section
|
|
sl@0
|
1345 |
set manual(pages) [lsort [glob $manual(wing-glob)]]
|
|
sl@0
|
1346 |
if {[lsearch -glob $manual(pages) */options.n] >= 0} {
|
|
sl@0
|
1347 |
set n [lsearch $manual(pages) */options.n]
|
|
sl@0
|
1348 |
set manual(pages) "[lindex $manual(pages) $n] [lreplace $manual(pages) $n $n]"
|
|
sl@0
|
1349 |
}
|
|
sl@0
|
1350 |
# set manual(pages) [lrange $manual(pages) 0 5]
|
|
sl@0
|
1351 |
foreach manual(page) $manual(pages) {
|
|
sl@0
|
1352 |
# whistle
|
|
sl@0
|
1353 |
puts stderr "scanning page $manual(page)"
|
|
sl@0
|
1354 |
set manual(tail) [file tail $manual(page)]
|
|
sl@0
|
1355 |
set manual(name) [file root $manual(tail)]
|
|
sl@0
|
1356 |
set manual(section) {}
|
|
sl@0
|
1357 |
if {[lsearch {case pack-old menubar} $manual(name)] >= 0} {
|
|
sl@0
|
1358 |
# obsolete
|
|
sl@0
|
1359 |
manerror "discarding $manual(name)"
|
|
sl@0
|
1360 |
continue
|
|
sl@0
|
1361 |
}
|
|
sl@0
|
1362 |
set manual(infp) [open $manual(page)]
|
|
sl@0
|
1363 |
set manual(text) {}
|
|
sl@0
|
1364 |
set manual(partial-text) {}
|
|
sl@0
|
1365 |
foreach p {.RS .DS .CS .SO} {
|
|
sl@0
|
1366 |
set manual($p) 0
|
|
sl@0
|
1367 |
}
|
|
sl@0
|
1368 |
set manual(stack) {}
|
|
sl@0
|
1369 |
set manual(section) {}
|
|
sl@0
|
1370 |
set manual(section-toc) {}
|
|
sl@0
|
1371 |
set manual(section-toc-n) 1
|
|
sl@0
|
1372 |
set manual(copyrights) {}
|
|
sl@0
|
1373 |
lappend manual(all-pages) $manual(wing-file)/$manual(tail)
|
|
sl@0
|
1374 |
manreport 100 $manual(name)
|
|
sl@0
|
1375 |
while {[gets $manual(infp) line] >= 0} {
|
|
sl@0
|
1376 |
manreport 100 $line
|
|
sl@0
|
1377 |
if {[regexp {^[`'][/\\]} $line]} {
|
|
sl@0
|
1378 |
if {[regexp {Copyright \(c\).*$} $line copyright]} {
|
|
sl@0
|
1379 |
lappend manual(copyrights) $copyright
|
|
sl@0
|
1380 |
}
|
|
sl@0
|
1381 |
# comment
|
|
sl@0
|
1382 |
continue
|
|
sl@0
|
1383 |
}
|
|
sl@0
|
1384 |
if {"$line" == {'}} {
|
|
sl@0
|
1385 |
# comment
|
|
sl@0
|
1386 |
continue
|
|
sl@0
|
1387 |
}
|
|
sl@0
|
1388 |
if {[parse-directive $line code rest]} {
|
|
sl@0
|
1389 |
switch -exact $code {
|
|
sl@0
|
1390 |
.ad - .na - .so - .ne - .AS - .VE - .VS -
|
|
sl@0
|
1391 |
. {
|
|
sl@0
|
1392 |
# ignore
|
|
sl@0
|
1393 |
continue
|
|
sl@0
|
1394 |
}
|
|
sl@0
|
1395 |
}
|
|
sl@0
|
1396 |
if {"$manual(partial-text)" != {}} {
|
|
sl@0
|
1397 |
lappend manual(text) [process-text $manual(partial-text)]
|
|
sl@0
|
1398 |
set manual(partial-text) {}
|
|
sl@0
|
1399 |
}
|
|
sl@0
|
1400 |
switch -exact $code {
|
|
sl@0
|
1401 |
.SH - .SS {
|
|
sl@0
|
1402 |
if {[llength $rest] == 0} {
|
|
sl@0
|
1403 |
gets $manual(infp) rest
|
|
sl@0
|
1404 |
}
|
|
sl@0
|
1405 |
lappend manual(text) "$code [unquote $rest]"
|
|
sl@0
|
1406 |
}
|
|
sl@0
|
1407 |
.TH {
|
|
sl@0
|
1408 |
lappend manual(text) "$code [unquote $rest]"
|
|
sl@0
|
1409 |
}
|
|
sl@0
|
1410 |
.HS - .UL -
|
|
sl@0
|
1411 |
.ta {
|
|
sl@0
|
1412 |
lappend manual(text) "$code [unquote $rest]"
|
|
sl@0
|
1413 |
}
|
|
sl@0
|
1414 |
.BS - .BE - .br - .fi - .sp -
|
|
sl@0
|
1415 |
.nf {
|
|
sl@0
|
1416 |
if {"$rest" != {}} {
|
|
sl@0
|
1417 |
manerror "unexpected argument: $line"
|
|
sl@0
|
1418 |
}
|
|
sl@0
|
1419 |
lappend manual(text) $code
|
|
sl@0
|
1420 |
}
|
|
sl@0
|
1421 |
.AP {
|
|
sl@0
|
1422 |
lappend manual(text) [concat .IP [process-text "[lindex $rest 0] \\fB[lindex $rest 1]\\fR ([lindex $rest 2])"]]
|
|
sl@0
|
1423 |
}
|
|
sl@0
|
1424 |
.IP {
|
|
sl@0
|
1425 |
regexp {^(.*) +\d+$} $rest all rest
|
|
sl@0
|
1426 |
lappend manual(text) ".IP [process-text [unquote [string trim $rest]]]"
|
|
sl@0
|
1427 |
}
|
|
sl@0
|
1428 |
.TP {
|
|
sl@0
|
1429 |
while {[is-a-directive [set next [gets $manual(infp)]]]} {
|
|
sl@0
|
1430 |
manerror "ignoring $next after .TP"
|
|
sl@0
|
1431 |
}
|
|
sl@0
|
1432 |
if {"$next" != {'}} {
|
|
sl@0
|
1433 |
lappend manual(text) ".IP [process-text $next]"
|
|
sl@0
|
1434 |
}
|
|
sl@0
|
1435 |
}
|
|
sl@0
|
1436 |
.OP {
|
|
sl@0
|
1437 |
lappend manual(text) [concat .OP [process-text \
|
|
sl@0
|
1438 |
"\\fB[lindex $rest 0]\\fR \\fB[lindex $rest 1]\\fR \\fB[lindex $rest 2]\\fR"]]
|
|
sl@0
|
1439 |
}
|
|
sl@0
|
1440 |
.PP -
|
|
sl@0
|
1441 |
.LP {
|
|
sl@0
|
1442 |
lappend manual(text) {.PP}
|
|
sl@0
|
1443 |
}
|
|
sl@0
|
1444 |
.RS {
|
|
sl@0
|
1445 |
incr manual(.RS)
|
|
sl@0
|
1446 |
lappend manual(text) $code
|
|
sl@0
|
1447 |
}
|
|
sl@0
|
1448 |
.RE {
|
|
sl@0
|
1449 |
incr manual(.RS) -1
|
|
sl@0
|
1450 |
lappend manual(text) $code
|
|
sl@0
|
1451 |
}
|
|
sl@0
|
1452 |
.SO {
|
|
sl@0
|
1453 |
incr manual(.SO)
|
|
sl@0
|
1454 |
lappend manual(text) $code
|
|
sl@0
|
1455 |
}
|
|
sl@0
|
1456 |
.SE {
|
|
sl@0
|
1457 |
incr manual(.SO) -1
|
|
sl@0
|
1458 |
lappend manual(text) $code
|
|
sl@0
|
1459 |
}
|
|
sl@0
|
1460 |
.DS {
|
|
sl@0
|
1461 |
incr manual(.DS)
|
|
sl@0
|
1462 |
lappend manual(text) $code
|
|
sl@0
|
1463 |
}
|
|
sl@0
|
1464 |
.DE {
|
|
sl@0
|
1465 |
incr manual(.DS) -1
|
|
sl@0
|
1466 |
lappend manual(text) $code
|
|
sl@0
|
1467 |
}
|
|
sl@0
|
1468 |
.CS {
|
|
sl@0
|
1469 |
incr manual(.CS)
|
|
sl@0
|
1470 |
lappend manual(text) $code
|
|
sl@0
|
1471 |
}
|
|
sl@0
|
1472 |
.CE {
|
|
sl@0
|
1473 |
incr manual(.CS) -1
|
|
sl@0
|
1474 |
lappend manual(text) $code
|
|
sl@0
|
1475 |
}
|
|
sl@0
|
1476 |
.de {
|
|
sl@0
|
1477 |
while {[gets $manual(infp) line] >= 0} {
|
|
sl@0
|
1478 |
if {[string match "..*" $line]} {
|
|
sl@0
|
1479 |
break
|
|
sl@0
|
1480 |
}
|
|
sl@0
|
1481 |
}
|
|
sl@0
|
1482 |
}
|
|
sl@0
|
1483 |
.. {
|
|
sl@0
|
1484 |
error "found .. outside of .de"
|
|
sl@0
|
1485 |
}
|
|
sl@0
|
1486 |
default {
|
|
sl@0
|
1487 |
manerror "unrecognized format directive: $line"
|
|
sl@0
|
1488 |
}
|
|
sl@0
|
1489 |
}
|
|
sl@0
|
1490 |
} else {
|
|
sl@0
|
1491 |
if {$manual(partial-text) == ""} {
|
|
sl@0
|
1492 |
set manual(partial-text) $line
|
|
sl@0
|
1493 |
} else {
|
|
sl@0
|
1494 |
append manual(partial-text) \n$line
|
|
sl@0
|
1495 |
}
|
|
sl@0
|
1496 |
}
|
|
sl@0
|
1497 |
}
|
|
sl@0
|
1498 |
if {$manual(partial-text) != ""} {
|
|
sl@0
|
1499 |
lappend manual(text) [process-text $manual(partial-text)]
|
|
sl@0
|
1500 |
}
|
|
sl@0
|
1501 |
close $manual(infp)
|
|
sl@0
|
1502 |
# fixups
|
|
sl@0
|
1503 |
if {$manual(.RS) != 0} {
|
|
sl@0
|
1504 |
if {$manual(name) != "selection"} {
|
|
sl@0
|
1505 |
puts "unbalanced .RS .RE"
|
|
sl@0
|
1506 |
}
|
|
sl@0
|
1507 |
}
|
|
sl@0
|
1508 |
if {$manual(.DS) != 0} {
|
|
sl@0
|
1509 |
puts "unbalanced .DS .DE"
|
|
sl@0
|
1510 |
}
|
|
sl@0
|
1511 |
if {$manual(.CS) != 0} {
|
|
sl@0
|
1512 |
puts "unbalanced .CS .CE"
|
|
sl@0
|
1513 |
}
|
|
sl@0
|
1514 |
if {$manual(.SO) != 0} {
|
|
sl@0
|
1515 |
puts "unbalanced .SO .SE"
|
|
sl@0
|
1516 |
}
|
|
sl@0
|
1517 |
# output conversion
|
|
sl@0
|
1518 |
open-text
|
|
sl@0
|
1519 |
if {[next-op-is .HS rest]} {
|
|
sl@0
|
1520 |
set manual($manual(name)-title) \
|
|
sl@0
|
1521 |
"[lrange $rest 1 end] [lindex $rest 0] manual page"
|
|
sl@0
|
1522 |
while {[more-text]} {
|
|
sl@0
|
1523 |
set line [next-text]
|
|
sl@0
|
1524 |
if {[is-a-directive $line]} {
|
|
sl@0
|
1525 |
output-directive $line
|
|
sl@0
|
1526 |
} else {
|
|
sl@0
|
1527 |
man-puts $line
|
|
sl@0
|
1528 |
}
|
|
sl@0
|
1529 |
}
|
|
sl@0
|
1530 |
man-puts <HR><PRE>
|
|
sl@0
|
1531 |
foreach copyright $manual(copyrights) {
|
|
sl@0
|
1532 |
man-puts "<A HREF=\"../copyright.htm\">Copyright</A> © [lrange $copyright 2 end]"
|
|
sl@0
|
1533 |
}
|
|
sl@0
|
1534 |
man-puts "<A HREF=\"../copyright.htm\">Copyright</A> © 1995-1997 Roger E. Critchlow Jr.</PRE>"
|
|
sl@0
|
1535 |
set manual(wing-copyrights) [merge-copyrights $manual(wing-copyrights) $manual(copyrights)]
|
|
sl@0
|
1536 |
} elseif {[next-op-is .TH rest]} {
|
|
sl@0
|
1537 |
set manual($manual(name)-title) "[lrange $rest 4 end] - [lindex $rest 0] manual page"
|
|
sl@0
|
1538 |
while {[more-text]} {
|
|
sl@0
|
1539 |
set line [next-text]
|
|
sl@0
|
1540 |
if {[is-a-directive $line]} {
|
|
sl@0
|
1541 |
output-directive $line
|
|
sl@0
|
1542 |
} else {
|
|
sl@0
|
1543 |
man-puts $line
|
|
sl@0
|
1544 |
}
|
|
sl@0
|
1545 |
}
|
|
sl@0
|
1546 |
man-puts <HR><PRE>
|
|
sl@0
|
1547 |
foreach copyright $manual(copyrights) {
|
|
sl@0
|
1548 |
man-puts "<A HREF=\"../copyright.htm\">Copyright</A> © [lrange $copyright 2 end]"
|
|
sl@0
|
1549 |
}
|
|
sl@0
|
1550 |
man-puts "<A HREF=\"../copyright.htm\">Copyright</A> © 1995-1997 Roger E. Critchlow Jr.</PRE>"
|
|
sl@0
|
1551 |
set manual(wing-copyrights) [merge-copyrights $manual(wing-copyrights) $manual(copyrights)]
|
|
sl@0
|
1552 |
} else {
|
|
sl@0
|
1553 |
manerror "no .HS or .TH record found"
|
|
sl@0
|
1554 |
}
|
|
sl@0
|
1555 |
#
|
|
sl@0
|
1556 |
# make the long table of contents for this page
|
|
sl@0
|
1557 |
#
|
|
sl@0
|
1558 |
set manual(toc-$manual(wing-file)-$manual(name)) [concat <DL> $manual(section-toc) </DL><HR>]
|
|
sl@0
|
1559 |
}
|
|
sl@0
|
1560 |
|
|
sl@0
|
1561 |
#
|
|
sl@0
|
1562 |
# make the wing table of contents for the section
|
|
sl@0
|
1563 |
#
|
|
sl@0
|
1564 |
set width 0
|
|
sl@0
|
1565 |
foreach name $manual(wing-toc) {
|
|
sl@0
|
1566 |
if {[string length $name] > $width} {
|
|
sl@0
|
1567 |
set width [string length $name]
|
|
sl@0
|
1568 |
}
|
|
sl@0
|
1569 |
}
|
|
sl@0
|
1570 |
set perline [expr {120 / $width}]
|
|
sl@0
|
1571 |
set nrows [expr {([llength $manual(wing-toc)]+$perline)/$perline}]
|
|
sl@0
|
1572 |
set n 0
|
|
sl@0
|
1573 |
catch {unset rows}
|
|
sl@0
|
1574 |
foreach name [lsort $manual(wing-toc)] {
|
|
sl@0
|
1575 |
set tail $manual(name-$name)
|
|
sl@0
|
1576 |
if {[llength $tail] > 1} {
|
|
sl@0
|
1577 |
manerror "$name is defined in more than one file: $tail"
|
|
sl@0
|
1578 |
set tail [lindex $tail [expr {[llength $tail]-1}]]
|
|
sl@0
|
1579 |
}
|
|
sl@0
|
1580 |
set tail [file tail $tail]
|
|
sl@0
|
1581 |
append rows([expr {$n%$nrows}]) \
|
|
sl@0
|
1582 |
"<td> <a href=\"$tail.htm\">$name</a>"
|
|
sl@0
|
1583 |
incr n
|
|
sl@0
|
1584 |
}
|
|
sl@0
|
1585 |
puts $manual(wing-toc-fp) <table>
|
|
sl@0
|
1586 |
foreach row [lsort -integer [array names rows]] {
|
|
sl@0
|
1587 |
puts $manual(wing-toc-fp) <tr>$rows($row)</tr>
|
|
sl@0
|
1588 |
}
|
|
sl@0
|
1589 |
puts $manual(wing-toc-fp) </table>
|
|
sl@0
|
1590 |
|
|
sl@0
|
1591 |
#
|
|
sl@0
|
1592 |
# insert wing copyrights
|
|
sl@0
|
1593 |
#
|
|
sl@0
|
1594 |
puts $manual(wing-toc-fp) "<HR><PRE>"
|
|
sl@0
|
1595 |
foreach copyright $manual(wing-copyrights) {
|
|
sl@0
|
1596 |
puts $manual(wing-toc-fp) "<A HREF=\"../copyright.htm\">Copyright</A> © [lrange $copyright 2 end]"
|
|
sl@0
|
1597 |
}
|
|
sl@0
|
1598 |
puts $manual(wing-toc-fp) "<A HREF=\"../copyright.htm\">Copyright</A> © 1995-1997 Roger E. Critchlow Jr."
|
|
sl@0
|
1599 |
puts $manual(wing-toc-fp) "</PRE></BODY></HTML>"
|
|
sl@0
|
1600 |
close $manual(wing-toc-fp)
|
|
sl@0
|
1601 |
set manual(merge-copyrights) [merge-copyrights $manual(merge-copyrights) $manual(wing-copyrights)]
|
|
sl@0
|
1602 |
}
|
|
sl@0
|
1603 |
|
|
sl@0
|
1604 |
##
|
|
sl@0
|
1605 |
## build the keyword index.
|
|
sl@0
|
1606 |
##
|
|
sl@0
|
1607 |
proc strcasecmp {a b} { return [string compare -nocase $a $b] }
|
|
sl@0
|
1608 |
set keys [lsort -command strcasecmp [array names manual keyword-*]]
|
|
sl@0
|
1609 |
makedirhier $html/Keywords
|
|
sl@0
|
1610 |
catch {eval file delete -- [glob $html/Keywords/*]}
|
|
sl@0
|
1611 |
puts $manual(short-toc-fp) "<DT><A HREF=\"Keywords/contents.htm\">Keywords</A><DD>The keywords from the $tcltkdesc man pages."
|
|
sl@0
|
1612 |
set keyfp [open $html/Keywords/contents.htm w]
|
|
sl@0
|
1613 |
puts $keyfp "<HTML><HEAD><TITLE>$tcltkdesc Keywords</TITLE></HEAD>"
|
|
sl@0
|
1614 |
puts $keyfp "<BODY><HR><H3>$tcltkdesc Keywords</H3><HR><H2>"
|
|
sl@0
|
1615 |
foreach a {A B C D E F G H I J K L M N O P Q R S T U V W X Y Z} {
|
|
sl@0
|
1616 |
puts $keyfp "<A HREF=\"$a.htm\">$a</A>"
|
|
sl@0
|
1617 |
set afp [open $html/Keywords/$a.htm w]
|
|
sl@0
|
1618 |
puts $afp "<HTML><HEAD><TITLE>$tcltkdesc Keywords - $a</TITLE></HEAD>"
|
|
sl@0
|
1619 |
puts $afp "<BODY><HR><H3>$tcltkdesc Keywords - $a</H3><HR><H2>"
|
|
sl@0
|
1620 |
foreach b {A B C D E F G H I J K L M N O P Q R S T U V W X Y Z} {
|
|
sl@0
|
1621 |
puts $afp "<A HREF=\"$b.htm\">$b</A>"
|
|
sl@0
|
1622 |
}
|
|
sl@0
|
1623 |
puts $afp "</H2><HR><DL>"
|
|
sl@0
|
1624 |
foreach k $keys {
|
|
sl@0
|
1625 |
if {[string match -nocase "keyword-${a}*" $k]} {
|
|
sl@0
|
1626 |
set k [string range $k 8 end]
|
|
sl@0
|
1627 |
puts $afp "<DT><A NAME=\"$k\">$k</A><DD>"
|
|
sl@0
|
1628 |
set refs {}
|
|
sl@0
|
1629 |
foreach man $manual(keyword-$k) {
|
|
sl@0
|
1630 |
set name [lindex $man 0]
|
|
sl@0
|
1631 |
set file [lindex $man 1]
|
|
sl@0
|
1632 |
lappend refs "<A HREF=\"../$file\">$name</A>"
|
|
sl@0
|
1633 |
}
|
|
sl@0
|
1634 |
puts $afp [join $refs {, }]
|
|
sl@0
|
1635 |
}
|
|
sl@0
|
1636 |
}
|
|
sl@0
|
1637 |
puts $afp "</DL><HR><PRE>"
|
|
sl@0
|
1638 |
# insert merged copyrights
|
|
sl@0
|
1639 |
foreach copyright $manual(merge-copyrights) {
|
|
sl@0
|
1640 |
puts $afp "<A HREF=\"copyright.htm\">Copyright</A> © [lrange $copyright 2 end]"
|
|
sl@0
|
1641 |
}
|
|
sl@0
|
1642 |
puts $afp "<A HREF=\"copyright.htm\">Copyright</A> © 1995-1997 Roger E. Critchlow Jr."
|
|
sl@0
|
1643 |
puts $afp "</PRE></BODY></HTML>"
|
|
sl@0
|
1644 |
close $afp
|
|
sl@0
|
1645 |
}
|
|
sl@0
|
1646 |
puts $keyfp "</H2><HR><PRE>"
|
|
sl@0
|
1647 |
|
|
sl@0
|
1648 |
# insert merged copyrights
|
|
sl@0
|
1649 |
foreach copyright $manual(merge-copyrights) {
|
|
sl@0
|
1650 |
puts $keyfp "<A HREF=\"copyright.htm\">Copyright</A> © [lrange $copyright 2 end]"
|
|
sl@0
|
1651 |
}
|
|
sl@0
|
1652 |
puts $keyfp "<A HREF=\"copyright.htm\">Copyright</A> © 1995-1997 Roger E. Critchlow Jr."
|
|
sl@0
|
1653 |
puts $keyfp </PRE><HR></BODY></HTML>
|
|
sl@0
|
1654 |
close $keyfp
|
|
sl@0
|
1655 |
|
|
sl@0
|
1656 |
##
|
|
sl@0
|
1657 |
## finish off short table of contents
|
|
sl@0
|
1658 |
##
|
|
sl@0
|
1659 |
puts $manual(short-toc-fp) {<DT><A HREF="http://www.elf.org">Source</A><DD>More information about these man pages.}
|
|
sl@0
|
1660 |
puts $manual(short-toc-fp) "</DL><HR><PRE>"
|
|
sl@0
|
1661 |
# insert merged copyrights
|
|
sl@0
|
1662 |
foreach copyright $manual(merge-copyrights) {
|
|
sl@0
|
1663 |
puts $manual(short-toc-fp) "<A HREF=\"copyright.htm\">Copyright</A> © [lrange $copyright 2 end]"
|
|
sl@0
|
1664 |
}
|
|
sl@0
|
1665 |
puts $manual(short-toc-fp) "<A HREF=\"copyright.htm\">Copyright</A> © 1995-1997 Roger E. Critchlow Jr."
|
|
sl@0
|
1666 |
puts $manual(short-toc-fp) "</PRE></BODY></HTML>"
|
|
sl@0
|
1667 |
close $manual(short-toc-fp)
|
|
sl@0
|
1668 |
|
|
sl@0
|
1669 |
##
|
|
sl@0
|
1670 |
## output man pages
|
|
sl@0
|
1671 |
##
|
|
sl@0
|
1672 |
unset manual(section)
|
|
sl@0
|
1673 |
foreach path $manual(all-pages) {
|
|
sl@0
|
1674 |
set manual(wing-file) [file dirname $path]
|
|
sl@0
|
1675 |
set manual(tail) [file tail $path]
|
|
sl@0
|
1676 |
set manual(name) [file root $manual(tail)]
|
|
sl@0
|
1677 |
set text $manual(output-$manual(wing-file)-$manual(name))
|
|
sl@0
|
1678 |
set ntext 0
|
|
sl@0
|
1679 |
foreach item $text {
|
|
sl@0
|
1680 |
incr ntext [llength [split $item \n]]
|
|
sl@0
|
1681 |
incr ntext
|
|
sl@0
|
1682 |
}
|
|
sl@0
|
1683 |
set toc $manual(toc-$manual(wing-file)-$manual(name))
|
|
sl@0
|
1684 |
set ntoc 0
|
|
sl@0
|
1685 |
foreach item $toc {
|
|
sl@0
|
1686 |
incr ntoc [llength [split $item \n]]
|
|
sl@0
|
1687 |
incr ntoc
|
|
sl@0
|
1688 |
}
|
|
sl@0
|
1689 |
puts stderr "rescanning page $manual(name) $ntoc/$ntext"
|
|
sl@0
|
1690 |
set manual(outfp) [open $html/$manual(wing-file)/$manual(name).htm w]
|
|
sl@0
|
1691 |
puts $manual(outfp) "<HTML><HEAD><TITLE>$manual($manual(name)-title)</TITLE></HEAD><BODY>"
|
|
sl@0
|
1692 |
if {($ntext > 60) && ($ntoc > 32) || [lsearch {
|
|
sl@0
|
1693 |
Hash LinkVar SetVar TraceVar ConfigWidg CrtImgType CrtItemType
|
|
sl@0
|
1694 |
CrtPhImgFmt DoOneEvent GetBitmap GetColor GetCursor GetDash
|
|
sl@0
|
1695 |
GetJustify GetPixels GetVisual ParseArgv QueueEvent
|
|
sl@0
|
1696 |
} $manual(tail)] >= 0} {
|
|
sl@0
|
1697 |
foreach item $toc {
|
|
sl@0
|
1698 |
puts $manual(outfp) $item
|
|
sl@0
|
1699 |
}
|
|
sl@0
|
1700 |
}
|
|
sl@0
|
1701 |
foreach item $text {
|
|
sl@0
|
1702 |
puts $manual(outfp) [insert-cross-references $item]
|
|
sl@0
|
1703 |
}
|
|
sl@0
|
1704 |
puts $manual(outfp) </BODY></HTML>
|
|
sl@0
|
1705 |
close $manual(outfp)
|
|
sl@0
|
1706 |
}
|
|
sl@0
|
1707 |
return {}
|
|
sl@0
|
1708 |
}
|
|
sl@0
|
1709 |
|
|
sl@0
|
1710 |
parse_command_line
|
|
sl@0
|
1711 |
|
|
sl@0
|
1712 |
set tcltkdesc ""; set cmdesc ""; set appdir ""
|
|
sl@0
|
1713 |
if {$build_tcl} {append tcltkdesc "Tcl"; append cmdesc "Tcl"; append appdir "$tcldir"}
|
|
sl@0
|
1714 |
if {$build_tcl && $build_tk} {append tcltkdesc "/"; append cmdesc " and "; append appdir ","}
|
|
sl@0
|
1715 |
if {$build_tk} {append tcltkdesc "Tk"; append cmdesc "Tk"; append appdir "$tkdir"}
|
|
sl@0
|
1716 |
|
|
sl@0
|
1717 |
set usercmddesc "The interpreters which implement $cmdesc."
|
|
sl@0
|
1718 |
set tclcmddesc {The commands which the <B>tclsh</B> interpreter implements.}
|
|
sl@0
|
1719 |
set tkcmddesc {The additional commands which the <B>wish</B> interpreter implements.}
|
|
sl@0
|
1720 |
set tcllibdesc {The C functions which a Tcl extended C program may use.}
|
|
sl@0
|
1721 |
set tklibdesc {The additional C functions which a Tk extended C program may use.}
|
|
sl@0
|
1722 |
|
|
sl@0
|
1723 |
if {1} {
|
|
sl@0
|
1724 |
if {[catch {
|
|
sl@0
|
1725 |
make-man-pages $webdir \
|
|
sl@0
|
1726 |
"$tcltkdir/{$appdir}/doc/*.1 \"$tcltkdesc Applications\" UserCmd {$usercmddesc}" \
|
|
sl@0
|
1727 |
[expr {$build_tcl ? "$tcltkdir/$tcldir/doc/*.n {Tcl Commands} TclCmd {$tclcmddesc}" : ""}] \
|
|
sl@0
|
1728 |
[expr {$build_tk ? "$tcltkdir/$tkdir/doc/*.n {Tk Commands} TkCmd {$tkcmddesc}" : ""}] \
|
|
sl@0
|
1729 |
[expr {$build_tcl ? "$tcltkdir/$tcldir/doc/*.3 {Tcl Library} TclLib {$tcllibdesc}" : ""}] \
|
|
sl@0
|
1730 |
[expr {$build_tk ? "$tcltkdir/$tkdir/doc/*.3 {Tk Library} TkLib {$tklibdesc}" : ""}]
|
|
sl@0
|
1731 |
} error]} {
|
|
sl@0
|
1732 |
puts $error\n$errorInfo
|
|
sl@0
|
1733 |
}
|
|
sl@0
|
1734 |
}
|