os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tools/tcltk-man2html.tcl
1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2 +++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tools/tcltk-man2html.tcl Fri Jun 15 03:10:57 2012 +0200
1.3 @@ -0,0 +1,1734 @@
1.4 +#!/bin/sh
1.5 +# The next line is executed by /bin/sh, but not tcl \
1.6 +exec tclsh8.4 "$0" ${1+"$@"}
1.7 +
1.8 +package require Tcl 8.4
1.9 +
1.10 +# Convert Ousterhout format man pages into highly crosslinked
1.11 +# hypertext.
1.12 +#
1.13 +# Along the way detect many unmatched font changes and other odd
1.14 +# things.
1.15 +#
1.16 +# Note well, this program is a hack rather than a piece of software
1.17 +# engineering. In that sense it's probably a good example of things
1.18 +# that a scripting language, like Tcl, can do well. It is offered as
1.19 +# an example of how someone might convert a specific set of man pages
1.20 +# into hypertext, not as a general solution to the problem. If you
1.21 +# try to use this, you'll be very much on your own.
1.22 +#
1.23 +# Copyright (c) 1995-1997 Roger E. Critchlow Jr
1.24 +#
1.25 +# The authors hereby grant permission to use, copy, modify, distribute,
1.26 +# and license this software and its documentation for any purpose, provided
1.27 +# that existing copyright notices are retained in all copies and that this
1.28 +# notice is included verbatim in any distributions. No written agreement,
1.29 +# license, or royalty fee is required for any of the authorized uses.
1.30 +# Modifications to this software may be copyrighted by their authors
1.31 +# and need not follow the licensing terms described here, provided that
1.32 +# the new terms are clearly indicated on the first page of each file where
1.33 +# they apply.
1.34 +#
1.35 +# IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
1.36 +# FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
1.37 +# ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
1.38 +# DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
1.39 +# POSSIBILITY OF SUCH DAMAGE.
1.40 +#
1.41 +# THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
1.42 +# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
1.43 +# FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE
1.44 +# IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
1.45 +# NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
1.46 +# MODIFICATIONS.
1.47 +#
1.48 +# Revisions:
1.49 +# May 15, 1995 - initial release
1.50 +# May 16, 1995 - added a back to home link to toplevel table of
1.51 +# contents.
1.52 +# May 18, 1995 - broke toplevel table of contents into separate
1.53 +# pages for each section, and broke long table of contents
1.54 +# into a one page for each man page.
1.55 +# Mar 10, 1996 - updated for tcl7.5b3/tk4.1b3
1.56 +# Apr 14, 1996 - incorporated command line parsing from Tom Tromey,
1.57 +# <tromey@creche.cygnus.com> -- thanks Tom.
1.58 +# - updated for tcl7.5/tk4.1 final release.
1.59 +# - converted to same copyright as the man pages.
1.60 +# Sep 14, 1996 - made various modifications for tcl7.6b1/tk4.2b1
1.61 +# Oct 18, 1996 - added tcl7.6/tk4.2 to the list of distributions.
1.62 +# Oct 22, 1996 - major hacking on indentation code and elsewhere.
1.63 +# Mar 4, 1997 -
1.64 +# May 28, 1997 - added tcl8.0b1/tk8.0b1 to the list of distributions
1.65 +# - cleaned source for tclsh8.0 execution
1.66 +# - renamed output files for windoze installation
1.67 +# - added spaces to tables
1.68 +# Oct 24, 1997 - moved from 8.0b1 to 8.0 release
1.69 +#
1.70 +
1.71 +set Version "0.32"
1.72 +
1.73 +proc parse_command_line {} {
1.74 + global argv Version
1.75 +
1.76 + # These variables determine where the man pages come from and where
1.77 + # the converted pages go to.
1.78 + global tcltkdir tkdir tcldir webdir build_tcl build_tk
1.79 +
1.80 + # Set defaults based on original code.
1.81 + set tcltkdir ../..
1.82 + set tkdir {}
1.83 + set tcldir {}
1.84 + set webdir ../html
1.85 + set build_tcl 0
1.86 + set build_tk 0
1.87 + # Default search version is a glob pattern
1.88 + set useversion {{,[8-9].[0-9]{,.[0-9]{,[0-9]}}}}
1.89 +
1.90 + # Handle arguments a la GNU:
1.91 + # --version
1.92 + # --useversion=<version>
1.93 + # --help
1.94 + # --srcdir=/path
1.95 + # --htmldir=/path
1.96 +
1.97 + foreach option $argv {
1.98 + switch -glob -- $option {
1.99 + --version {
1.100 + puts "tcltk-man-html $Version"
1.101 + exit 0
1.102 + }
1.103 +
1.104 + --help {
1.105 + puts "usage: tcltk-man-html \[OPTION\] ...\n"
1.106 + puts " --help print this help, then exit"
1.107 + puts " --version print version number, then exit"
1.108 + puts " --srcdir=DIR find tcl and tk source below DIR"
1.109 + puts " --htmldir=DIR put generated HTML in DIR"
1.110 + puts " --tcl build tcl help"
1.111 + puts " --tk build tk help"
1.112 + puts " --useversion version of tcl/tk to search for"
1.113 + exit 0
1.114 + }
1.115 +
1.116 + --srcdir=* {
1.117 + # length of "--srcdir=" is 9.
1.118 + set tcltkdir [string range $option 9 end]
1.119 + }
1.120 +
1.121 + --htmldir=* {
1.122 + # length of "--htmldir=" is 10
1.123 + set webdir [string range $option 10 end]
1.124 + }
1.125 +
1.126 + --useversion=* {
1.127 + # length of "--useversion=" is 13
1.128 + set useversion [string range $option 13 end]
1.129 + }
1.130 +
1.131 + --tcl {
1.132 + set build_tcl 1
1.133 + }
1.134 +
1.135 + --tk {
1.136 + set build_tk 1
1.137 + }
1.138 +
1.139 + default {
1.140 + puts stderr "tcltk-man-html: unrecognized option -- `$option'"
1.141 + exit 1
1.142 + }
1.143 + }
1.144 + }
1.145 +
1.146 + if {!$build_tcl && !$build_tk} {set build_tcl 1; set build_tk 1}
1.147 +
1.148 + if {$build_tcl} {
1.149 + # Find Tcl.
1.150 + set tcldir [lindex [lsort [glob -nocomplain -tails -type d \
1.151 + -directory $tcltkdir tcl$useversion]] end]
1.152 + if {$tcldir == ""} then {
1.153 + puts stderr "tcltk-man-html: couldn't find Tcl below $tcltkdir"
1.154 + exit 1
1.155 + }
1.156 + puts "using Tcl source directory $tcldir"
1.157 + }
1.158 +
1.159 + if {$build_tk} {
1.160 + # Find Tk.
1.161 + set tkdir [lindex [lsort [glob -nocomplain -tails -type d \
1.162 + -directory $tcltkdir tk$useversion]] end]
1.163 + if {$tkdir == ""} then {
1.164 + puts stderr "tcltk-man-html: couldn't find Tk below $tcltkdir"
1.165 + exit 1
1.166 + }
1.167 + puts "using Tk source directory $tkdir"
1.168 + }
1.169 +
1.170 + # the title for the man pages overall
1.171 + global overall_title
1.172 + set overall_title ""
1.173 + if {$build_tcl} {append overall_title "[capitalize $tcldir]"}
1.174 + if {$build_tcl && $build_tk} {append overall_title "/"}
1.175 + if {$build_tk} {append overall_title "[capitalize $tkdir]"}
1.176 + append overall_title " Manual"
1.177 +}
1.178 +
1.179 +proc capitalize {string} {
1.180 + return [string toupper $string 0]
1.181 +}
1.182 +
1.183 +##
1.184 +##
1.185 +##
1.186 +set manual(report-level) 1
1.187 +
1.188 +proc manerror {msg} {
1.189 + global manual
1.190 + set name {}
1.191 + set subj {}
1.192 + if {[info exists manual(name)]} {
1.193 + set name $manual(name)
1.194 + }
1.195 + if {[info exists manual(section)] && [string length $manual(section)]} {
1.196 + puts stderr "$name: $manual(section): $msg"
1.197 + } else {
1.198 + puts stderr "$name: $msg"
1.199 + }
1.200 +}
1.201 +
1.202 +proc manreport {level msg} {
1.203 + global manual
1.204 + if {$level < $manual(report-level)} {
1.205 + manerror $msg
1.206 + }
1.207 +}
1.208 +
1.209 +proc fatal {msg} {
1.210 + global manual
1.211 + manerror $msg
1.212 + exit 1
1.213 +}
1.214 +##
1.215 +## parsing
1.216 +##
1.217 +proc unquote arg {
1.218 + return [string map [list \" {}] $arg]
1.219 +}
1.220 +
1.221 +proc parse-directive {line codename restname} {
1.222 + upvar $codename code $restname rest
1.223 + return [regexp {^(\.[.a-zA-Z0-9]*) *(.*)} $line all code rest]
1.224 +}
1.225 +
1.226 +proc process-text {text} {
1.227 + global manual
1.228 + # preprocess text
1.229 + set text [string map [list \
1.230 + {\&} "\t" \
1.231 + {&} {&} \
1.232 + {\\} {\} \
1.233 + {\e} {\} \
1.234 + {\ } { } \
1.235 + {\|} { } \
1.236 + {\0} { } \
1.237 + {\%} {} \
1.238 + "\\\n" "\n" \
1.239 + \" {"} \
1.240 + {<} {<} \
1.241 + {>} {>} \
1.242 + {\(+-} {±} \
1.243 + {\fP} {\fR} \
1.244 + {\.} . \
1.245 + {\(bu} {•} \
1.246 + ] $text]
1.247 + regsub -all {\\o'o\^'} $text {\ô} text; # o-circumflex in re_syntax.n
1.248 + regsub -all {\\-\\\|\\-} $text -- text; # two hyphens
1.249 + regsub -all -- {\\-\\\^\\-} $text -- text; # two hyphens
1.250 + regsub -all {\\-} $text - text; # a hyphen
1.251 + regsub -all "\\\\\n" $text "\\\\n" text; # backslashed newline
1.252 + while {[string first "\\" $text] >= 0} {
1.253 + # C R
1.254 + if {[regsub {^([^\\]*)\\fC([^\\]*)\\fR(.*)$} $text \
1.255 + {\1<TT>\2</TT>\3} text]} continue
1.256 + # B R
1.257 + if {[regsub {^([^\\]*)\\fB([^\\]*)\\fR(.*)$} $text \
1.258 + {\1<B>\2</B>\3} text]} continue
1.259 + # B I
1.260 + if {[regsub {^([^\\]*)\\fB([^\\]*)\\fI(.*)$} $text \
1.261 + {\1<B>\2</B>\\fI\3} text]} continue
1.262 + # I R
1.263 + if {[regsub {^([^\\]*)\\fI([^\\]*)\\fR(.*)$} $text \
1.264 + {\1<I>\2</I>\3} text]} continue
1.265 + # I B
1.266 + if {[regsub {^([^\\]*)\\fI([^\\]*)\\fB(.*)$} $text \
1.267 + {\1<I>\2</I>\\fB\3} text]} continue
1.268 + # B B, I I, R R
1.269 + if {[regsub {^([^\\]*)\\fB([^\\]*)\\fB(.*)$} $text \
1.270 + {\1\\fB\2\3} ntext]
1.271 + || [regsub {^([^\\]*)\\fI([^\\]*)\\fI(.*)$} $text \
1.272 + {\1\\fI\2\3} ntext]
1.273 + || [regsub {^([^\\]*)\\fR([^\\]*)\\fR(.*)$} $text \
1.274 + {\1\\fR\2\3} ntext]} {
1.275 + manerror "process-text: impotent font change: $text"
1.276 + set text $ntext
1.277 + continue
1.278 + }
1.279 + # unrecognized
1.280 + manerror "process-text: uncaught backslash: $text"
1.281 + set text [string map [list "\\" "#92;"] $text]
1.282 + }
1.283 + return $text
1.284 +}
1.285 +##
1.286 +## pass 2 text input and matching
1.287 +##
1.288 +proc open-text {} {
1.289 + global manual
1.290 + set manual(text-length) [llength $manual(text)]
1.291 + set manual(text-pointer) 0
1.292 +}
1.293 +proc more-text {} {
1.294 + global manual
1.295 + return [expr {$manual(text-pointer) < $manual(text-length)}]
1.296 +}
1.297 +proc next-text {} {
1.298 + global manual
1.299 + if {[more-text]} {
1.300 + set text [lindex $manual(text) $manual(text-pointer)]
1.301 + incr manual(text-pointer)
1.302 + return $text
1.303 + }
1.304 + manerror "read past end of text"
1.305 + error "fatal"
1.306 +}
1.307 +proc is-a-directive {line} {
1.308 + return [string match .* $line]
1.309 +}
1.310 +proc split-directive {line opname restname} {
1.311 + upvar $opname op $restname rest
1.312 + set op [string range $line 0 2]
1.313 + set rest [string trim [string range $line 3 end]]
1.314 +}
1.315 +proc next-op-is {op restname} {
1.316 + global manual
1.317 + upvar $restname rest
1.318 + if {[more-text]} {
1.319 + set text [lindex $manual(text) $manual(text-pointer)]
1.320 + if {[string equal -length 3 $text $op]} {
1.321 + set rest [string range $text 4 end]
1.322 + incr manual(text-pointer)
1.323 + return 1
1.324 + }
1.325 + }
1.326 + return 0
1.327 +}
1.328 +proc backup-text {n} {
1.329 + global manual
1.330 + if {$manual(text-pointer)-$n >= 0} {
1.331 + incr manual(text-pointer) -$n
1.332 + }
1.333 +}
1.334 +proc match-text args {
1.335 + global manual
1.336 + set nargs [llength $args]
1.337 + if {$manual(text-pointer) + $nargs > $manual(text-length)} {
1.338 + return 0
1.339 + }
1.340 + set nback 0
1.341 + foreach arg $args {
1.342 + if {![more-text]} {
1.343 + backup-text $nback
1.344 + return 0
1.345 + }
1.346 + set arg [string trim $arg]
1.347 + set targ [string trim [lindex $manual(text) $manual(text-pointer)]]
1.348 + if {[string equal $arg $targ]} {
1.349 + incr nback
1.350 + incr manual(text-pointer)
1.351 + continue
1.352 + }
1.353 + if {[regexp {^@(\w+)$} $arg all name]} {
1.354 + upvar $name var
1.355 + set var $targ
1.356 + incr nback
1.357 + incr manual(text-pointer)
1.358 + continue
1.359 + }
1.360 + if {[regexp -nocase {^(\.[A-Z][A-Z])@(\w+)$} $arg all op name]\
1.361 + && [string equal $op [lindex $targ 0]]} {
1.362 + upvar $name var
1.363 + set var [lrange $targ 1 end]
1.364 + incr nback
1.365 + incr manual(text-pointer)
1.366 + continue
1.367 + }
1.368 + backup-text $nback
1.369 + return 0
1.370 + }
1.371 + return 1
1.372 +}
1.373 +proc expand-next-text {n} {
1.374 + global manual
1.375 + return [join [lrange $manual(text) $manual(text-pointer) \
1.376 + [expr {$manual(text-pointer)+$n-1}]] \n\n]
1.377 +}
1.378 +##
1.379 +## pass 2 output
1.380 +##
1.381 +proc man-puts {text} {
1.382 + global manual
1.383 + lappend manual(output-$manual(wing-file)-$manual(name)) $text
1.384 +}
1.385 +
1.386 +##
1.387 +## build hypertext links to tables of contents
1.388 +##
1.389 +proc long-toc {text} {
1.390 + global manual
1.391 + set here M[incr manual(section-toc-n)]
1.392 + set there L[incr manual(long-toc-n)]
1.393 + lappend manual(section-toc) \
1.394 + "<DD><A HREF=\"$manual(name).htm#$here\" NAME=\"$there\">$text</A>"
1.395 + return "<A NAME=\"$here\">$text</A>"
1.396 +}
1.397 +proc option-toc {name class switch} {
1.398 + global manual
1.399 + if {[string equal $manual(section) "WIDGET-SPECIFIC OPTIONS"]} {
1.400 + # link the defined option into the long table of contents
1.401 + set link [long-toc "$switch, $name, $class"]
1.402 + regsub -- "$switch, $name, $class" $link "$switch" link
1.403 + return $link
1.404 + } elseif {[string equal $manual(name):$manual(section) \
1.405 + "options:DESCRIPTION"]} {
1.406 + # link the defined standard option to the long table of
1.407 + # contents and make a target for the standard option references
1.408 + # from other man pages.
1.409 + set first [lindex $switch 0]
1.410 + set here M$first
1.411 + set there L[incr manual(long-toc-n)]
1.412 + set manual(standard-option-$first) "<A HREF=\"$manual(name).htm#$here\">$switch, $name, $class</A>"
1.413 + lappend manual(section-toc) "<DD><A HREF=\"$manual(name).htm#$here\" NAME=\"$there\">$switch, $name, $class</A>"
1.414 + return "<A NAME=\"$here\">$switch</A>"
1.415 + } else {
1.416 + error "option-toc in $manual(name) section $manual(section)"
1.417 + }
1.418 +}
1.419 +proc std-option-toc {name} {
1.420 + global manual
1.421 + if {[info exists manual(standard-option-$name)]} {
1.422 + lappend manual(section-toc) <DD>$manual(standard-option-$name)
1.423 + return $manual(standard-option-$name)
1.424 + }
1.425 + set here M[incr manual(section-toc-n)]
1.426 + set there L[incr manual(long-toc-n)]
1.427 + set other M$name
1.428 + lappend manual(section-toc) "<DD><A HREF=\"options.htm#$other\">$name</A>"
1.429 + return "<A HREF=\"options.htm#$other\">$name</A>"
1.430 +}
1.431 +##
1.432 +## process the widget option section
1.433 +## in widget and options man pages
1.434 +##
1.435 +proc output-widget-options {rest} {
1.436 + global manual
1.437 + man-puts <DL>
1.438 + lappend manual(section-toc) <DL>
1.439 + backup-text 1
1.440 + set para {}
1.441 + while {[next-op-is .OP rest]} {
1.442 + switch -exact [llength $rest] {
1.443 + 3 { foreach {switch name class} $rest { break } }
1.444 + 5 {
1.445 + set switch [lrange $rest 0 2]
1.446 + set name [lindex $rest 3]
1.447 + set class [lindex $rest 4]
1.448 + }
1.449 + default {
1.450 + fatal "bad .OP $rest"
1.451 + }
1.452 + }
1.453 + if {![regexp {^(<.>)([-\w ]+)(</.>)$} $switch all oswitch switch cswitch]} {
1.454 + if {![regexp {^(<.>)([-\w ]+) or ([-\w ]+)(</.>)$} $switch all oswitch switch1 switch2 cswitch]} {
1.455 + error "not Switch: $switch"
1.456 + } else {
1.457 + set switch "$switch1$cswitch or $oswitch$switch2"
1.458 + }
1.459 + }
1.460 + if {![regexp {^(<.>)([\w]*)(</.>)$} $name all oname name cname]} {
1.461 + error "not Name: $name"
1.462 + }
1.463 + if {![regexp {^(<.>)([\w]*)(</.>)$} $class all oclass class cclass]} {
1.464 + error "not Class: $class"
1.465 + }
1.466 + man-puts "$para<DT>Command-Line Name: $oswitch[option-toc $name $class $switch]$cswitch"
1.467 + man-puts "<DT>Database Name: $oname$name$cname"
1.468 + man-puts "<DT>Database Class: $oclass$class$cclass"
1.469 + man-puts <DD>[next-text]
1.470 + set para <P>
1.471 + }
1.472 + man-puts </DL>
1.473 + lappend manual(section-toc) </DL>
1.474 +}
1.475 +
1.476 +##
1.477 +## process .RS lists
1.478 +##
1.479 +proc output-RS-list {} {
1.480 + global manual
1.481 + if {[next-op-is .IP rest]} {
1.482 + output-IP-list .RS .IP $rest
1.483 + if {[match-text .RE .sp .RS @rest .IP @rest2]} {
1.484 + man-puts <P>$rest
1.485 + output-IP-list .RS .IP $rest2
1.486 + }
1.487 + if {[match-text .RE .sp .RS @rest .RE]} {
1.488 + man-puts <P>$rest
1.489 + return
1.490 + }
1.491 + if {[next-op-is .RE rest]} {
1.492 + return
1.493 + }
1.494 + }
1.495 + man-puts <DL><DD>
1.496 + while {[more-text]} {
1.497 + set line [next-text]
1.498 + if {[is-a-directive $line]} {
1.499 + split-directive $line code rest
1.500 + switch -exact $code {
1.501 + .RE {
1.502 + break
1.503 + }
1.504 + .SH - .SS {
1.505 + manerror "unbalanced .RS at section end"
1.506 + backup-text 1
1.507 + break
1.508 + }
1.509 + default {
1.510 + output-directive $line
1.511 + }
1.512 + }
1.513 + } else {
1.514 + man-puts $line
1.515 + }
1.516 + }
1.517 + man-puts </DL>
1.518 +}
1.519 +
1.520 +##
1.521 +## process .IP lists which may be plain indents,
1.522 +## numeric lists, or definition lists
1.523 +##
1.524 +proc output-IP-list {context code rest} {
1.525 + global manual
1.526 + if {![string length $rest]} {
1.527 + # blank label, plain indent, no contents entry
1.528 + man-puts <DL><DD>
1.529 + while {[more-text]} {
1.530 + set line [next-text]
1.531 + if {[is-a-directive $line]} {
1.532 + split-directive $line code rest
1.533 + if {[string equal $code ".IP"] && [string equal $rest {}]} {
1.534 + man-puts "<P>"
1.535 + continue
1.536 + }
1.537 + if {[lsearch {.br .DS .RS} $code] >= 0} {
1.538 + output-directive $line
1.539 + } else {
1.540 + backup-text 1
1.541 + break
1.542 + }
1.543 + } else {
1.544 + man-puts $line
1.545 + }
1.546 + }
1.547 + man-puts </DL>
1.548 + } else {
1.549 + # labelled list, make contents
1.550 + if {
1.551 + [string compare $context ".SH"] &&
1.552 + [string compare $context ".SS"]
1.553 + } then {
1.554 + man-puts <P>
1.555 + }
1.556 + man-puts <DL>
1.557 + lappend manual(section-toc) <DL>
1.558 + backup-text 1
1.559 + set accept_RE 0
1.560 + set para {}
1.561 + while {[more-text]} {
1.562 + set line [next-text]
1.563 + if {[is-a-directive $line]} {
1.564 + split-directive $line code rest
1.565 + switch -exact $code {
1.566 + .IP {
1.567 + if {$accept_RE} {
1.568 + output-IP-list .IP $code $rest
1.569 + continue
1.570 + }
1.571 + if {[string equal $manual(section) "ARGUMENTS"] || \
1.572 + [regexp {^\[\d+\]$} $rest]} {
1.573 + man-puts "$para<DT>$rest<DD>"
1.574 + } elseif {[string equal {•} $rest]} {
1.575 + man-puts "$para<DT><DD>$rest "
1.576 + } else {
1.577 + man-puts "$para<DT>[long-toc $rest]<DD>"
1.578 + }
1.579 + if {[string equal $manual(name):$manual(section) \
1.580 + "selection:DESCRIPTION"]} {
1.581 + if {[match-text .RE @rest .RS .RS]} {
1.582 + man-puts <DT>[long-toc $rest]<DD>
1.583 + }
1.584 + }
1.585 + }
1.586 + .sp -
1.587 + .br -
1.588 + .DS -
1.589 + .CS {
1.590 + output-directive $line
1.591 + }
1.592 + .RS {
1.593 + if {[match-text .RS]} {
1.594 + output-directive $line
1.595 + incr accept_RE 1
1.596 + } elseif {[match-text .CS]} {
1.597 + output-directive .CS
1.598 + incr accept_RE 1
1.599 + } elseif {[match-text .PP]} {
1.600 + output-directive .PP
1.601 + incr accept_RE 1
1.602 + } elseif {[match-text .DS]} {
1.603 + output-directive .DS
1.604 + incr accept_RE 1
1.605 + } else {
1.606 + output-directive $line
1.607 + }
1.608 + }
1.609 + .PP {
1.610 + if {[match-text @rest1 .br @rest2 .RS]} {
1.611 + # yet another nroff kludge as above
1.612 + man-puts "$para<DT>[long-toc $rest1]"
1.613 + man-puts "<DT>[long-toc $rest2]<DD>"
1.614 + incr accept_RE 1
1.615 + } elseif {[match-text @rest .RE]} {
1.616 + # gad, this is getting ridiculous
1.617 + if {!$accept_RE} {
1.618 + man-puts "</DL><P>$rest<DL>"
1.619 + backup-text 1
1.620 + set para {}
1.621 + break
1.622 + } else {
1.623 + man-puts "<P>$rest"
1.624 + incr accept_RE -1
1.625 + }
1.626 + } elseif {$accept_RE} {
1.627 + output-directive $line
1.628 + } else {
1.629 + backup-text 1
1.630 + break
1.631 + }
1.632 + }
1.633 + .RE {
1.634 + if {!$accept_RE} {
1.635 + backup-text 1
1.636 + break
1.637 + }
1.638 + incr accept_RE -1
1.639 + }
1.640 + default {
1.641 + backup-text 1
1.642 + break
1.643 + }
1.644 + }
1.645 + } else {
1.646 + man-puts $line
1.647 + }
1.648 + set para <P>
1.649 + }
1.650 + man-puts "$para</DL>"
1.651 + lappend manual(section-toc) </DL>
1.652 + if {$accept_RE} {
1.653 + manerror "missing .RE in output-IP-list"
1.654 + }
1.655 + }
1.656 +}
1.657 +##
1.658 +## handle the NAME section lines
1.659 +## there's only one line in the NAME section,
1.660 +## consisting of a comma separated list of names,
1.661 +## followed by a hyphen and a short description.
1.662 +##
1.663 +proc output-name {line} {
1.664 + global manual
1.665 + # split name line into pieces
1.666 + regexp {^([^-]+) - (.*)$} $line all head tail
1.667 + # output line to manual page untouched
1.668 + man-puts $line
1.669 + # output line to long table of contents
1.670 + lappend manual(section-toc) <DL><DD>$line</DL>
1.671 + # separate out the names for future reference
1.672 + foreach name [split $head ,] {
1.673 + set name [string trim $name]
1.674 + if {[llength $name] > 1} {
1.675 + manerror "name has a space: {$name}\nfrom: $line"
1.676 + }
1.677 + lappend manual(wing-toc) $name
1.678 + lappend manual(name-$name) $manual(wing-file)/$manual(name)
1.679 + }
1.680 +}
1.681 +##
1.682 +## build a cross-reference link if appropriate
1.683 +##
1.684 +proc cross-reference {ref} {
1.685 + global manual
1.686 + if {[string match Tcl_* $ref]} {
1.687 + set lref $ref
1.688 + } elseif {[string match Tk_* $ref]} {
1.689 + set lref $ref
1.690 + } elseif {[string equal $ref "Tcl"]} {
1.691 + set lref $ref
1.692 + } else {
1.693 + set lref [string tolower $ref]
1.694 + }
1.695 + ##
1.696 + ## nothing to reference
1.697 + ##
1.698 + if {![info exists manual(name-$lref)]} {
1.699 + foreach name {array file history info interp string trace
1.700 + after clipboard grab image option pack place selection tk tkwait update winfo wm} {
1.701 + if {[regexp "^$name \[a-z0-9]*\$" $lref] && \
1.702 + [info exists manual(name-$name)] && \
1.703 + [string compare $manual(tail) "$name.n"]} {
1.704 + return "<A HREF=\"../$manual(name-$name).htm\">$ref</A>"
1.705 + }
1.706 + }
1.707 + if {[lsearch {stdin stdout stderr end} $lref] >= 0} {
1.708 + # no good place to send these
1.709 + # tcl tokens?
1.710 + # also end
1.711 + }
1.712 + return $ref
1.713 + }
1.714 + ##
1.715 + ## would be a self reference
1.716 + ##
1.717 + foreach name $manual(name-$lref) {
1.718 + if {[lsearch $name $manual(wing-file)/$manual(name)] >= 0} {
1.719 + return $ref
1.720 + }
1.721 + }
1.722 + ##
1.723 + ## multiple choices for reference
1.724 + ##
1.725 + if {[llength $manual(name-$lref)] > 1} {
1.726 + set tcl_i [lsearch -glob $manual(name-$lref) *TclCmd*]
1.727 + set tcl_ref [lindex $manual(name-$lref) $tcl_i]
1.728 + set tk_i [lsearch -glob $manual(name-$lref) *TkCmd*]
1.729 + set tk_ref [lindex $manual(name-$lref) $tk_i]
1.730 + if {$tcl_i >= 0 && "$manual(wing-file)" == {TclCmd} \
1.731 + || "$manual(wing-file)" == {TclLib}} {
1.732 + return "<A HREF=\"../$tcl_ref.htm\">$ref</A>"
1.733 + }
1.734 + if {$tk_i >= 0 && "$manual(wing-file)" == {TkCmd} \
1.735 + || "$manual(wing-file)" == {TkLib}} {
1.736 + return "<A HREF=\"../$tk_ref.htm\">$ref</A>"
1.737 + }
1.738 + if {"$lref" == {exit} && "$manual(tail)" == {tclsh.1} && $tcl_i >= 0} {
1.739 + return "<A HREF=\"../$tcl_ref.htm\">$ref</A>"
1.740 + }
1.741 + puts stderr "multiple cross reference to $ref in $manual(name-$lref) from $manual(wing-file)/$manual(tail)"
1.742 + return $ref
1.743 + }
1.744 + ##
1.745 + ## exceptions, sigh, to the rule
1.746 + ##
1.747 + switch $manual(tail) {
1.748 + canvas.n {
1.749 + if {$lref == {focus}} {
1.750 + upvar tail tail
1.751 + set clue [string first command $tail]
1.752 + if {$clue < 0 || $clue > 5} {
1.753 + return $ref
1.754 + }
1.755 + }
1.756 + if {[lsearch {bitmap image text} $lref] >= 0} {
1.757 + return $ref
1.758 + }
1.759 + }
1.760 + checkbutton.n -
1.761 + radiobutton.n {
1.762 + if {[lsearch {image} $lref] >= 0} {
1.763 + return $ref
1.764 + }
1.765 + }
1.766 + menu.n {
1.767 + if {[lsearch {checkbutton radiobutton} $lref] >= 0} {
1.768 + return $ref
1.769 + }
1.770 + }
1.771 + options.n {
1.772 + if {[lsearch {bitmap image set} $lref] >= 0} {
1.773 + return $ref
1.774 + }
1.775 + }
1.776 + regexp.n {
1.777 + if {[lsearch {string} $lref] >= 0} {
1.778 + return $ref
1.779 + }
1.780 + }
1.781 + source.n {
1.782 + if {[lsearch {text} $lref] >= 0} {
1.783 + return $ref
1.784 + }
1.785 + }
1.786 + history.n {
1.787 + if {[lsearch {exec} $lref] >= 0} {
1.788 + return $ref
1.789 + }
1.790 + }
1.791 + return.n {
1.792 + if {[lsearch {error continue break} $lref] >= 0} {
1.793 + return $ref
1.794 + }
1.795 + }
1.796 + scrollbar.n {
1.797 + if {[lsearch {set} $lref] >= 0} {
1.798 + return $ref
1.799 + }
1.800 + }
1.801 + }
1.802 + ##
1.803 + ## return the cross reference
1.804 + ##
1.805 + return "<A HREF=\"../$manual(name-$lref).htm\">$ref</A>"
1.806 +}
1.807 +##
1.808 +## reference generation errors
1.809 +##
1.810 +proc reference-error {msg text} {
1.811 + global manual
1.812 + puts stderr "$manual(tail): $msg: {$text}"
1.813 + return $text
1.814 +}
1.815 +##
1.816 +## insert as many cross references into this text string as are appropriate
1.817 +##
1.818 +proc insert-cross-references {text} {
1.819 + global manual
1.820 + ##
1.821 + ## we identify cross references by:
1.822 + ## ``quotation''
1.823 + ## <B>emboldening</B>
1.824 + ## Tcl_ prefix
1.825 + ## Tk_ prefix
1.826 + ## [a-zA-Z0-9]+ manual entry
1.827 + ## and we avoid messing with already anchored text
1.828 + ##
1.829 + ##
1.830 + ## find where each item lives
1.831 + ##
1.832 + array set offset [list \
1.833 + anchor [string first {<A } $text] \
1.834 + end-anchor [string first {</A>} $text] \
1.835 + quote [string first {``} $text] \
1.836 + end-quote [string first {''} $text] \
1.837 + bold [string first {<B>} $text] \
1.838 + end-bold [string first {</B>} $text] \
1.839 + tcl [string first {Tcl_} $text] \
1.840 + tk [string first {Tk_} $text] \
1.841 + Tcl1 [string first {Tcl manual entry} $text] \
1.842 + Tcl2 [string first {Tcl overview manual entry} $text] \
1.843 + ]
1.844 + ##
1.845 + ## accumulate a list
1.846 + ##
1.847 + foreach name [array names offset] {
1.848 + if {$offset($name) >= 0} {
1.849 + set invert($offset($name)) $name
1.850 + lappend offsets $offset($name)
1.851 + }
1.852 + }
1.853 + ##
1.854 + ## if nothing, then we're done.
1.855 + ##
1.856 + if {![info exists offsets]} {
1.857 + return $text
1.858 + }
1.859 + ##
1.860 + ## sort the offsets
1.861 + ##
1.862 + set offsets [lsort -integer $offsets]
1.863 + ##
1.864 + ## see which we want to use
1.865 + ##
1.866 + switch -exact $invert([lindex $offsets 0]) {
1.867 + anchor {
1.868 + if {$offset(end-anchor) < 0} {
1.869 + return [reference-error {Missing end anchor} $text]
1.870 + }
1.871 + set head [string range $text 0 $offset(end-anchor)]
1.872 + set tail [string range $text [expr {$offset(end-anchor)+1}] end]
1.873 + return $head[insert-cross-references $tail]
1.874 + }
1.875 + quote {
1.876 + if {$offset(end-quote) < 0} {
1.877 + return [reference-error "Missing end quote" $text]
1.878 + }
1.879 + if {$invert([lindex $offsets 1]) == "tk"} {
1.880 + set offsets [lreplace $offsets 1 1]
1.881 + }
1.882 + if {$invert([lindex $offsets 1]) == "tcl"} {
1.883 + set offsets [lreplace $offsets 1 1]
1.884 + }
1.885 + switch -exact $invert([lindex $offsets 1]) {
1.886 + end-quote {
1.887 + set head [string range $text 0 [expr {$offset(quote)-1}]]
1.888 + set body [string range $text [expr {$offset(quote)+2}] \
1.889 + [expr {$offset(end-quote)-1}]]
1.890 + set tail [string range $text \
1.891 + [expr {$offset(end-quote)+2}] end]
1.892 + return "$head``[cross-reference $body]''[insert-cross-references $tail]"
1.893 + }
1.894 + bold -
1.895 + anchor {
1.896 + set head [string range $text \
1.897 + 0 [expr {$offset(end-quote)+1}]]
1.898 + set tail [string range $text \
1.899 + [expr {$offset(end-quote)+2}] end]
1.900 + return "$head[insert-cross-references $tail]"
1.901 + }
1.902 + }
1.903 + return [reference-error "Uncaught quote case" $text]
1.904 + }
1.905 + bold {
1.906 + if {$offset(end-bold) < 0} { return $text }
1.907 + if {$invert([lindex $offsets 1]) == "tk"} {
1.908 + set offsets [lreplace $offsets 1 1]
1.909 + }
1.910 + if {$invert([lindex $offsets 1]) == "tcl"} {
1.911 + set offsets [lreplace $offsets 1 1]
1.912 + }
1.913 + switch -exact $invert([lindex $offsets 1]) {
1.914 + end-bold {
1.915 + set head [string range $text 0 [expr {$offset(bold)-1}]]
1.916 + set body [string range $text [expr {$offset(bold)+3}] \
1.917 + [expr {$offset(end-bold)-1}]]
1.918 + set tail [string range $text \
1.919 + [expr {$offset(end-bold)+4}] end]
1.920 + return "$head<B>[cross-reference $body]</B>[insert-cross-references $tail]"
1.921 + }
1.922 + anchor {
1.923 + set head [string range $text \
1.924 + 0 [expr {$offset(end-bold)+3}]]
1.925 + set tail [string range $text \
1.926 + [expr {$offset(end-bold)+4}] end]
1.927 + return "$head[insert-cross-references $tail]"
1.928 + }
1.929 + }
1.930 + return [reference-error "Uncaught bold case" $text]
1.931 + }
1.932 + tk {
1.933 + set head [string range $text 0 [expr {$offset(tk)-1}]]
1.934 + set tail [string range $text $offset(tk) end]
1.935 + if {![regexp {^(Tk_\w+)(.*)$} $tail all body tail]} {
1.936 + return [reference-error "Tk regexp failed" $text]
1.937 + }
1.938 + return $head[cross-reference $body][insert-cross-references $tail]
1.939 + }
1.940 + tcl {
1.941 + set head [string range $text 0 [expr {$offset(tcl)-1}]]
1.942 + set tail [string range $text $offset(tcl) end]
1.943 + if {![regexp {^(Tcl_\w+)(.*)$} $tail all body tail]} {
1.944 + return [reference-error {Tcl regexp failed} $text]
1.945 + }
1.946 + return $head[cross-reference $body][insert-cross-references $tail]
1.947 + }
1.948 + Tcl1 -
1.949 + Tcl2 {
1.950 + set off [lindex $offsets 0]
1.951 + set head [string range $text 0 [expr {$off-1}]]
1.952 + set body Tcl
1.953 + set tail [string range $text [expr {$off+3}] end]
1.954 + return $head[cross-reference $body][insert-cross-references $tail]
1.955 + }
1.956 + end-anchor -
1.957 + end-bold -
1.958 + end-quote {
1.959 + return [reference-error "Out of place $invert([lindex $offsets 0])" $text]
1.960 + }
1.961 + }
1.962 +}
1.963 +##
1.964 +## process formatting directives
1.965 +##
1.966 +proc output-directive {line} {
1.967 + global manual
1.968 + # process format directive
1.969 + split-directive $line code rest
1.970 + switch -exact $code {
1.971 + .BS -
1.972 + .BE {
1.973 + # man-puts <HR>
1.974 + }
1.975 + .SH - .SS {
1.976 + # drain any open lists
1.977 + # announce the subject
1.978 + set manual(section) $rest
1.979 + # start our own stack of stuff
1.980 + set manual($manual(name)-$manual(section)) {}
1.981 + lappend manual(has-$manual(section)) $manual(name)
1.982 + if {[string compare .SS $code]} {
1.983 + man-puts "<H3>[long-toc $manual(section)]</H3>"
1.984 + } else {
1.985 + man-puts "<H4>[long-toc $manual(section)]</H4>"
1.986 + }
1.987 + # some sections can simply free wheel their way through the text
1.988 + # some sections can be processed in their own loops
1.989 + switch -exact $manual(section) {
1.990 + NAME {
1.991 + if {[lsearch {CrtImgType.3 CrtItemType.3 CrtPhImgFmt.3} $manual(tail)] >= 0} {
1.992 + # these manual pages have two NAME sections
1.993 + if {[info exists manual($manual(tail)-NAME)]} {
1.994 + return
1.995 + }
1.996 + set manual($manual(tail)-NAME) 1
1.997 + }
1.998 + set names {}
1.999 + while {1} {
1.1000 + set line [next-text]
1.1001 + if {[is-a-directive $line]} {
1.1002 + backup-text 1
1.1003 + output-name [join $names { }]
1.1004 + return
1.1005 + } else {
1.1006 + lappend names [string trim $line]
1.1007 + }
1.1008 + }
1.1009 + }
1.1010 + SYNOPSIS {
1.1011 + lappend manual(section-toc) <DL>
1.1012 + while {1} {
1.1013 + if {[next-op-is .nf rest]
1.1014 + || [next-op-is .br rest]
1.1015 + || [next-op-is .fi rest]} {
1.1016 + continue
1.1017 + }
1.1018 + if {[next-op-is .SH rest]
1.1019 + || [next-op-is .SS rest]
1.1020 + || [next-op-is .BE rest]
1.1021 + || [next-op-is .SO rest]} {
1.1022 + backup-text 1
1.1023 + break
1.1024 + }
1.1025 + if {[next-op-is .sp rest]} {
1.1026 + #man-puts <P>
1.1027 + continue
1.1028 + }
1.1029 + set more [next-text]
1.1030 + if {[is-a-directive $more]} {
1.1031 + manerror "in SYNOPSIS found $more"
1.1032 + backup-text 1
1.1033 + break
1.1034 + } else {
1.1035 + foreach more [split $more \n] {
1.1036 + man-puts $more<BR>
1.1037 + if {[lsearch {TclLib TkLib} $manual(wing-file)] < 0} {
1.1038 + lappend manual(section-toc) <DD>$more
1.1039 + }
1.1040 + }
1.1041 + }
1.1042 + }
1.1043 + lappend manual(section-toc) </DL>
1.1044 + return
1.1045 + }
1.1046 + {SEE ALSO} {
1.1047 + while {[more-text]} {
1.1048 + if {[next-op-is .SH rest] || [next-op-is .SS rest]} {
1.1049 + backup-text 1
1.1050 + return
1.1051 + }
1.1052 + set more [next-text]
1.1053 + if {[is-a-directive $more]} {
1.1054 + manerror "$more"
1.1055 + backup-text 1
1.1056 + return
1.1057 + }
1.1058 + set nmore {}
1.1059 + foreach cr [split $more ,] {
1.1060 + set cr [string trim $cr]
1.1061 + if {![regexp {^<B>.*</B>$} $cr]} {
1.1062 + set cr <B>$cr</B>
1.1063 + }
1.1064 + if {[regexp {^<B>(.*)\([13n]\)</B>$} $cr all name]} {
1.1065 + set cr <B>$name</B>
1.1066 + }
1.1067 + lappend nmore $cr
1.1068 + }
1.1069 + man-puts [join $nmore {, }]
1.1070 + }
1.1071 + return
1.1072 + }
1.1073 + KEYWORDS {
1.1074 + while {[more-text]} {
1.1075 + if {[next-op-is .SH rest] || [next-op-is .SS rest]} {
1.1076 + backup-text 1
1.1077 + return
1.1078 + }
1.1079 + set more [next-text]
1.1080 + if {[is-a-directive $more]} {
1.1081 + manerror "$more"
1.1082 + backup-text 1
1.1083 + return
1.1084 + }
1.1085 + set keys {}
1.1086 + foreach key [split $more ,] {
1.1087 + set key [string trim $key]
1.1088 + lappend manual(keyword-$key) [list $manual(name) $manual(wing-file)/$manual(name).htm]
1.1089 + set initial [string toupper [string index $key 0]]
1.1090 + lappend keys "<A href=\"../Keywords/$initial.htm\#$key\">$key</A>"
1.1091 + }
1.1092 + man-puts [join $keys {, }]
1.1093 + }
1.1094 + return
1.1095 + }
1.1096 + }
1.1097 + if {[next-op-is .IP rest]} {
1.1098 + output-IP-list $code .IP $rest
1.1099 + return
1.1100 + }
1.1101 + if {[next-op-is .PP rest]} {
1.1102 + return
1.1103 + }
1.1104 + return
1.1105 + }
1.1106 + .SO {
1.1107 + if {[match-text @stuff .SE]} {
1.1108 + output-directive {.SH STANDARD OPTIONS}
1.1109 + set opts {}
1.1110 + foreach line [split $stuff \n] {
1.1111 + foreach option [split $line \t] {
1.1112 + lappend opts $option
1.1113 + }
1.1114 + }
1.1115 + man-puts <DL>
1.1116 + lappend manual(section-toc) <DL>
1.1117 + foreach option [lsort $opts] {
1.1118 + man-puts "<DT><B>[std-option-toc $option]</B>"
1.1119 + }
1.1120 + man-puts </DL>
1.1121 + lappend manual(section-toc) </DL>
1.1122 + } else {
1.1123 + manerror "unexpected .SO format:\n[expand-next-text 2]"
1.1124 + }
1.1125 + }
1.1126 + .OP {
1.1127 + output-widget-options $rest
1.1128 + return
1.1129 + }
1.1130 + .IP {
1.1131 + output-IP-list .IP .IP $rest
1.1132 + return
1.1133 + }
1.1134 + .PP {
1.1135 + man-puts <P>
1.1136 + }
1.1137 + .RS {
1.1138 + output-RS-list
1.1139 + return
1.1140 + }
1.1141 + .RE {
1.1142 + manerror "unexpected .RE"
1.1143 + return
1.1144 + }
1.1145 + .br {
1.1146 + man-puts <BR>
1.1147 + return
1.1148 + }
1.1149 + .DE {
1.1150 + manerror "unexpected .DE"
1.1151 + return
1.1152 + }
1.1153 + .DS {
1.1154 + if {[next-op-is .ta rest]} {
1.1155 +
1.1156 + }
1.1157 + if {[match-text @stuff .DE]} {
1.1158 + man-puts <PRE>$stuff</PRE>
1.1159 + } elseif {[match-text .fi @ul1 @ul2 .nf @stuff .DE]} {
1.1160 + man-puts "<PRE>[lindex $ul1 1][lindex $ul2 1]\n$stuff</PRE>"
1.1161 + } else {
1.1162 + manerror "unexpected .DS format:\n[expand-next-text 2]"
1.1163 + }
1.1164 + return
1.1165 + }
1.1166 + .CS {
1.1167 + if {[next-op-is .ta rest]} {
1.1168 +
1.1169 + }
1.1170 + if {[match-text @stuff .CE]} {
1.1171 + man-puts <PRE>$stuff</PRE>
1.1172 + } else {
1.1173 + manerror "unexpected .CS format:\n[expand-next-text 2]"
1.1174 + }
1.1175 + return
1.1176 + }
1.1177 + .CE {
1.1178 + manerror "unexpected .CE"
1.1179 + return
1.1180 + }
1.1181 + .sp {
1.1182 + man-puts <P>
1.1183 + }
1.1184 + .ta {
1.1185 + # these are tab stop settings for short tables
1.1186 + switch -exact $manual(name):$manual(section) {
1.1187 + {bind:MODIFIERS} -
1.1188 + {bind:EVENT TYPES} -
1.1189 + {bind:BINDING SCRIPTS AND SUBSTITUTIONS} -
1.1190 + {expr:OPERANDS} -
1.1191 + {expr:MATH FUNCTIONS} -
1.1192 + {history:DESCRIPTION} -
1.1193 + {history:HISTORY REVISION} -
1.1194 + {re_syntax:BRACKET EXPRESSIONS} -
1.1195 + {switch:DESCRIPTION} -
1.1196 + {upvar:DESCRIPTION} {
1.1197 + return; # fix.me
1.1198 + }
1.1199 + default {
1.1200 + manerror "ignoring $line"
1.1201 + }
1.1202 + }
1.1203 + }
1.1204 + .nf {
1.1205 + if {[match-text @more .fi]} {
1.1206 + foreach more [split $more \n] {
1.1207 + man-puts $more<BR>
1.1208 + }
1.1209 + } elseif {[match-text .RS @more .RE .fi]} {
1.1210 + man-puts <DL><DD>
1.1211 + foreach more [split $more \n] {
1.1212 + man-puts $more<BR>
1.1213 + }
1.1214 + man-puts </DL>
1.1215 + } elseif {[match-text .RS @more .RS @more2 .RE .RE .fi]} {
1.1216 + man-puts <DL><DD>
1.1217 + foreach more [split $more \n] {
1.1218 + man-puts $more<BR>
1.1219 + }
1.1220 + man-puts <DL><DD>
1.1221 + foreach more2 [split $more2 \n] {
1.1222 + man-puts $more2<BR>
1.1223 + }
1.1224 + man-puts </DL></DL>
1.1225 + } elseif {[match-text .RS @more .RS @more2 .RE @more3 .RE .fi]} {
1.1226 + man-puts <DL><DD>
1.1227 + foreach more [split $more \n] {
1.1228 + man-puts $more<BR>
1.1229 + }
1.1230 + man-puts <DL><DD>
1.1231 + foreach more2 [split $more2 \n] {
1.1232 + man-puts $more2<BR>
1.1233 + }
1.1234 + man-puts </DL><DD>
1.1235 + foreach more3 [split $more3 \n] {
1.1236 + man-puts $more3<BR>
1.1237 + }
1.1238 + man-puts </DL>
1.1239 + } elseif {[match-text .sp .RS @more .RS @more2 .sp .RE .RE .fi]} {
1.1240 + man-puts <P><DL><DD>
1.1241 + foreach more [split $more \n] {
1.1242 + man-puts $more<BR>
1.1243 + }
1.1244 + man-puts <DL><DD>
1.1245 + foreach more2 [split $more2 \n] {
1.1246 + man-puts $more2<BR>
1.1247 + }
1.1248 + man-puts </DL></DL><P>
1.1249 + } elseif {[match-text .RS .sp @more .sp .RE .fi]} {
1.1250 + man-puts <P><DL><DD>
1.1251 + foreach more [split $more \n] {
1.1252 + man-puts $more<BR>
1.1253 + }
1.1254 + man-puts </DL><P>
1.1255 + } else {
1.1256 + manerror "ignoring $line"
1.1257 + }
1.1258 + }
1.1259 + .fi {
1.1260 + manerror "ignoring $line"
1.1261 + }
1.1262 + .na -
1.1263 + .ad -
1.1264 + .UL -
1.1265 + .ne {
1.1266 + manerror "ignoring $line"
1.1267 + }
1.1268 + default {
1.1269 + manerror "unrecognized format directive: $line"
1.1270 + }
1.1271 + }
1.1272 +}
1.1273 +##
1.1274 +## merge copyright listings
1.1275 +##
1.1276 +proc merge-copyrights {l1 l2} {
1.1277 + foreach copyright [concat $l1 $l2] {
1.1278 + if {[regexp {^Copyright +\(c\) +(\d+) +(by +)?(\w.*)$} $copyright all date by who]} {
1.1279 + lappend dates($who) $date
1.1280 + continue
1.1281 + }
1.1282 + if {[regexp {^Copyright +\(c\) +(\d+)-(\d+) +(by +)?(\w.*)$} $copyright all from to by who]} {
1.1283 + for {set date $from} {$date <= $to} {incr date} {
1.1284 + lappend dates($who) $date
1.1285 + }
1.1286 + continue
1.1287 + }
1.1288 + if {[regexp {^Copyright +\(c\) +(\d+), *(\d+) +(by +)?(\w.*)$} $copyright all date1 date2 by who]} {
1.1289 + lappend dates($who) $date1 $date2
1.1290 + continue
1.1291 + }
1.1292 + puts "oops: $copyright"
1.1293 + }
1.1294 + foreach who [array names dates] {
1.1295 + set list [lsort $dates($who)]
1.1296 + if {[llength $list] == 1 || [lindex $list 0] == [lrange $list end end]} {
1.1297 + lappend merge "Copyright (c) [lindex $list 0] $who"
1.1298 + } else {
1.1299 + lappend merge "Copyright (c) [lindex $list 0]-[lrange $list end end] $who"
1.1300 + }
1.1301 + }
1.1302 + return [lsort $merge]
1.1303 +}
1.1304 +
1.1305 +proc makedirhier {dir} {
1.1306 + if {![file isdirectory $dir] && \
1.1307 + [catch {file mkdir $dir} error]} {
1.1308 + return -code error "cannot create directory $dir: $error"
1.1309 + }
1.1310 +}
1.1311 +
1.1312 +##
1.1313 +## foreach of the man directories specified by args
1.1314 +## convert manpages into hypertext in the directory
1.1315 +## specified by html.
1.1316 +##
1.1317 +proc make-man-pages {html args} {
1.1318 + global env manual overall_title tcltkdesc
1.1319 + makedirhier $html
1.1320 + set manual(short-toc-n) 1
1.1321 + set manual(short-toc-fp) [open $html/contents.htm w]
1.1322 + puts $manual(short-toc-fp) "<HTML><HEAD><TITLE>$overall_title</TITLE></HEAD>"
1.1323 + puts $manual(short-toc-fp) "<BODY><HR><H3>$overall_title</H3><HR><DL>"
1.1324 + set manual(merge-copyrights) {}
1.1325 + foreach arg $args {
1.1326 + if {$arg == ""} {continue}
1.1327 + set manual(wing-glob) [lindex $arg 0]
1.1328 + set manual(wing-name) [lindex $arg 1]
1.1329 + set manual(wing-file) [lindex $arg 2]
1.1330 + set manual(wing-description) [lindex $arg 3]
1.1331 + set manual(wing-copyrights) {}
1.1332 + makedirhier $html/$manual(wing-file)
1.1333 + set manual(wing-toc-fp) [open $html/$manual(wing-file)/contents.htm w]
1.1334 + # whistle
1.1335 + puts stderr "scanning section $manual(wing-name)"
1.1336 + # put the entry for this section into the short table of contents
1.1337 + puts $manual(short-toc-fp) "<DT><A HREF=\"$manual(wing-file)/contents.htm\">$manual(wing-name)</A><DD>$manual(wing-description)"
1.1338 + # initialize the wing table of contents
1.1339 + puts $manual(wing-toc-fp) "<HTML><HEAD><TITLE>$manual(wing-name) Manual</TITLE></HEAD>"
1.1340 + puts $manual(wing-toc-fp) "<BODY><HR><H3>$manual(wing-name)</H3><HR>"
1.1341 + # initialize the short table of contents for this section
1.1342 + set manual(wing-toc) {}
1.1343 + # initialize the man directory for this section
1.1344 + makedirhier $html/$manual(wing-file)
1.1345 + # initialize the long table of contents for this section
1.1346 + set manual(long-toc-n) 1
1.1347 + # get the manual pages for this section
1.1348 + set manual(pages) [lsort [glob $manual(wing-glob)]]
1.1349 + if {[lsearch -glob $manual(pages) */options.n] >= 0} {
1.1350 + set n [lsearch $manual(pages) */options.n]
1.1351 + set manual(pages) "[lindex $manual(pages) $n] [lreplace $manual(pages) $n $n]"
1.1352 + }
1.1353 + # set manual(pages) [lrange $manual(pages) 0 5]
1.1354 + foreach manual(page) $manual(pages) {
1.1355 + # whistle
1.1356 + puts stderr "scanning page $manual(page)"
1.1357 + set manual(tail) [file tail $manual(page)]
1.1358 + set manual(name) [file root $manual(tail)]
1.1359 + set manual(section) {}
1.1360 + if {[lsearch {case pack-old menubar} $manual(name)] >= 0} {
1.1361 + # obsolete
1.1362 + manerror "discarding $manual(name)"
1.1363 + continue
1.1364 + }
1.1365 + set manual(infp) [open $manual(page)]
1.1366 + set manual(text) {}
1.1367 + set manual(partial-text) {}
1.1368 + foreach p {.RS .DS .CS .SO} {
1.1369 + set manual($p) 0
1.1370 + }
1.1371 + set manual(stack) {}
1.1372 + set manual(section) {}
1.1373 + set manual(section-toc) {}
1.1374 + set manual(section-toc-n) 1
1.1375 + set manual(copyrights) {}
1.1376 + lappend manual(all-pages) $manual(wing-file)/$manual(tail)
1.1377 + manreport 100 $manual(name)
1.1378 + while {[gets $manual(infp) line] >= 0} {
1.1379 + manreport 100 $line
1.1380 + if {[regexp {^[`'][/\\]} $line]} {
1.1381 + if {[regexp {Copyright \(c\).*$} $line copyright]} {
1.1382 + lappend manual(copyrights) $copyright
1.1383 + }
1.1384 + # comment
1.1385 + continue
1.1386 + }
1.1387 + if {"$line" == {'}} {
1.1388 + # comment
1.1389 + continue
1.1390 + }
1.1391 + if {[parse-directive $line code rest]} {
1.1392 + switch -exact $code {
1.1393 + .ad - .na - .so - .ne - .AS - .VE - .VS -
1.1394 + . {
1.1395 + # ignore
1.1396 + continue
1.1397 + }
1.1398 + }
1.1399 + if {"$manual(partial-text)" != {}} {
1.1400 + lappend manual(text) [process-text $manual(partial-text)]
1.1401 + set manual(partial-text) {}
1.1402 + }
1.1403 + switch -exact $code {
1.1404 + .SH - .SS {
1.1405 + if {[llength $rest] == 0} {
1.1406 + gets $manual(infp) rest
1.1407 + }
1.1408 + lappend manual(text) "$code [unquote $rest]"
1.1409 + }
1.1410 + .TH {
1.1411 + lappend manual(text) "$code [unquote $rest]"
1.1412 + }
1.1413 + .HS - .UL -
1.1414 + .ta {
1.1415 + lappend manual(text) "$code [unquote $rest]"
1.1416 + }
1.1417 + .BS - .BE - .br - .fi - .sp -
1.1418 + .nf {
1.1419 + if {"$rest" != {}} {
1.1420 + manerror "unexpected argument: $line"
1.1421 + }
1.1422 + lappend manual(text) $code
1.1423 + }
1.1424 + .AP {
1.1425 + lappend manual(text) [concat .IP [process-text "[lindex $rest 0] \\fB[lindex $rest 1]\\fR ([lindex $rest 2])"]]
1.1426 + }
1.1427 + .IP {
1.1428 + regexp {^(.*) +\d+$} $rest all rest
1.1429 + lappend manual(text) ".IP [process-text [unquote [string trim $rest]]]"
1.1430 + }
1.1431 + .TP {
1.1432 + while {[is-a-directive [set next [gets $manual(infp)]]]} {
1.1433 + manerror "ignoring $next after .TP"
1.1434 + }
1.1435 + if {"$next" != {'}} {
1.1436 + lappend manual(text) ".IP [process-text $next]"
1.1437 + }
1.1438 + }
1.1439 + .OP {
1.1440 + lappend manual(text) [concat .OP [process-text \
1.1441 + "\\fB[lindex $rest 0]\\fR \\fB[lindex $rest 1]\\fR \\fB[lindex $rest 2]\\fR"]]
1.1442 + }
1.1443 + .PP -
1.1444 + .LP {
1.1445 + lappend manual(text) {.PP}
1.1446 + }
1.1447 + .RS {
1.1448 + incr manual(.RS)
1.1449 + lappend manual(text) $code
1.1450 + }
1.1451 + .RE {
1.1452 + incr manual(.RS) -1
1.1453 + lappend manual(text) $code
1.1454 + }
1.1455 + .SO {
1.1456 + incr manual(.SO)
1.1457 + lappend manual(text) $code
1.1458 + }
1.1459 + .SE {
1.1460 + incr manual(.SO) -1
1.1461 + lappend manual(text) $code
1.1462 + }
1.1463 + .DS {
1.1464 + incr manual(.DS)
1.1465 + lappend manual(text) $code
1.1466 + }
1.1467 + .DE {
1.1468 + incr manual(.DS) -1
1.1469 + lappend manual(text) $code
1.1470 + }
1.1471 + .CS {
1.1472 + incr manual(.CS)
1.1473 + lappend manual(text) $code
1.1474 + }
1.1475 + .CE {
1.1476 + incr manual(.CS) -1
1.1477 + lappend manual(text) $code
1.1478 + }
1.1479 + .de {
1.1480 + while {[gets $manual(infp) line] >= 0} {
1.1481 + if {[string match "..*" $line]} {
1.1482 + break
1.1483 + }
1.1484 + }
1.1485 + }
1.1486 + .. {
1.1487 + error "found .. outside of .de"
1.1488 + }
1.1489 + default {
1.1490 + manerror "unrecognized format directive: $line"
1.1491 + }
1.1492 + }
1.1493 + } else {
1.1494 + if {$manual(partial-text) == ""} {
1.1495 + set manual(partial-text) $line
1.1496 + } else {
1.1497 + append manual(partial-text) \n$line
1.1498 + }
1.1499 + }
1.1500 + }
1.1501 + if {$manual(partial-text) != ""} {
1.1502 + lappend manual(text) [process-text $manual(partial-text)]
1.1503 + }
1.1504 + close $manual(infp)
1.1505 + # fixups
1.1506 + if {$manual(.RS) != 0} {
1.1507 + if {$manual(name) != "selection"} {
1.1508 + puts "unbalanced .RS .RE"
1.1509 + }
1.1510 + }
1.1511 + if {$manual(.DS) != 0} {
1.1512 + puts "unbalanced .DS .DE"
1.1513 + }
1.1514 + if {$manual(.CS) != 0} {
1.1515 + puts "unbalanced .CS .CE"
1.1516 + }
1.1517 + if {$manual(.SO) != 0} {
1.1518 + puts "unbalanced .SO .SE"
1.1519 + }
1.1520 + # output conversion
1.1521 + open-text
1.1522 + if {[next-op-is .HS rest]} {
1.1523 + set manual($manual(name)-title) \
1.1524 + "[lrange $rest 1 end] [lindex $rest 0] manual page"
1.1525 + while {[more-text]} {
1.1526 + set line [next-text]
1.1527 + if {[is-a-directive $line]} {
1.1528 + output-directive $line
1.1529 + } else {
1.1530 + man-puts $line
1.1531 + }
1.1532 + }
1.1533 + man-puts <HR><PRE>
1.1534 + foreach copyright $manual(copyrights) {
1.1535 + man-puts "<A HREF=\"../copyright.htm\">Copyright</A> © [lrange $copyright 2 end]"
1.1536 + }
1.1537 + man-puts "<A HREF=\"../copyright.htm\">Copyright</A> © 1995-1997 Roger E. Critchlow Jr.</PRE>"
1.1538 + set manual(wing-copyrights) [merge-copyrights $manual(wing-copyrights) $manual(copyrights)]
1.1539 + } elseif {[next-op-is .TH rest]} {
1.1540 + set manual($manual(name)-title) "[lrange $rest 4 end] - [lindex $rest 0] manual page"
1.1541 + while {[more-text]} {
1.1542 + set line [next-text]
1.1543 + if {[is-a-directive $line]} {
1.1544 + output-directive $line
1.1545 + } else {
1.1546 + man-puts $line
1.1547 + }
1.1548 + }
1.1549 + man-puts <HR><PRE>
1.1550 + foreach copyright $manual(copyrights) {
1.1551 + man-puts "<A HREF=\"../copyright.htm\">Copyright</A> © [lrange $copyright 2 end]"
1.1552 + }
1.1553 + man-puts "<A HREF=\"../copyright.htm\">Copyright</A> © 1995-1997 Roger E. Critchlow Jr.</PRE>"
1.1554 + set manual(wing-copyrights) [merge-copyrights $manual(wing-copyrights) $manual(copyrights)]
1.1555 + } else {
1.1556 + manerror "no .HS or .TH record found"
1.1557 + }
1.1558 + #
1.1559 + # make the long table of contents for this page
1.1560 + #
1.1561 + set manual(toc-$manual(wing-file)-$manual(name)) [concat <DL> $manual(section-toc) </DL><HR>]
1.1562 + }
1.1563 +
1.1564 + #
1.1565 + # make the wing table of contents for the section
1.1566 + #
1.1567 + set width 0
1.1568 + foreach name $manual(wing-toc) {
1.1569 + if {[string length $name] > $width} {
1.1570 + set width [string length $name]
1.1571 + }
1.1572 + }
1.1573 + set perline [expr {120 / $width}]
1.1574 + set nrows [expr {([llength $manual(wing-toc)]+$perline)/$perline}]
1.1575 + set n 0
1.1576 + catch {unset rows}
1.1577 + foreach name [lsort $manual(wing-toc)] {
1.1578 + set tail $manual(name-$name)
1.1579 + if {[llength $tail] > 1} {
1.1580 + manerror "$name is defined in more than one file: $tail"
1.1581 + set tail [lindex $tail [expr {[llength $tail]-1}]]
1.1582 + }
1.1583 + set tail [file tail $tail]
1.1584 + append rows([expr {$n%$nrows}]) \
1.1585 + "<td> <a href=\"$tail.htm\">$name</a>"
1.1586 + incr n
1.1587 + }
1.1588 + puts $manual(wing-toc-fp) <table>
1.1589 + foreach row [lsort -integer [array names rows]] {
1.1590 + puts $manual(wing-toc-fp) <tr>$rows($row)</tr>
1.1591 + }
1.1592 + puts $manual(wing-toc-fp) </table>
1.1593 +
1.1594 + #
1.1595 + # insert wing copyrights
1.1596 + #
1.1597 + puts $manual(wing-toc-fp) "<HR><PRE>"
1.1598 + foreach copyright $manual(wing-copyrights) {
1.1599 + puts $manual(wing-toc-fp) "<A HREF=\"../copyright.htm\">Copyright</A> © [lrange $copyright 2 end]"
1.1600 + }
1.1601 + puts $manual(wing-toc-fp) "<A HREF=\"../copyright.htm\">Copyright</A> © 1995-1997 Roger E. Critchlow Jr."
1.1602 + puts $manual(wing-toc-fp) "</PRE></BODY></HTML>"
1.1603 + close $manual(wing-toc-fp)
1.1604 + set manual(merge-copyrights) [merge-copyrights $manual(merge-copyrights) $manual(wing-copyrights)]
1.1605 + }
1.1606 +
1.1607 + ##
1.1608 + ## build the keyword index.
1.1609 + ##
1.1610 + proc strcasecmp {a b} { return [string compare -nocase $a $b] }
1.1611 + set keys [lsort -command strcasecmp [array names manual keyword-*]]
1.1612 + makedirhier $html/Keywords
1.1613 + catch {eval file delete -- [glob $html/Keywords/*]}
1.1614 + puts $manual(short-toc-fp) "<DT><A HREF=\"Keywords/contents.htm\">Keywords</A><DD>The keywords from the $tcltkdesc man pages."
1.1615 + set keyfp [open $html/Keywords/contents.htm w]
1.1616 + puts $keyfp "<HTML><HEAD><TITLE>$tcltkdesc Keywords</TITLE></HEAD>"
1.1617 + puts $keyfp "<BODY><HR><H3>$tcltkdesc Keywords</H3><HR><H2>"
1.1618 + 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} {
1.1619 + puts $keyfp "<A HREF=\"$a.htm\">$a</A>"
1.1620 + set afp [open $html/Keywords/$a.htm w]
1.1621 + puts $afp "<HTML><HEAD><TITLE>$tcltkdesc Keywords - $a</TITLE></HEAD>"
1.1622 + puts $afp "<BODY><HR><H3>$tcltkdesc Keywords - $a</H3><HR><H2>"
1.1623 + 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} {
1.1624 + puts $afp "<A HREF=\"$b.htm\">$b</A>"
1.1625 + }
1.1626 + puts $afp "</H2><HR><DL>"
1.1627 + foreach k $keys {
1.1628 + if {[string match -nocase "keyword-${a}*" $k]} {
1.1629 + set k [string range $k 8 end]
1.1630 + puts $afp "<DT><A NAME=\"$k\">$k</A><DD>"
1.1631 + set refs {}
1.1632 + foreach man $manual(keyword-$k) {
1.1633 + set name [lindex $man 0]
1.1634 + set file [lindex $man 1]
1.1635 + lappend refs "<A HREF=\"../$file\">$name</A>"
1.1636 + }
1.1637 + puts $afp [join $refs {, }]
1.1638 + }
1.1639 + }
1.1640 + puts $afp "</DL><HR><PRE>"
1.1641 + # insert merged copyrights
1.1642 + foreach copyright $manual(merge-copyrights) {
1.1643 + puts $afp "<A HREF=\"copyright.htm\">Copyright</A> © [lrange $copyright 2 end]"
1.1644 + }
1.1645 + puts $afp "<A HREF=\"copyright.htm\">Copyright</A> © 1995-1997 Roger E. Critchlow Jr."
1.1646 + puts $afp "</PRE></BODY></HTML>"
1.1647 + close $afp
1.1648 + }
1.1649 + puts $keyfp "</H2><HR><PRE>"
1.1650 +
1.1651 + # insert merged copyrights
1.1652 + foreach copyright $manual(merge-copyrights) {
1.1653 + puts $keyfp "<A HREF=\"copyright.htm\">Copyright</A> © [lrange $copyright 2 end]"
1.1654 + }
1.1655 + puts $keyfp "<A HREF=\"copyright.htm\">Copyright</A> © 1995-1997 Roger E. Critchlow Jr."
1.1656 + puts $keyfp </PRE><HR></BODY></HTML>
1.1657 + close $keyfp
1.1658 +
1.1659 + ##
1.1660 + ## finish off short table of contents
1.1661 + ##
1.1662 + puts $manual(short-toc-fp) {<DT><A HREF="http://www.elf.org">Source</A><DD>More information about these man pages.}
1.1663 + puts $manual(short-toc-fp) "</DL><HR><PRE>"
1.1664 + # insert merged copyrights
1.1665 + foreach copyright $manual(merge-copyrights) {
1.1666 + puts $manual(short-toc-fp) "<A HREF=\"copyright.htm\">Copyright</A> © [lrange $copyright 2 end]"
1.1667 + }
1.1668 + puts $manual(short-toc-fp) "<A HREF=\"copyright.htm\">Copyright</A> © 1995-1997 Roger E. Critchlow Jr."
1.1669 + puts $manual(short-toc-fp) "</PRE></BODY></HTML>"
1.1670 + close $manual(short-toc-fp)
1.1671 +
1.1672 + ##
1.1673 + ## output man pages
1.1674 + ##
1.1675 + unset manual(section)
1.1676 + foreach path $manual(all-pages) {
1.1677 + set manual(wing-file) [file dirname $path]
1.1678 + set manual(tail) [file tail $path]
1.1679 + set manual(name) [file root $manual(tail)]
1.1680 + set text $manual(output-$manual(wing-file)-$manual(name))
1.1681 + set ntext 0
1.1682 + foreach item $text {
1.1683 + incr ntext [llength [split $item \n]]
1.1684 + incr ntext
1.1685 + }
1.1686 + set toc $manual(toc-$manual(wing-file)-$manual(name))
1.1687 + set ntoc 0
1.1688 + foreach item $toc {
1.1689 + incr ntoc [llength [split $item \n]]
1.1690 + incr ntoc
1.1691 + }
1.1692 + puts stderr "rescanning page $manual(name) $ntoc/$ntext"
1.1693 + set manual(outfp) [open $html/$manual(wing-file)/$manual(name).htm w]
1.1694 + puts $manual(outfp) "<HTML><HEAD><TITLE>$manual($manual(name)-title)</TITLE></HEAD><BODY>"
1.1695 + if {($ntext > 60) && ($ntoc > 32) || [lsearch {
1.1696 + Hash LinkVar SetVar TraceVar ConfigWidg CrtImgType CrtItemType
1.1697 + CrtPhImgFmt DoOneEvent GetBitmap GetColor GetCursor GetDash
1.1698 + GetJustify GetPixels GetVisual ParseArgv QueueEvent
1.1699 + } $manual(tail)] >= 0} {
1.1700 + foreach item $toc {
1.1701 + puts $manual(outfp) $item
1.1702 + }
1.1703 + }
1.1704 + foreach item $text {
1.1705 + puts $manual(outfp) [insert-cross-references $item]
1.1706 + }
1.1707 + puts $manual(outfp) </BODY></HTML>
1.1708 + close $manual(outfp)
1.1709 + }
1.1710 + return {}
1.1711 +}
1.1712 +
1.1713 +parse_command_line
1.1714 +
1.1715 +set tcltkdesc ""; set cmdesc ""; set appdir ""
1.1716 +if {$build_tcl} {append tcltkdesc "Tcl"; append cmdesc "Tcl"; append appdir "$tcldir"}
1.1717 +if {$build_tcl && $build_tk} {append tcltkdesc "/"; append cmdesc " and "; append appdir ","}
1.1718 +if {$build_tk} {append tcltkdesc "Tk"; append cmdesc "Tk"; append appdir "$tkdir"}
1.1719 +
1.1720 +set usercmddesc "The interpreters which implement $cmdesc."
1.1721 +set tclcmddesc {The commands which the <B>tclsh</B> interpreter implements.}
1.1722 +set tkcmddesc {The additional commands which the <B>wish</B> interpreter implements.}
1.1723 +set tcllibdesc {The C functions which a Tcl extended C program may use.}
1.1724 +set tklibdesc {The additional C functions which a Tk extended C program may use.}
1.1725 +
1.1726 +if {1} {
1.1727 + if {[catch {
1.1728 + make-man-pages $webdir \
1.1729 + "$tcltkdir/{$appdir}/doc/*.1 \"$tcltkdesc Applications\" UserCmd {$usercmddesc}" \
1.1730 + [expr {$build_tcl ? "$tcltkdir/$tcldir/doc/*.n {Tcl Commands} TclCmd {$tclcmddesc}" : ""}] \
1.1731 + [expr {$build_tk ? "$tcltkdir/$tkdir/doc/*.n {Tk Commands} TkCmd {$tkcmddesc}" : ""}] \
1.1732 + [expr {$build_tcl ? "$tcltkdir/$tcldir/doc/*.3 {Tcl Library} TclLib {$tcllibdesc}" : ""}] \
1.1733 + [expr {$build_tk ? "$tcltkdir/$tkdir/doc/*.3 {Tk Library} TkLib {$tklibdesc}" : ""}]
1.1734 + } error]} {
1.1735 + puts $error\n$errorInfo
1.1736 + }
1.1737 +}