diff options
author | hobbs <hobbs> | 1999-12-21 23:59:28 (GMT) |
---|---|---|
committer | hobbs <hobbs> | 1999-12-21 23:59:28 (GMT) |
commit | 671c6e58fccb3a31aaaa79897e8c664ffb21fe82 (patch) | |
tree | 90375e3be8b6d06160b927c509f469b4b085fc89 /tools/tcl8.1-tk8.1-man-html.tcl | |
parent | 569c90e5035bd0fbfc62dfd81479cea91d46fa61 (diff) | |
download | tcl-671c6e58fccb3a31aaaa79897e8c664ffb21fe82.zip tcl-671c6e58fccb3a31aaaa79897e8c664ffb21fe82.tar.gz tcl-671c6e58fccb3a31aaaa79897e8c664ffb21fe82.tar.bz2 |
renamed tcl8.1-tk8.1-man-html.tcl tcltk-man2html.tcl, and rewrote
the internals to use 8.2+ string functions
tcl.wse.in moved to 8.3b1
Diffstat (limited to 'tools/tcl8.1-tk8.1-man-html.tcl')
-rw-r--r-- | tools/tcl8.1-tk8.1-man-html.tcl | 1663 |
1 files changed, 0 insertions, 1663 deletions
diff --git a/tools/tcl8.1-tk8.1-man-html.tcl b/tools/tcl8.1-tk8.1-man-html.tcl deleted file mode 100644 index cb51f34..0000000 --- a/tools/tcl8.1-tk8.1-man-html.tcl +++ /dev/null @@ -1,1663 +0,0 @@ -#!/usr/local/bin/tclsh8.0 -# -# Convert Ousterhout format man pages into highly crosslinked -# hypertext. -# -# Along the way detect many unmatched font changes and other odd -# things. -# -# Note well, this program is a hack rather than a piece of software -# engineering. In that sense it's probably a good example of things -# that a scripting language, like Tcl, can do well. It is offered as -# an example of how someone might convert a specific set of man pages -# into hypertext, not as a general solution to the problem. If you -# try to use this, you'll be very much on your own. -# -# Copyright (c) 1995-1997 Roger E. Critchlow Jr -# -# The authors hereby grant permission to use, copy, modify, distribute, -# and license this software and its documentation for any purpose, provided -# that existing copyright notices are retained in all copies and that this -# notice is included verbatim in any distributions. No written agreement, -# license, or royalty fee is required for any of the authorized uses. -# Modifications to this software may be copyrighted by their authors -# and need not follow the licensing terms described here, provided that -# the new terms are clearly indicated on the first page of each file where -# they apply. -# -# IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY -# FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES -# ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY -# DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE -# POSSIBILITY OF SUCH DAMAGE. -# -# THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES, -# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, -# FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE -# IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE -# NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR -# MODIFICATIONS. -# -# Revisions: -# May 15, 1995 - initial release -# May 16, 1995 - added a back to home link to toplevel table of -# contents. -# May 18, 1995 - broke toplevel table of contents into separate -# pages for each section, and broke long table of contents -# into a one page for each man page. -# Mar 10, 1996 - updated for tcl7.5b3/tk4.1b3 -# Apr 14, 1996 - incorporated command line parsing from Tom Tromey, -# <tromey@creche.cygnus.com> -- thanks Tom. -# - updated for tcl7.5/tk4.1 final release. -# - converted to same copyright as the man pages. -# Sep 14, 1996 - made various modifications for tcl7.6b1/tk4.2b1 -# Oct 18, 1996 - added tcl7.6/tk4.2 to the list of distributions. -# Oct 22, 1996 - major hacking on indentation code and elsewhere. -# Mar 4, 1997 - -# May 28, 1997 - added tcl8.0b1/tk8.0b1 to the list of distributions -# - cleaned source for tclsh8.0 execution -# - renamed output files for windoze installation -# - added spaces to tables -# Oct 24, 1997 - moved from 8.0b1 to 8.0 release -# - -set Version "0.14" - -proc parse_command_line {} { - global argv Version - - # These variables determine where the man pages come from and where - # the converted pages go to. - global tcltkdir tkdir tcldir webdir - - # Set defaults based on original code. - set tcltkdir ../.. - set tkdir {} - set tcldir {} - set webdir ../html - - # Directory names for Tcl and Tk, in priority order. - set tclDirList {tcl8.2 tcl8.1 tcl8.0 tcl tcl7.4 tcl7.5 tcl7.6} - set tkDirList {tk8.2 tk8.1 tk8.0 tk tk4.0 tk4.1 tk4.2} - - # Handle arguments a la GNU: - # --version - # --help - # --srcdir=/path - # --htmldir=/path - - foreach option $argv { - switch -glob -- $option { - --version { - puts "tcltk-man-html $Version" - exit 0 - } - - --help { - puts "usage: tcltk-man-html \[OPTION\] ...\n" - puts " --help print this help, then exit" - puts " --version print version number, then exit" - puts " --srcdir=DIR find tcl and tk source below DIR" - puts " --htmldir=DIR put generated HTML in DIR" - exit 0 - } - - --srcdir=* { - # length of "--srcdir=" is 9. - set tcltkdir [string range $option 9 end] - } - - --htmldir=* { - # length of "--htmldir=" is 10 - set webdir [string range $option 10 end] - } - - default { - puts stderr "tcltk-man-html: unrecognized option -- `$option'" - exit 1 - } - } - } - - # Find Tcl. - foreach dir $tclDirList { - if {[file isdirectory $tcltkdir/$dir]} then { - set tcldir $dir - break - } - } - if {$tcldir == ""} then { - puts stderr "tcltk-man-html: couldn't find Tcl below $tcltkdir" - exit 1 - } - - # Find Tk. - foreach dir $tkDirList { - if {[file isdirectory $tcltkdir/$dir]} then { - set tkdir $dir - break - } - } - if {$tkdir == ""} then { - puts stderr "tcltk-man-html: couldn't find Tk below $tcltkdir" - exit 1 - } - - # the title for the man pages overall - global overall_title - set overall_title "[capitalize $tcldir]/[capitalize $tkdir] Manual" -} - -proc capitalize {string} { - return [string toupper [string index $string 0]][string range $string 1 end] -} - -## -## -## -set manual(report-level) 1; - -proc manerror {msg} { - global manual; - set name {}; - set subj {}; - if {[info exists manual(name)]} { - set name $manual(name); - } - if {[info exists manual(section)] && "$manual(section)" != {}} { - puts stderr "$name: $manual(section): $msg"; - } else { - puts stderr "$name: $msg"; - } -} - -proc manreport {level msg} { - global manual; - if {$level < $manual(report-level)} { - manerror $msg; - } -} - -proc fatal {msg} { - global manual; - manerror $msg; - exit 1; -} -## -## parsing -## -proc unquote arg { - regsub -all \" $arg {} arg; - return $arg; -} - -proc parse-directive {line codename restname} { - upvar $codename code $restname rest; - return [regexp {^(\.[.a-zA-Z0-9]*) *(.*)} $line all code rest]; -} - -proc process-text {text} { - global manual; - # preprocess text - regsub -all {\\&} $text \t text; # some kind of tab? - regsub -all {&} $text {\&} text; - regsub -all {\\\\} $text {\\} text; # reverse solidus, ie backslash - regsub -all {\\ } $text {\ } text; # non breaking space - regsub -all {\\%} $text {} text; # don't break word following? - regsub -all "\\\\\n" $text "\n" text; # - regsub -all \" $text {\"} text; - regsub -all {<} $text {\<} text; - regsub -all {>} $text {\>} text; - regsub -all {\\o'o\^'} $text {\ô} text; # o-circumflex in re_syntax.n - regsub -all {\\-\\\|\\-} $text -- text; # two hyphens - regsub -all -- {\\-\\\^\\-} $text -- text; # two hyphens - regsub -all {\\-} $text - text; # a hyphen - regsub -all {\\0} $text { } text; # a space - regsub -all {\\\|} $text {\ } text; # a very thin space - regsub -all {\\e} $text {\\} text; # reverse solidus, ie backslash - regsub -all {\\\(\+-} $text {\±} text; # plus or minus sign - regsub -all {\\fP} $text {\\fR} text; # a funky font in expr.n - regsub -all {\\\.} $text . text; # a plain . - regsub -all "\\\\\n" $text "\\&\#92;\n" text; # an escaped newline - while {[regexp {\\} $text]} { - # C R - if {[regsub {^([^\\]*)\\fC([^\\]*)\\fR(.*)$} $text {\1<TT>\2</TT>\3} text]} continue - # B R - if {[regsub {^([^\\]*)\\fB([^\\]*)\\fR(.*)$} $text {\1<B>\2</B>\3} text]} continue - # B I - if {[regsub {^([^\\]*)\\fB([^\\]*)\\fI(.*)$} $text {\1<B>\2</B>\\fI\3} text]} continue - # I R - if {[regsub {^([^\\]*)\\fI([^\\]*)\\fR(.*)$} $text {\1<I>\2</I>\3} text]} continue - # I B - if {[regsub {^([^\\]*)\\fI([^\\]*)\\fB(.*)$} $text {\1<I>\2</I>\\fB\3} text]} continue - # B B, I I, R R - if {[regsub {^([^\\]*)\\fB([^\\]*)\\fB(.*)$} $text {\1\\fB\2\3} ntext] - || [regsub {^([^\\]*)\\fI([^\\]*)\\fI(.*)$} $text {\1\\fI\2\3} ntext] - || [regsub {^([^\\]*)\\fR([^\\]*)\\fR(.*)$} $text {\1\\fR\2\3} ntext]} { - manerror "process-text: impotent font change: $text"; - set text $ntext; - continue; - } - # unrecognized - manerror "process-text: uncaught backslash: $text" - regsub -all {\\} $text {#92;} text - } - return $text -} -## -## pass 2 text input and matching -## -proc open-text {} { - global manual; - set manual(text-length) [llength $manual(text)]; - set manual(text-pointer) 0; -} -proc more-text {} { - global manual; - return [expr $manual(text-pointer) < $manual(text-length)]; -} -proc next-text {} { - global manual; - if {[more-text]} { - set text [lindex $manual(text) $manual(text-pointer)]; - incr manual(text-pointer); - return $text; - } - manerror "read past end of text"; - error "fatal"; -} -proc is-a-directive {line} { - return [expr {[string first . $line] == 0}] -} -proc split-directive {line opname restname} { - upvar $opname op $restname rest - set op [string range $line 0 2]; - set rest [string trim [string range $line 3 end]]; -} -proc next-op-is {op restname} { - global manual; - upvar $restname rest; - if {[more-text]} { - set text [lindex $manual(text) $manual(text-pointer)]; - if {[string compare [string range $text 0 2] $op] == 0} { - set rest [string range $text 4 end]; - incr manual(text-pointer); - return 1; - } - } - return 0; -} -proc backup-text {n} { - global manual; - if {$manual(text-pointer)-$n >= 0} { - incr manual(text-pointer) -$n; - } -} -proc match-text args { - global manual; - set nargs [llength $args]; - if {$manual(text-pointer) + $nargs > $manual(text-length)} { - return 0; - } - set nback 0; - foreach arg $args { - if { ! [more-text]} { - backup-text $nback; - return 0; - } - set arg [string trim $arg]; - set targ [string trim [lindex $manual(text) $manual(text-pointer)]]; - if {"$arg" == "$targ"} { - incr nback; - incr manual(text-pointer); - continue; - } - if {[regexp {^@([_a-zA-Z0-9]+)$} $arg all name]} { - upvar $name var; - set var $targ; - incr nback; - incr manual(text-pointer); - continue; - } - if {[regexp {^(\.[a-zA-Z][a-zA-Z])@([_a-zA-Z0-9]+)$} $arg all op name] && "$op" == "[lindex $targ 0]"} { - upvar $name var; - set var [lrange $targ 1 end]; - incr nback; - incr manual(text-pointer); - continue; - } - backup-text $nback; - return 0; - } - return 1; -} -proc expand-next-text {n} { - global manual; - return [join [lrange $manual(text) $manual(text-pointer) [expr $manual(text-pointer)+$n-1]] \n\n]; -} -## -## pass 2 output -## -proc man-puts {text} { - global manual; - lappend manual(output-$manual(wing-file)-$manual(name)) $text; -} - -## -## build hypertext links to tables of contents -## -proc long-toc {text} { - global manual; - set here M[incr manual(section-toc-n)] - set there L[incr manual(long-toc-n)]; - lappend manual(section-toc) "<DD><A HREF=\"$manual(name).htm#$here\" NAME=\"$there\">$text</A>"; - return "<A NAME=\"$here\">$text</A>"; -} -proc option-toc {name class switch} { - global manual; - if {"$manual(section)" == {WIDGET-SPECIFIC OPTIONS}} { - # link the defined option into the long table of contents - set link [long-toc "$switch, $name, $class"]; - regsub -- "$switch, $name, $class" $link "$switch" link; - return $link; - } elseif {"$manual(name):$manual(section)" == {options:DESCRIPTION}} { - # link the defined standard option to the long table of - # contents and make a target for the standard option references - # from other man pages. - set first [lindex $switch 0]; - set here M$first; - set there L[incr manual(long-toc-n)]; - set manual(standard-option-$first) "<A HREF=\"$manual(name).htm#$here\">$switch, $name, $class</A>"; - lappend manual(section-toc) "<DD><A HREF=\"$manual(name).htm#$here\" NAME=\"$there\">$switch, $name, $class</A>"; - return "<A NAME=\"$here\">$switch</A>"; - } else { - error "option-toc in $manual(name) section $manual(section)"; - } -} -proc std-option-toc {name} { - global manual; - if {[info exists manual(standard-option-$name)]} { - lappend manual(section-toc) <DD>$manual(standard-option-$name); - return $manual(standard-option-$name); - } - set here M[incr manual(section-toc-n)] - set there L[incr manual(long-toc-n)]; - set other M$name; - lappend manual(section-toc) "<DD><A HREF=\"options.htm#$other\">$name</A>"; - return "<A HREF=\"options.htm#$other\">$name</A>"; -} -## -## process the widget option section -## in widget and options man pages -## -proc output-widget-options {rest} { - global manual - man-puts <DL>; - lappend manual(section-toc) <DL>; - backup-text 1; - set para {} - while {[next-op-is .OP rest]} { - switch -exact [llength $rest] { - 3 { - set switch [lindex $rest 0]; - set name [lindex $rest 1]; - set class [lindex $rest 2]; - } - 5 { - set switch [lrange $rest 0 2]; - set name [lindex $rest 3]; - set class [lindex $rest 4]; - } - default { - fatal "bad .OP $rest"; - } - } - if { ! [regexp {^(<.>)([-a-zA-Z0-9 ]+)(</.>)$} $switch all oswitch switch cswitch]} { - if { ! [regexp {^(<.>)([-a-zA-Z0-9 ]+) or ([-a-zA-Z0-9 ]+)(</.>)$} $switch all oswitch switch1 switch2 cswitch]} { - error "not Switch: $switch"; - } else { - set switch "$switch1$cswitch or $oswitch$switch2"; - } - } - if { ! [regexp {^(<.>)([a-zA-Z0-9]*)(</.>)$} $name all oname name cname]} { - error "not Name: $name"; - } - if { ! [regexp {^(<.>)([a-zA-Z0-9]*)(</.>)$} $class all oclass class cclass]} { - error "not Class: $class"; - } - man-puts "$para<DT>Command-Line Name: $oswitch[option-toc $name $class $switch]$cswitch"; - man-puts "<DT>Database Name: $oname$name$cname"; - man-puts "<DT>Database Class: $oclass$class$cclass"; - man-puts <DD>[next-text]; - set para <P> - } - man-puts </DL>; - lappend manual(section-toc) </DL>; -} - -## -## process .RS lists -## -proc output-RS-list {} { - global manual; - if {[next-op-is .IP rest]} { - output-IP-list .RS .IP $rest; - if {[match-text .RE .sp .RS @rest .IP @rest2]} { - man-puts <P>$rest - output-IP-list .RS .IP $rest2 - } - if {[match-text .RE .sp .RS @rest .RE]} { - man-puts <P>$rest - return; - } - if {[next-op-is .RE rest]} { - return; - } - } - man-puts <DL><P><DD>; - while {[more-text]} { - set line [next-text]; - if {[is-a-directive $line]} { - split-directive $line code rest - switch -exact $code { - .RE { - break; - } - .SH { - manerror "unbalanced .RS at section end"; - backup-text 1; - break; - } - default { - output-directive $line; - } - } - } else { - man-puts $line; - } - } - man-puts </DL>; -} - -## -## process .IP lists which may be plain indents, -## numeric lists, or definition lists -## -proc output-IP-list {context code rest} { - global manual; - if {"$rest" == {}} { - # blank label, plain indent, no contents entry - man-puts <DL><P><DD> - while {[more-text]} { - set line [next-text]; - if {[is-a-directive $line]} { - split-directive $line code rest - if {"$code" == {.IP} && "$rest" == {}} { - man-puts "<P>"; - continue; - } - if {[lsearch {.br .DS .RS} $code] >= 0} { - output-directive $line; - } else { - backup-text 1; - break; - } - } else { - man-puts $line; - } - } - man-puts </DL>; - } else { - # labelled list, make contents - if {"$context" != {.SH}} { - man-puts <P>; - } - man-puts <DL> - lappend manual(section-toc) <DL>; - backup-text 1 - set accept_RE 0 - while {[more-text]} { - set line [next-text]; - if {[is-a-directive $line]} { - split-directive $line code rest - switch -exact $code { - .IP { - if {$accept_RE} { - output-IP-list .IP $code $rest - continue; - } - if {"$manual(section)" == {ARGUMENTS} || [regexp {^\[[0-9]+\]$} $rest]} { - man-puts "<P><DT>$rest<DD>"; - } else { - man-puts "<P><DT>[long-toc $rest]<DD>"; - } - if {"$manual(name):$manual(section)" == {selection:DESCRIPTION}} { - if {[match-text .RE @rest .RS .RS]} { - man-puts <DT>[long-toc $rest]<DD>; - } - } - } - .sp - - .br - - .DS - - .CS { - output-directive $line; - } - .RS { - if {[match-text .RS]} { - output-directive $line; - incr accept_RE 1; - } elseif {[match-text .CS]} { - output-directive .CS - incr accept_RE 1; - } elseif {[match-text .PP]} { - output-directive .PP - incr accept_RE 1; - } elseif {[match-text .DS]} { - output-directive .DS - incr accept_RE 1; - } else { - output-directive $line; - } - } - .PP { - if {[match-text @rest1 .br @rest2 .RS]} { - # yet another nroff kludge as above - man-puts "<P><DT>[long-toc $rest1]" - man-puts "<DT>[long-toc $rest2]<DD>" - incr accept_RE 1; - } elseif {[match-text @rest .RE]} { - # gad, this is getting ridiculous - if { ! $accept_RE} { - man-puts "</DL><P>$rest<DL>" - backup-text 1 - break; - } else { - man-puts "<P>$rest" - incr accept_RE -1 - } - } elseif {$accept_RE} { - output-directive $line - } else { - backup-text 1 - break; - } - } - .RE { - if { ! $accept_RE} { - backup-text 1; - break; - } - incr accept_RE -1 - } - default { - backup-text 1; - break; - } - } - } else { - man-puts $line; - } - } - man-puts <P></DL>; - lappend manual(section-toc) </DL>; - if {$accept_RE} { - manerror "missing .RE in output-IP-list" - } - } -} -## -## handle the NAME section lines -## there's only one line in the NAME section, -## consisting of a comma separated list of names, -## followed by a hyphen and a short description. -## -proc output-name {line} { - global manual; - # split name line into pieces - regexp {^([^-]+) - (.*)$} $line all head tail; - # output line to manual page untouched - man-puts $line - # output line to long table of contents - lappend manual(section-toc) <DL><DD>$line</DL> - # separate out the names for future reference - foreach name [split $head ,] { - set name [string trim $name]; - if {[llength $name] > 1} { - manerror "name has a space: {$name}\nfrom: $line"; - } - lappend manual(wing-toc) $name; - lappend manual(name-$name) $manual(wing-file)/$manual(name); - } -} -## -## build a cross-reference link if appropriate -## -proc cross-reference {ref} { - global manual; - if {[string match Tcl_* $ref]} { - set lref $ref; - } elseif {[string match Tk_* $ref]} { - set lref $ref; - } elseif {"$ref" == {Tcl}} { - set lref $ref; - } else { - set lref [string tolower $ref]; - } - ## - ## nothing to reference - ## - if { ! [info exists manual(name-$lref)]} { - foreach name {array file history info interp string trace - after clipboard grab image option pack place selection tk tkwait update winfo wm} { - if {[regexp "^$name \[a-z0-9]*\$" $lref] && "$manual(tail)" != "$name.n"} { - return "<A HREF=\"../$manual(name-$name).htm\">$ref</A>"; - } - } - if {[lsearch {stdin stdout stderr end} $lref] >= 0} { - # no good place to send these - # tcl tokens? - # also end - } - return $ref; - } - ## - ## would be a self reference - ## - foreach name $manual(name-$lref) { - if {[lsearch $name $manual(wing-file)/$manual(name)] >= 0} { - return $ref; - } - } - ## - ## multiple choices for reference - ## - if {[llength $manual(name-$lref)] > 1} { - set tcl_i [lsearch -glob $manual(name-$lref) *TclCmd*]; - set tcl_ref [lindex $manual(name-$lref) $tcl_i]; - set tk_i [lsearch -glob $manual(name-$lref) *TkCmd*]; - set tk_ref [lindex $manual(name-$lref) $tk_i]; - if {$tcl_i >= 0 && "$manual(wing-file)" == {TclCmd} || "$manual(wing-file)" == {TclLib}} { - return "<A HREF=\"../$tcl_ref.htm\">$ref</A>"; - } - if {$tk_i >= 0 && "$manual(wing-file)" == {TkCmd} || "$manual(wing-file)" == {TkLib}} { - return "<A HREF=\"../$tk_ref.htm\">$ref</A>"; - } - if {"$lref" == {exit} && "$manual(tail)" == {tclsh.1} && $tcl_i >= 0} { - return "<A HREF=\"../$tcl_ref.htm\">$ref</A>"; - } - puts stderr "multiple cross reference to $ref in $manual(name-$lref) from $manual(wing-file)/$manual(tail)"; - return $ref; - } - ## - ## exceptions, sigh, to the rule - ## - switch $manual(tail) { - canvas.n { - if {$lref == {focus}} { - upvar tail tail; - set clue [string first command $tail]; - if {$clue < 0 || $clue > 5} { - return $ref; - } - } - if {[lsearch {bitmap image text} $lref] >= 0} { - return $ref; - } - } - checkbutton.n - - radiobutton.n { - if {[lsearch {image} $lref] >= 0} { - return $ref; - } - } - menu.n { - if {[lsearch {checkbutton radiobutton} $lref] >= 0} { - return $ref; - } - } - options.n { - if {[lsearch {bitmap image set} $lref] >= 0} { - return $ref; - } - } - regexp.n { - if {[lsearch {string} $lref] >= 0} { - return $ref; - } - } - source.n { - if {[lsearch {text} $lref] >= 0} { - return $ref; - } - } - history.n { - if {[lsearch {exec} $lref] >= 0} { - return $ref; - } - } - return.n { - if {[lsearch {error continue break} $lref] >= 0} { - return $ref; - } - } - scrollbar.n { - if {[lsearch {set} $lref] >= 0} { - return $ref; - } - } - } - ## - ## return the cross reference - ## - return "<A HREF=\"../$manual(name-$lref).htm\">$ref</A>"; -} -## -## reference generation errors -## -proc reference-error {msg text} { - global manual; - puts stderr "$manual(tail): $msg: {$text}"; - return $text; -} -## -## insert as many cross references into this text string as are appropriate -## -proc insert-cross-references {text} { - global manual; - ## - ## we identify cross references by: - ## ``quotation'' - ## <B>emboldening</B> - ## Tcl_ prefix - ## Tk_ prefix - ## [a-zA-Z0-9]+ manual entry - ## and we avoid messing with already anchored text - ## - ## - ## find where each item lives - ## - array set offset [list \ - anchor [string first {<A } $text] \ - end-anchor [string first {</A>} $text] \ - quote [string first {``} $text] \ - end-quote [string first {''} $text] \ - bold [string first {<B>} $text] \ - end-bold [string first {</B>} $text] \ - tcl [string first {Tcl_} $text] \ - tk [string first {Tk_} $text] \ - Tcl1 [string first {Tcl manual entry} $text] \ - Tcl2 [string first {Tcl overview manual entry} $text] \ - ]; - ## - ## accumulate a list - ## - foreach name [array names offset] { - if {$offset($name) >= 0} { - set invert($offset($name)) $name; - lappend offsets $offset($name); - } - } - ## - ## if nothing, then we're done. - ## - if { ! [info exists offsets]} { - return $text; - } - ## - ## sort the offsets - ## - set offsets [lsort -integer $offsets]; - ## - ## see which we want to use - ## - switch -exact $invert([lindex $offsets 0]) { - anchor { - if {$offset(end-anchor) < 0} { return [reference-error {Missing end anchor} $text]; } - set head [string range $text 0 $offset(end-anchor)]; - set tail [string range $text [expr $offset(end-anchor)+1] end]; - return $head[insert-cross-references $tail] - } - quote { - if {$offset(end-quote) < 0} { return [reference-error {Missing end quote} $text]; } - if {"$invert([lindex $offsets 1])" == {tk}} { set offsets [lreplace $offsets 1 1]; } - if {"$invert([lindex $offsets 1])" == {tcl}} { set offsets [lreplace $offsets 1 1]; } - switch -exact $invert([lindex $offsets 1]) { - end-quote { - set head [string range $text 0 [expr $offset(quote)-1]] - set body [string range $text [expr $offset(quote)+2] [expr $offset(end-quote)-1]]; - set tail [string range $text [expr $offset(end-quote)+2] end]; - return $head``[cross-reference $body]''[insert-cross-references $tail]; - } - bold - - anchor { - set head [string range $text 0 [expr $offset(end-quote)+1]] - set tail [string range $text [expr $offset(end-quote)+2] end]; - return $head[insert-cross-references $tail]; - } - } - return [reference-error {Uncaught quote case} $text]; - } - bold { - if {$offset(end-bold) < 0} { return $text; } - if {"$invert([lindex $offsets 1])" == {tk}} { set offsets [lreplace $offsets 1 1]; } - if {"$invert([lindex $offsets 1])" == {tcl}} { set offsets [lreplace $offsets 1 1]; } - switch -exact $invert([lindex $offsets 1]) { - end-bold { - set head [string range $text 0 [expr $offset(bold)-1]] - set body [string range $text [expr $offset(bold)+3] [expr $offset(end-bold)-1]]; - set tail [string range $text [expr $offset(end-bold)+4] end]; - return $head<B>[cross-reference $body]</B>[insert-cross-references $tail]; - } - anchor { - set head [string range $text 0 [expr $offset(end-bold)+3]] - set tail [string range $text [expr $offset(end-bold)+4] end]; - return $head[insert-cross-references $tail]; - } - } - return [reference-error {Uncaught bold case} $text]; - } - tk { - set head [string range $text 0 [expr $offset(tk)-1]] - set tail [string range $text $offset(tk) end]; - if { ! [regexp {^(Tk_[a-zA-Z0-9_]+)(.*)$} $tail all body tail]} { return [reference-error {Tk regexp failed} $text]; } - return $head[cross-reference $body][insert-cross-references $tail]; - } - tcl { - set head [string range $text 0 [expr $offset(tcl)-1]] - set tail [string range $text $offset(tcl) end]; - if { ! [regexp {^(Tcl_[a-zA-Z0-9_]+)(.*)$} $tail all body tail]} { return [reference-error {Tcl regexp failed} $text]; } - return $head[cross-reference $body][insert-cross-references $tail]; - } - Tcl1 - - Tcl2 { - set off [lindex $offsets 0]; - set head [string range $text 0 [expr $off-1]]; - set body Tcl - set tail [string range $text [expr $off+3] end]; - return $head[cross-reference $body][insert-cross-references $tail]; - } - end-anchor - - end-bold - - end-quote { - return [reference-error "Out of place $invert([lindex $offsets 0])" $text]; - } - } -} -## -## process formatting directives -## -proc output-directive {line} { - global manual; - # process format directive - split-directive $line code rest - switch -exact $code { - .BS - - .BE { - # man-puts <HR>; - } - .SH { - # drain any open lists - # announce the subject - set manual(section) $rest; - # start our own stack of stuff - set manual($manual(name)-$manual(section)) {}; - lappend manual(has-$manual(section)) $manual(name); - man-puts "<H3>[long-toc $manual(section)]</H3>"; - # some sections can simply free wheel their way through the text - # some sections can be processed in their own loops - switch -exact $manual(section) { - NAME { - if {[lsearch {CrtImgType.3 CrtItemType.3 CrtPhImgFmt.3} $manual(tail)] >= 0} { - # these manual pages have two NAME sections - if {[info exists manual($manual(tail)-NAME)]} { - return; - } - set manual($manual(tail)-NAME) 1 - } - set names {} - while {1} { - set line [next-text]; - if {[is-a-directive $line]} { - backup-text 1; - output-name [join $names { }] - return; - } else { - lappend names [string trim $line] - } - } - } - SYNOPSIS { - lappend manual(section-toc) <DL>; - while {1} { - if {[next-op-is .nf rest] - || [next-op-is .br rest] - || [next-op-is .fi rest]} { - continue; - } - if {[next-op-is .SH rest] - || [next-op-is .BE rest] - || [next-op-is .SO rest]} { - backup-text 1; - break; - } - if {[next-op-is .sp rest]} { - #man-puts <P>; - continue; - } - set more [next-text]; - if {[is-a-directive $more]} { - manerror "in SYNOPSIS found $more"; - backup-text 1; - break; - } else { - foreach more [split $more \n] { - man-puts $more<BR>; - if {[lsearch {TclLib TkLib} $manual(wing-file)] < 0} { - lappend manual(section-toc) <DD>$more; - } - } - } - } - lappend manual(section-toc) </DL>; - return; - } - {SEE ALSO} { - while {[more-text]} { - if {[next-op-is .SH rest]} { - backup-text 1; - return; - } - set more [next-text]; - if {[is-a-directive $more]} { - manerror "$more"; - backup-text 1; - return; - } - set nmore {}; - foreach cr [split $more ,] { - set cr [string trim $cr]; - if { ! [regexp {^<B>.*</B>$} $cr]} { - set cr <B>$cr</B>; - } - if {[regexp {^<B>(.*)\([13n]\)</B>$} $cr all name]} { - set cr <B>$name</B> - } - lappend nmore $cr; - } - man-puts [join $nmore {, }]; - } - return; - } - KEYWORDS { - while {[more-text]} { - if {[next-op-is .SH rest]} { - backup-text 1; - return; - } - set more [next-text]; - if {[is-a-directive $more]} { - manerror "$more"; - backup-text 1; - return; - } - set keys {} - foreach key [split $more ,] { - set key [string trim $key] - lappend manual(keyword-$key) [list $manual(name) $manual(wing-file)/$manual(name).htm]; - set initial [string toupper [string index $key 0]] - lappend keys "<A href=\"../Keywords/$initial.htm\#$key\">$key</A>" - } - man-puts [join $keys {, }] - } - return; - } - } - if {[next-op-is .IP rest]} { - output-IP-list .SH .IP $rest; - return; - } - if {[next-op-is .PP rest]} { - return; - } - return; - } - .SO { - if {[match-text @stuff .SE]} { - output-directive {.SH STANDARD OPTIONS}; - set opts {}; - foreach line [split $stuff \n] { - foreach option [split $line \t] { - lappend opts $option; - } - } - man-puts <DL>; - lappend manual(section-toc) <DL>; - foreach option [lsort $opts] { - man-puts "<DT><B>[std-option-toc $option]</B>"; - } - man-puts </DL>; - lappend manual(section-toc) </DL>; - } else { - manerror "unexpected .SO format:\n[expand-next-text 2]"; - } - } - .OP { - output-widget-options $rest; - return; - } - .IP { - output-IP-list .IP .IP $rest; - return; - } - .PP { - man-puts <P>; - } - .RS { - output-RS-list; - return; - } - .RE { - manerror "unexpected .RE"; - return; - } - .br { - man-puts <BR>; - return; - } - .DE { - manerror "unexpected .DE"; - return; - } - .DS { - if {[next-op-is .ta rest]} { - ; - } - if {[match-text @stuff .DE]} { - man-puts <PRE>$stuff</PRE>; - } elseif {[match-text .fi @ul1 @ul2 .nf @stuff .DE]} { - man-puts "<PRE>[lindex $ul1 1][lindex $ul2 1]\n$stuff</PRE>"; - } else { - manerror "unexpected .DS format:\n[expand-next-text 2]"; - } - return; - } - .CS { - if {[next-op-is .ta rest]} { - ; - } - if {[match-text @stuff .CE]} { - man-puts <PRE>$stuff</PRE>; - } else { - manerror "unexpected .CS format:\n[expand-next-text 2]"; - } - return; - } - .CE { - manerror "unexpected .CE"; - return; - } - .sp { - man-puts <P>; - } - .ta { - # these are tab stop settings for short tables - switch -exact $manual(name):$manual(section) { - {bind:MODIFIERS} - - {bind:EVENT TYPES} - - {bind:BINDING SCRIPTS AND SUBSTITUTIONS} - - {expr:OPERANDS} - - {expr:MATH FUNCTIONS} - - {history:DESCRIPTION} - - {history:HISTORY REVISION} - - {switch:DESCRIPTION} - - {upvar:DESCRIPTION} { - return; # fix.me - } - default { - manerror "ignoring $line"; - } - } - } - .nf { - if {[match-text @more .fi]} { - foreach more [split $more \n] { - man-puts $more<BR>; - } - } elseif {[match-text .RS @more .RE .fi]} { - man-puts <DL><DD>; - foreach more [split $more \n] { - man-puts $more<BR>; - } - man-puts </DL>; - } elseif {[match-text .RS @more .RS @more2 .RE .RE .fi]} { - man-puts <DL><DD>; - foreach more [split $more \n] { - man-puts $more<BR>; - } - man-puts <DL><DD>; - foreach more2 [split $more2 \n] { - man-puts $more2<BR>; - } - man-puts </DL></DL>; - } elseif {[match-text .RS @more .RS @more2 .RE @more3 .RE .fi]} { - man-puts <DL><DD>; - foreach more [split $more \n] { - man-puts $more<BR>; - } - man-puts <DL><DD>; - foreach more2 [split $more2 \n] { - man-puts $more2<BR>; - } - man-puts </DL><DD>; - foreach more3 [split $more3 \n] { - man-puts $more3<BR>; - } - man-puts </DL>; - } elseif {[match-text .sp .RS @more .RS @more2 .sp .RE .RE .fi]} { - man-puts <P><DL><DD>; - foreach more [split $more \n] { - man-puts $more<BR>; - } - man-puts <DL><DD>; - foreach more2 [split $more2 \n] { - man-puts $more2<BR>; - } - man-puts </DL></DL><P>; - } elseif {[match-text .RS .sp @more .sp .RE .fi]} { - man-puts <P><DL><DD>; - foreach more [split $more \n] { - man-puts $more<BR>; - } - man-puts </DL><P>; - } else { - manerror "ignoring $line"; - } - } - .fi { - manerror "ignoring $line"; - } - .na - - .ad - - .UL - - .ne { - manerror "ignoring $line"; - } - default { - manerror "unrecognized format directive: $line"; - } - } -} -## -## merge copyright listings -## -proc merge-copyrights {l1 l2} { - foreach copyright [concat $l1 $l2] { - if {[regexp {^Copyright +\(c\) +([0-9]+) +(by +)?([A-Za-z].*)$} $copyright all date by who]} { - lappend dates($who) $date; - continue; - } - if {[regexp {^Copyright +\(c\) +([0-9]+)-([0-9]+) +(by +)?([A-Za-z].*)$} $copyright all from to by who]} { - for {set date $from} {$date <= $to} {incr date} { - lappend dates($who) $date; - } - continue; - } - if {[regexp {^Copyright +\(c\) +([0-9]+), *([0-9]+) +(by +)?([A-Za-z].*)$} $copyright all date1 date2 by who]} { - lappend dates($who) $date1 $date2; - continue; - } - puts "oops: $copyright"; - } - foreach who [array names dates] { - set list [lsort $dates($who)]; - if {[llength $list] == 1 || [lindex $list 0] == [lrange $list end end]} { - lappend merge "Copyright (c) [lindex $list 0] $who"; - } else { - lappend merge "Copyright (c) [lindex $list 0]-[lrange $list end end] $who"; - } - } - return [lsort $merge]; -} - -proc makedirhier {dir} { - if { ! [file isdirectory $dir]} { - makedirhier [file dirname $dir]; - if { ! [file isdirectory $dir]} { - if {[catch {exec mkdir $dir} error]} { - error "cannot create directory $dir: $error"; - } - } - } -} - -## -## foreach of the man directories specified by args -## convert manpages into hypertext in the directory -## specified by html. -## -proc make-man-pages {html args} { - global env manual overall_title; - makedirhier $html; - if { ! [file isdirectory $html]} { - exec mkdir $html; - } - set manual(short-toc-n) 1; - set manual(short-toc-fp) [open $html/contents.htm w]; - puts $manual(short-toc-fp) "<HTML><HEAD><TITLE>$overall_title</TITLE></HEAD>" - puts $manual(short-toc-fp) "<BODY><HR><H3>$overall_title</H3><HR><DL>"; - set manual(merge-copyrights) {} - foreach arg $args { - set manual(wing-glob) [lindex $arg 0]; - set manual(wing-name) [lindex $arg 1]; - set manual(wing-file) [lindex $arg 2]; - set manual(wing-description) [lindex $arg 3]; - set manual(wing-copyrights) {}; - makedirhier $html/$manual(wing-file); - set manual(wing-toc-fp) [open $html/$manual(wing-file)/contents.htm w]; - # whistle - puts stderr "scanning section $manual(wing-name)"; - # put the entry for this section into the short table of contents - puts $manual(short-toc-fp) "<DT><A HREF=\"$manual(wing-file)/contents.htm\">$manual(wing-name)</A><DD>$manual(wing-description)"; - # initialize the wing table of contents - puts $manual(wing-toc-fp) "<HTML><HEAD><TITLE>$manual(wing-name) Manual</TITLE></HEAD>" - puts $manual(wing-toc-fp) "<BODY><HR><H3>$manual(wing-name)</H3><HR>"; - # initialize the short table of contents for this section - set manual(wing-toc) {}; - # initialize the man directory for this section - makedirhier $html/$manual(wing-file); - # initialize the long table of contents for this section - set manual(long-toc-n) 1; - # get the manual pages for this section - set manual(pages) [lsort [glob $manual(wing-glob)]]; - if {[lsearch -glob $manual(pages) */options.n] >= 0} { - set n [lsearch $manual(pages) */options.n]; - set manual(pages) "[lindex $manual(pages) $n] [lreplace $manual(pages) $n $n]"; - } - # set manual(pages) [lrange $manual(pages) 0 5]; - foreach manual(page) $manual(pages) { - # whistle - puts stderr "scanning page $manual(page)"; - set manual(tail) [file tail $manual(page)]; - set manual(name) [file root $manual(tail)]; - set manual(section) {}; - if {[lsearch {case pack-old menubar} $manual(name)] >= 0} { - # obsolete - manerror "discarding $manual(name)"; - continue; - } - set manual(infp) [open "$manual(page)"]; - set manual(text) {}; - set manual(partial-text) {}; - foreach p {.RS .DS .CS .SO} { - set manual($p) 0; - } - set manual(stack) {}; - set manual(section) {}; - set manual(section-toc) {}; - set manual(section-toc-n) 1; - set manual(copyrights) {}; - lappend manual(all-pages) $manual(wing-file)/$manual(tail); - manreport 100 "$manual(name)"; - while {[gets $manual(infp) line] >= 0} { - manreport 100 $line; - if {[regexp {^[`'][/\\]} $line]} { - if {[regexp {Copyright \(c\).*$} $line copyright]} { - lappend manual(copyrights) $copyright; - } - # comment - continue; - } - if {"$line" == {'}} { - # comment - continue; - } - if {[parse-directive $line code rest]} { - switch -exact $code { - .ad - - .na - - .so - - .ne - - .AS - - .VE - - .VS - - . { - # ignore - continue; - } - } - if {"$manual(partial-text)" != {}} { - lappend manual(text) [process-text $manual(partial-text)]; - set manual(partial-text) {}; - } - switch -exact $code { - .SH { - if {[llength $rest] == 0} { - gets $manual(infp) rest; - } - lappend manual(text) ".SH [unquote $rest]"; - } - .TH { - lappend manual(text) "$code [unquote $rest]"; - } - .HS - - .UL - - .ta { - lappend manual(text) "$code [unquote $rest]"; - } - .BS - - .BE - - .br - - .fi - - .sp - - .nf { - if {"$rest" != {}} { - manerror "unexpected argument: $line"; - } - lappend manual(text) $code; - } - .AP { - lappend manual(text) [concat .IP [process-text "[lindex $rest 0] \\fB[lindex $rest 1]\\fR ([lindex $rest 2])"]]; - } - .IP { - regexp {^(.*) +[0-9]+$} $rest all rest - lappend manual(text) ".IP [process-text [unquote [string trim $rest]]]"; - } - .TP { - set next [gets $manual(infp)]; - if {"$next" != {'}} { - lappend manual(text) ".IP [process-text $next]"; - } - } - .OP { - lappend manual(text) [concat .OP [process-text \ - "\\fB[lindex $rest 0]\\fR \\fB[lindex $rest 1]\\fR \\fB[lindex $rest 2]\\fR"]]; - } - .PP - - .LP { - lappend manual(text) {.PP}; - } - .RS { - incr manual(.RS); - lappend manual(text) $code; - } - .RE { - incr manual(.RS) -1; - lappend manual(text) $code; - } - .SO { - incr manual(.SO); - lappend manual(text) $code; - } - .SE { - incr manual(.SO) -1; - lappend manual(text) $code; - } - .DS { - incr manual(.DS); - lappend manual(text) $code; - } - .DE { - incr manual(.DS) -1; - lappend manual(text) $code; - } - .CS { - incr manual(.CS); - lappend manual(text) $code; - } - .CE { - incr manual(.CS) -1; - lappend manual(text) $code; - } - .de { - while {[gets $manual(infp) line] >= 0} { - if {[regexp {^\.\.} $line]} { - break; - } - } - } - .. { - error "found .. outside of .de"; - } - default { - manerror "unrecognized format directive: $line"; - } - } - } else { - if {"$manual(partial-text)" == {}} { - set manual(partial-text) $line; - } else { - append manual(partial-text) \n$line; - } - } - } - if {"$manual(partial-text)" != {}} { - lappend manual(text) [process-text $manual(partial-text)]; - } - close $manual(infp); - # fixups - if {$manual(.RS) != 0} { - if {"$manual(name)" != {selection}} { - puts "unbalanced .RS .RE"; - } - } - if {$manual(.DS) != 0} { - puts "unbalanced .DS .DE"; - } - if {$manual(.CS) != 0} { - puts "unbalanced .CS .CE"; - } - if {$manual(.SO) != 0} { - puts "unbalanced .SO .SE"; - } - # output conversion - open-text; - if {[next-op-is .HS rest]} { - set manual($manual(name)-title) "[lrange $rest 1 end] [lindex $rest 0] manual page"; - while {[more-text]} { - set line [next-text]; - if {[is-a-directive $line]} { - output-directive $line; - } else { - man-puts $line; - } - } - man-puts <HR><PRE>; - foreach copyright $manual(copyrights) { - man-puts "<A HREF=\"../copyright.htm\">Copyright</A> © [lrange $copyright 2 end]"; - } - man-puts "<A HREF=\"../copyright.htm\">Copyright</A> © 1995-1997 Roger E. Critchlow Jr.</PRE>"; - set manual(wing-copyrights) [merge-copyrights $manual(wing-copyrights) $manual(copyrights)]; - } elseif {[next-op-is .TH rest]} { - set manual($manual(name)-title) "[lrange $rest 4 end] - [lindex $rest 0] manual page"; - while {[more-text]} { - set line [next-text]; - if {[is-a-directive $line]} { - output-directive $line; - } else { - man-puts $line; - } - } - man-puts <HR><PRE>; - foreach copyright $manual(copyrights) { - man-puts "<A HREF=\"../copyright.htm\">Copyright</A> © [lrange $copyright 2 end]"; - } - man-puts "<A HREF=\"../copyright.htm\">Copyright</A> © 1995-1997 Roger E. Critchlow Jr.</PRE>"; - set manual(wing-copyrights) [merge-copyrights $manual(wing-copyrights) $manual(copyrights)]; - } else { - manerror "no .HS or .TH record found"; - } - # - # make the long table of contents for this page - # - set manual(toc-$manual(wing-file)-$manual(name)) [concat <DL> $manual(section-toc) </DL><HR>]; - } - - # - # make the wing table of contents for the section - # - set width 0; - foreach name $manual(wing-toc) { - if {[string length $name] > $width} { - set width [string length $name]; - } - } - set perline [expr 120 / $width]; - set nrows [expr ([llength $manual(wing-toc)]+$perline)/$perline] - set n 0; - catch {unset rows} - foreach name [lsort $manual(wing-toc)] { - set tail $manual(name-$name); - if {[llength $tail] > 1} { - manerror "$name is defined in more than one file: $tail"; - set tail [lindex $tail [expr [llength $tail]-1]]; - } - set tail [file tail $tail]; - append rows([expr $n%$nrows]) "<td> <a href=\"$tail.htm\">$name</a>" - incr n; - } - puts $manual(wing-toc-fp) <table>; - foreach row [lsort -integer [array names rows]] { - puts $manual(wing-toc-fp) <tr>$rows($row)</tr> - } - puts $manual(wing-toc-fp) </table>; - - # - # insert wing copyrights - # - puts $manual(wing-toc-fp) "<HR><PRE>" - foreach copyright $manual(wing-copyrights) { - puts $manual(wing-toc-fp) "<A HREF=\"../copyright.htm\">Copyright</A> © [lrange $copyright 2 end]"; - } - puts $manual(wing-toc-fp) "<A HREF=\"../copyright.htm\">Copyright</A> © 1995-1997 Roger E. Critchlow Jr."; - puts $manual(wing-toc-fp) "</PRE></BODY></HTML>"; - close $manual(wing-toc-fp); - set manual(merge-copyrights) [merge-copyrights $manual(merge-copyrights) $manual(wing-copyrights)]; - } - - ## - ## build the keyword index. - ## - proc strcasecmp {a b} { return [string compare [string tolower $a] [string tolower $b]]; } - set keys [lsort -command strcasecmp [array names manual keyword-*]]; - makedirhier $html/Keywords - catch {eval exec rm -f [glob $html/Keywords/*]} - puts $manual(short-toc-fp) {<DT><A HREF="Keywords/contents.htm">Keywords</A><DD>The keywords from the Tcl/Tk man pages.}; - set keyfp [open $html/Keywords/contents.htm w]; - puts $keyfp "<HTML><HEAD><TITLE>Tcl/Tk Keywords</TITLE></HEAD>" - puts $keyfp "<BODY><HR><H3>Tcl/Tk Keywords</H3><HR><H2>" - 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} { - puts $keyfp "<A HREF=\"$a.htm\">$a</A>" - set afp [open $html/Keywords/$a.htm w]; - puts $afp "<HTML><HEAD><TITLE>Tcl/Tk Keywords - $a</TITLE></HEAD>" - puts $afp "<BODY><HR><H3>Tcl/Tk Keywords - $a</H3><HR><H2>" - 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} { - puts $afp "<A HREF=\"$b.htm\">$b</A>" - } - puts $afp "</H2><HR><DL>" - foreach k $keys { - if {[regexp -nocase -- "^keyword-$a" $k]} { - set k [string range $k 8 end] - puts $afp "<DT><A NAME=\"$k\">$k</A><DD>" - set refs {} - foreach man $manual(keyword-$k) { - set name [lindex $man 0]; - set file [lindex $man 1] - lappend refs "<A HREF=\"../$file\">$name</A>"; - } - puts $afp [join $refs {, }]; - } - } - puts $afp "</DL><HR><PRE>" - # insert merged copyrights - foreach copyright $manual(merge-copyrights) { - puts $afp "<A HREF=\"copyright.htm\">Copyright</A> © [lrange $copyright 2 end]"; - } - puts $afp "<A HREF=\"copyright.htm\">Copyright</A> © 1995-1997 Roger E. Critchlow Jr."; - puts $afp "</PRE></BODY></HTML>" - close $afp - } - puts $keyfp "</H2><HR><PRE>" - - # insert merged copyrights - foreach copyright $manual(merge-copyrights) { - puts $keyfp "<A HREF=\"copyright.htm\">Copyright</A> © [lrange $copyright 2 end]"; - } - puts $keyfp "<A HREF=\"copyright.htm\">Copyright</A> © 1995-1997 Roger E. Critchlow Jr."; - puts $keyfp </PRE><HR></BODY></HTML> - close $keyfp; - - ## - ## finish off short table of contents - ## - puts $manual(short-toc-fp) {<DT><A HREF="http://www.elf.org">Source</A><DD>More information about these man pages.} - puts $manual(short-toc-fp) "</DL><HR><PRE>"; - # insert merged copyrights - foreach copyright $manual(merge-copyrights) { - puts $manual(short-toc-fp) "<A HREF=\"copyright.htm\">Copyright</A> © [lrange $copyright 2 end]"; - } - puts $manual(short-toc-fp) "<A HREF=\"copyright.htm\">Copyright</A> © 1995-1997 Roger E. Critchlow Jr."; - puts $manual(short-toc-fp) "</PRE></BODY></HTML>"; - close $manual(short-toc-fp); - - ## - ## output man pages - ## - unset manual(section); - foreach path $manual(all-pages) { - set manual(wing-file) [file dirname $path]; - set manual(tail) [file tail $path]; - set manual(name) [file root $manual(tail)]; - set text $manual(output-$manual(wing-file)-$manual(name)); - set ntext 0; - foreach item $text { - incr ntext [llength [split $item \n]]; - incr ntext; - } - set toc $manual(toc-$manual(wing-file)-$manual(name)); - set ntoc 0; - foreach item $toc { - incr ntoc [llength [split $item \n]]; - incr ntoc; - } - puts stderr "rescanning page $manual(name) $ntoc/$ntext"; - set manual(outfp) [open $html/$manual(wing-file)/$manual(name).htm w]; - puts $manual(outfp) "<HTML><HEAD><TITLE>$manual($manual(name)-title)</TITLE></HEAD><BODY>" - if {$ntext > 60 && $ntoc > 32 - || [lsearch {Hash LinkVar SetVar TraceVar - ConfigWidg CrtImgType CrtItemType CrtPhImgFmt DoOneEvent GetBitmap GetColor GetCursor GetJustify GetPixels GetVisual - ParseArgv QueueEvent} $manual(tail)] >= 0} { - foreach item $toc { - puts $manual(outfp) $item; - } - } - foreach item $text { - puts $manual(outfp) [insert-cross-references $item]; - } - puts $manual(outfp) </BODY></HTML>; - close $manual(outfp); - } - return {}; -} - -set usercmddesc {The interpreters which implement Tcl and Tk.} -set tclcmddesc {The commands which the <B>tclsh</B> interpreter implements.} -set tkcmddesc {The additional commands which the <B>wish</B> interpreter implements.} -set tcllibdesc {The C functions which a Tcl extended C program may use.} -set tklibdesc {The additional C functions which a Tk extended C program may use.} - -parse_command_line - -if {1} { - if {[catch { - make-man-pages $webdir \ - "$tcltkdir/{$tkdir,$tcldir}/doc/*.1 {Tcl/Tk Applications} UserCmd {$usercmddesc}" \ - "$tcltkdir/$tcldir/doc/*.n {Tcl Commands} TclCmd {$tclcmddesc}" \ - "$tcltkdir/$tkdir/doc/*.n {Tk Commands} TkCmd {$tkcmddesc}" \ - "$tcltkdir/$tcldir/doc/*.3 {Tcl Library} TclLib {$tcllibdesc}" \ - "$tcltkdir/$tkdir/doc/*.3 {Tk Library} TkLib {$tklibdesc}" - } error]} { - puts $error\n$errorInfo; - } -} - |