diff options
Diffstat (limited to 'tools/tcltk-man2html.tcl')
| -rwxr-xr-x | tools/tcltk-man2html.tcl | 1107 |
1 files changed, 665 insertions, 442 deletions
diff --git a/tools/tcltk-man2html.tcl b/tools/tcltk-man2html.tcl index c96362f..c6932d0 100755 --- a/tools/tcltk-man2html.tcl +++ b/tools/tcltk-man2html.tcl @@ -2,13 +2,11 @@ # The next line is executed by /bin/sh, but not tcl \ exec tclsh "$0" ${1+"$@"} -package require Tcl 8.4 +package require Tcl 8.5 -# Convert Ousterhout format man pages into highly crosslinked -# hypertext. +# Convert Ousterhout format man pages into highly crosslinked hypertext. # -# Along the way detect many unmatched font changes and other odd -# things. +# 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 @@ -18,54 +16,10 @@ package require Tcl 8.4 # 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.32" +set Version "0.40" + +set ::CSSFILE "docs.css" proc parse_command_line {} { global argv Version @@ -82,7 +36,7 @@ proc parse_command_line {} { set build_tcl 0 set build_tk 0 # Default search version is a glob pattern - set useversion {{,[8-9].[0-9]{,.[0-9]{,[0-9]}}}} + set useversion {{,[8-9].[0-9]{,[.ab][0-9]{,[0-9]}}}} # Handle arguments a la GNU: # --version @@ -140,13 +94,16 @@ proc parse_command_line {} { } } - if {!$build_tcl && !$build_tk} {set build_tcl 1; set build_tk 1} + if {!$build_tcl && !$build_tk} { + set build_tcl 1; + set build_tk 1 + } if {$build_tcl} { # Find Tcl. set tcldir [lindex [lsort [glob -nocomplain -tails -type d \ - -directory $tcltkdir tcl$useversion]] end] - if {$tcldir == ""} then { + -directory $tcltkdir tcl$useversion]] end] + if {$tcldir eq ""} { puts stderr "tcltk-man-html: couldn't find Tcl below $tcltkdir" exit 1 } @@ -157,7 +114,7 @@ proc parse_command_line {} { # Find Tk. set tkdir [lindex [lsort [glob -nocomplain -tails -type d \ -directory $tcltkdir tk$useversion]] end] - if {$tkdir == ""} then { + if {$tkdir eq ""} { puts stderr "tcltk-man-html: couldn't find Tk below $tcltkdir" exit 1 } @@ -167,10 +124,16 @@ proc parse_command_line {} { # the title for the man pages overall global overall_title set overall_title "" - if {$build_tcl} {append overall_title "[capitalize $tcldir]"} - if {$build_tcl && $build_tk} {append overall_title "/"} - if {$build_tk} {append overall_title "[capitalize $tkdir]"} - append overall_title " Manual" + if {$build_tcl} { + append overall_title "[capitalize $tcldir]" + } + if {$build_tcl && $build_tk} { + append overall_title "/" + } + if {$build_tk} { + append overall_title "[capitalize $tkdir]" + } + append overall_title " Documentation" } proc capitalize {string} { @@ -186,28 +149,168 @@ proc manerror {msg} { global manual set name {} set subj {} + set procname [lindex [info level -1] 0] if {[info exists manual(name)]} { set name $manual(name) } if {[info exists manual(section)] && [string length $manual(section)]} { - puts stderr "$name: $manual(section): $msg" + puts stderr "$name: $manual(section): $procname: $msg" } else { - puts stderr "$name: $msg" + puts stderr "$name: $procname: $msg" } } proc manreport {level msg} { global manual if {$level < $manual(report-level)} { - manerror $msg + uplevel 1 [list manerror $msg] } } proc fatal {msg} { global manual - manerror $msg + uplevel 1 [list manerror $msg] exit 1 } + +## +## templating +## +proc indexfile {} { + if {[info exists ::TARGET] && $::TARGET eq "devsite"} { + return "index.tml" + } else { + return "contents.htm" + } +} +proc copyright {copyright {level {}}} { + # We don't actually generate a separate copyright page anymore + #set page "${level}copyright.htm" + #return "<A HREF=\"$page\">Copyright</A> © [htmlize-text [lrange $copyright 2 end]]" + # obfuscate any email addresses that may appear in name + set who [string map {@ (at)} [lrange $copyright 2 end]] + return "Copyright © [htmlize-text $who]" +} +proc copyout {copyrights {level {}}} { + set out "<div class=\"copy\">" + foreach c $copyrights { + append out "[copyright $c $level]\n" + } + append out "</div>" + return $out +} +proc CSS {{level ""}} { + return "<link rel=\"stylesheet\" href=\"${level}$::CSSFILE\" type=\"text/css\" media=\"all\">\n" +} +proc DOCTYPE {} { + return "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\">" +} +proc htmlhead {title header args} { + set level "" + if {[lindex $args end] eq "../[indexfile]"} { + # XXX hack - assume same level for CSS file + set level "../" + } + set out "[DOCTYPE]\n<HTML>\n<HEAD><TITLE>$title</TITLE>\n[CSS $level]</HEAD>\n" + foreach {uptitle url} $args { + set header "<a href=\"$url\">$uptitle</a> <small>></small> $header" + } + append out "<BODY><H2>$header</H2>" + global manual + if {[info exists manual(subheader)]} { + set subs {} + foreach {name subdir} $manual(subheader) { + if {$name eq $title} { + lappend subs $name + } else { + lappend subs "<A HREF=\"${level}$subdir/[indexfile]\">$name</A>" + } + } + append out "\n<H3>[join $subs { | }]</H3>" + } + return $out +} +proc gencss {} { + set hBd "1px dotted #11577b" + return " +body, div, p, th, td, li, dd, ul, ol, dl, dt, blockquote { + font-family: Verdana, sans-serif; +} + +pre, code { font-family: 'Courier New', Courier, monospace; } + +pre { + background-color: #f6fcec; + border-top: 1px solid #6A6A6A; + border-bottom: 1px solid #6A6A6A; + padding: 1em; + overflow: auto; +} + +body { + background-color: #FFFFFF; + font-size: 12px; + line-height: 1.25; + letter-spacing: .2px; + padding-left: .5em; +} + +h1, h2, h3, h4 { + font-family: Georgia, serif; + padding-left: 1em; + margin-top: 1em; +} + +h1 { + font-size: 18px; + color: #11577b; + border-bottom: $hBd; + margin-top: 0px; +} + +h2 { + font-size: 14px; + color: #11577b; + background-color: #c5dce8; + padding-left: 1em; + border: 1px solid #6A6A6A; +} + +h3, h4 { + color: #1674A4; + background-color: #e8f2f6; + border-bottom: $hBd; + border-top: $hBd; +} + +h3 { font-size: 12px; } +h4 { font-size: 11px; } + +.keylist dt, .arguments dt { + width: 20em; + float: left; + padding: 2px; + border-top: 1px solid #999; +} + +.keylist dt { font-weight: bold; } + +.keylist dd, .arguments dd { + margin-left: 20em; + padding: 2px; + border-top: 1px solid #999; +} + +.copy { + background-color: #f6fcfc; + white-space: pre; + font-size: 80%; + border-top: 1px solid #6A6A6A; + margin-top: 2em; +} +" +} + ## ## parsing ## @@ -216,36 +319,53 @@ proc unquote arg { } proc parse-directive {line codename restname} { - upvar $codename code $restname rest + upvar 1 $codename code $restname rest return [regexp {^(\.[.a-zA-Z0-9]*) *(.*)} $line all code rest] } +proc htmlize-text {text {charmap {}}} { + # contains some extras for use in nroff->html processing + # build on the list passed in, if any + lappend charmap \ + {&} {&} \ + {\\} "\" \ + {\e} "\" \ + {\ } { } \ + {\|} { } \ + {\0} { } \ + \" {"} \ + {<} {<} \ + {>} {>} \ + \u201c "“" \ + \u201d "”" + + return [string map $charmap $text] +} + proc process-text {text} { global manual # preprocess text - set text [string map [list \ - {\&} "\t" \ - {&} {&} \ - {\\} {\} \ - {\e} {\} \ - {\ } { } \ - {\|} { } \ - {\0} { } \ - {\%} {} \ - "\\\n" "\n" \ - \" {"} \ - {<} {<} \ - {>} {>} \ - {\(+-} {±} \ - {\fP} {\fR} \ - {\.} . \ - {\(bu} {•} \ - ] $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 "\\\\\n" $text "\\\\n" text; # backslashed newline + set charmap [list \ + {\&} "\t" \ + {\%} {} \ + "\\\n" "\n" \ + {\(+-} "±" \ + {\(co} "©" \ + {\(em} "—" \ + {\(fm} "′" \ + {\(mu} "×" \ + {\(->} "<font size=\"+1\">→</font>" \ + {\fP} {\fR} \ + {\.} . \ + {\(bu} "•" \ + ] + lappend charmap {\o'o^'} {ô} ; # o-circumflex in re_syntax.n + lappend charmap {\-\|\-} -- ; # two hyphens + lappend charmap {\-} - ; # a hyphen + + set text [htmlize-text $text $charmap] + # General quoted entity + regsub -all {\\N'(\d+)'} $text "\\&#\\1;" text while {[string first "\\" $text] >= 0} { # C R if {[regsub {^([^\\]*)\\fC([^\\]*)\\fR(.*)$} $text \ @@ -263,19 +383,21 @@ proc process-text {text} { if {[regsub {^([^\\]*)\\fI([^\\]*)\\fB(.*)$} $text \ {\1<I>\2</I>\\fB\3} text]} continue # B B, I I, R R - if {[regsub {^([^\\]*)\\fB([^\\]*)\\fB(.*)$} $text \ + 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" + {\1\\fR\2\3} ntext] + } then { + manerror "impotent font change: $text" set text $ntext continue } # unrecognized - manerror "process-text: uncaught backslash: $text" - set text [string map [list "\\" "#92;"] $text] + manerror "uncaught backslash: $text" + set text [string map [list "\\" "\"] $text] } return $text } @@ -305,13 +427,13 @@ proc is-a-directive {line} { return [string match .* $line] } proc split-directive {line opname restname} { - upvar $opname op $restname rest + upvar 1 $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 + upvar 1 $restname rest if {[more-text]} { set text [lindex $manual(text) $manual(text-pointer)] if {[string equal -length 3 $text $op]} { @@ -342,13 +464,13 @@ proc match-text args { } set arg [string trim $arg] set targ [string trim [lindex $manual(text) $manual(text-pointer)]] - if {[string equal $arg $targ]} { + if {$arg eq $targ} { incr nback incr manual(text-pointer) continue } if {[regexp {^@(\w+)$} $arg all name]} { - upvar $name var + upvar 1 $name var set var $targ incr nback incr manual(text-pointer) @@ -356,7 +478,7 @@ proc match-text args { } if {[regexp -nocase {^(\.[A-Z][A-Z])@(\w+)$} $arg all op name]\ && [string equal $op [lindex $targ 0]]} { - upvar $name var + upvar 1 $name var set var [lrange $targ 1 end] incr nback incr manual(text-pointer) @@ -393,37 +515,44 @@ proc long-toc {text} { } proc option-toc {name class switch} { global manual - if {[string equal $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 {[string equal $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 { + if {[string match "*OPTIONS" $manual(section)]} { + if { + $manual(name) ne "ttk_widget" + && $manual(section) ne "WIDGET-SPECIFIC OPTIONS" + } then { + # 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)" ne "options:DESCRIPTION"} { error "option-toc in $manual(name) section $manual(section)" } + + # 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-$manual(name)-$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>" } -proc std-option-toc {name} { +proc std-option-toc {name page} { global manual - if {[info exists manual(standard-option-$name)]} { - lappend manual(section-toc) <DD>$manual(standard-option-$name) - return $manual(standard-option-$name) + if {[info exists manual(standard-option-$page-$name)]} { + lappend manual(section-toc) <DD>$manual(standard-option-$page-$name) + return $manual(standard-option-$page-$name) } + manerror "missing reference to \"$name\" in $page.n" 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>" + lappend manual(section-toc) "<DD><A HREF=\"$page.htm#$other\">$name</A>" + return "<A HREF=\"$page.htm#$other\">$name</A>" } ## ## process the widget option section @@ -436,8 +565,10 @@ proc output-widget-options {rest} { backup-text 1 set para {} while {[next-op-is .OP rest]} { - switch -exact [llength $rest] { - 3 { foreach {switch name class} $rest { break } } + switch -exact -- [llength $rest] { + 3 { + lassign $rest switch name class + } 5 { set switch [lrange $rest 0 2] set name [lindex $rest 3] @@ -447,12 +578,13 @@ proc output-widget-options {rest} { fatal "bad .OP $rest" } } - if {![regexp {^(<.>)([-\w ]+)(</.>)$} $switch all oswitch switch cswitch]} { - if {![regexp {^(<.>)([-\w ]+) or ([-\w ]+)(</.>)$} $switch all oswitch switch1 switch2 cswitch]} { + if {![regexp {^(<.>)([-\w ]+)(</.>)$} $switch \ + all oswitch switch cswitch]} { + if {![regexp {^(<.>)([-\w ]+) or ([-\w ]+)(</.>)$} $switch \ + all oswitch switch1 switch2 cswitch]} { error "not Switch: $switch" - } else { - set switch "$switch1$cswitch or $oswitch$switch2" } + set switch "$switch1$cswitch or $oswitch$switch2" } if {![regexp {^(<.>)([\w]*)(</.>)$} $name all oname name cname]} { error "not Name: $name" @@ -465,6 +597,30 @@ proc output-widget-options {rest} { man-puts "<DT>Database Class: $oclass$class$cclass" man-puts <DD>[next-text] set para <P> + + if {[next-op-is .RS rest]} { + while {[more-text]} { + set line [next-text] + if {[is-a-directive $line]} { + split-directive $line code rest + switch -exact -- $code { + .RE { + break + } + .SH - .SS { + manerror "unbalanced .RS at section end" + backup-text 1 + break + } + default { + output-directive $line + } + } + } else { + man-puts $line + } + } + } } man-puts </DL> lappend manual(section-toc) </DL> @@ -494,7 +650,7 @@ proc output-RS-list {} { set line [next-text] if {[is-a-directive $line]} { split-directive $line code rest - switch -exact $code { + switch -exact -- $code { .RE { break } @@ -510,7 +666,7 @@ proc output-RS-list {} { } else { man-puts $line } - } + } man-puts </DL> } @@ -527,11 +683,11 @@ proc output-IP-list {context code rest} { set line [next-text] if {[is-a-directive $line]} { split-directive $line code rest - if {[string equal $code ".IP"] && [string equal $rest {}]} { + if {$code eq ".IP" && $rest eq {}} { man-puts "<P>" continue } - if {[lsearch {.br .DS .RS} $code] >= 0} { + if {$code in {.br .DS .RS}} { output-directive $line } else { backup-text 1 @@ -544,14 +700,12 @@ proc output-IP-list {context code rest} { man-puts </DL> } else { # labelled list, make contents - if { - [string compare $context ".SH"] && - [string compare $context ".SS"] - } then { + if {$context ne ".SH" && $context ne ".SS"} { man-puts <P> } - man-puts <DL> - lappend manual(section-toc) <DL> + set dl "<DL class=\"[string tolower $manual(section)]\">" + man-puts $dl + lappend manual(section-toc) $dl backup-text 1 set accept_RE 0 set para {} @@ -559,31 +713,28 @@ proc output-IP-list {context code rest} { set line [next-text] if {[is-a-directive $line]} { split-directive $line code rest - switch -exact $code { + switch -exact -- $code { .IP { if {$accept_RE} { output-IP-list .IP $code $rest continue } - if {[string equal $manual(section) "ARGUMENTS"] || \ + if {$manual(section) eq "ARGUMENTS" || \ [regexp {^\[\d+\]$} $rest]} { man-puts "$para<DT>$rest<DD>" - } elseif {[string equal {•} $rest]} { - man-puts "$para<DT><DD>$rest " + } elseif {"•" eq $rest} { + man-puts "$para<DT><DD>$rest " } else { man-puts "$para<DT>[long-toc $rest]<DD>" } - if {[string equal $manual(name):$manual(section) \ - "selection:DESCRIPTION"]} { + if {"$manual(name):$manual(section)" eq \ + "selection:DESCRIPTION"} { if {[match-text .RE @rest .RS .RS]} { man-puts <DT>[long-toc $rest]<DD> } } } - .sp - - .br - - .DS - - .CS { + .sp - .br - .DS - .CS { output-directive $line } .RS { @@ -664,7 +815,7 @@ proc output-name {line} { # output line to manual page untouched man-puts $line # output line to long table of contents - lappend manual(section-toc) <DL><DD>$line</DL> + lappend manual(section-toc) <DL><DD>$line</DD></DL> # separate out the names for future reference foreach name [split $head ,] { set name [string trim $name] @@ -680,11 +831,11 @@ proc output-name {line} { ## proc cross-reference {ref} { global manual - if {[string match Tcl_* $ref]} { + if {[string match "Tcl_*" $ref]} { set lref $ref - } elseif {[string match Tk_* $ref]} { + } elseif {[string match "Tk_*" $ref]} { set lref $ref - } elseif {[string equal $ref "Tcl"]} { + } elseif {$ref eq "Tcl"} { set lref $ref } else { set lref [string tolower $ref] @@ -693,15 +844,17 @@ proc cross-reference {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} { + 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] && \ [info exists manual(name-$name)] && \ - [string compare $manual(tail) "$name.n"]} { + $manual(tail) ne "$name.n"} { return "<A HREF=\"../$manual(name-$name).htm\">$ref</A>" } } - if {[lsearch {stdin stdout stderr end} $lref] >= 0} { + if {$lref in {stdin stdout stderr end}} { # no good place to send these # tcl tokens? # also end @@ -712,7 +865,7 @@ proc cross-reference {ref} { ## would be a self reference ## foreach name $manual(name-$lref) { - if {[lsearch $name $manual(wing-file)/$manual(name)] >= 0} { + if {"$manual(wing-file)/$manual(name)" in $name} { return $ref } } @@ -724,15 +877,15 @@ proc cross-reference {ref} { 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}} { + if {$tcl_i >= 0 && $manual(wing-file) eq "TclCmd" + || $manual(wing-file) eq "TclLib"} { return "<A HREF=\"../$tcl_ref.htm\">$ref</A>" } - if {$tk_i >= 0 && "$manual(wing-file)" == {TkCmd} \ - || "$manual(wing-file)" == {TkLib}} { + if {$tk_i >= 0 && $manual(wing-file) eq "TkCmd" + || $manual(wing-file) eq "TkLib"} { return "<A HREF=\"../$tk_ref.htm\">$ref</A>" } - if {"$lref" == {exit} && "$manual(tail)" == {tclsh.1} && $tcl_i >= 0} { + if {$lref eq "exit" && $manual(tail) eq "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)" @@ -741,57 +894,56 @@ proc cross-reference {ref} { ## ## exceptions, sigh, to the rule ## - switch $manual(tail) { + switch -exact -- $manual(tail) { canvas.n { - if {$lref == {focus}} { - upvar tail tail + if {$lref eq "focus"} { + upvar 1 tail tail set clue [string first command $tail] if {$clue < 0 || $clue > 5} { return $ref } } - if {[lsearch {bitmap image text} $lref] >= 0} { + if {$lref in {bitmap image text}} { return $ref } } - checkbutton.n - - radiobutton.n { - if {[lsearch {image} $lref] >= 0} { + checkbutton.n - radiobutton.n { + if {$lref in {image}} { return $ref } } menu.n { - if {[lsearch {checkbutton radiobutton} $lref] >= 0} { + if {$lref in {checkbutton radiobutton}} { return $ref } } options.n { - if {[lsearch {bitmap image set} $lref] >= 0} { + if {$lref in {bitmap image set}} { return $ref } } regexp.n { - if {[lsearch {string} $lref] >= 0} { + if {$lref in {string}} { return $ref } } source.n { - if {[lsearch {text} $lref] >= 0} { + if {$lref in {text}} { return $ref } } history.n { - if {[lsearch {exec} $lref] >= 0} { + if {$lref in {exec}} { return $ref } } return.n { - if {[lsearch {error continue break} $lref] >= 0} { + if {$lref in {error continue break}} { return $ref } } scrollbar.n { - if {[lsearch {set} $lref] >= 0} { + if {$lref in {set}} { return $ref } } @@ -860,7 +1012,7 @@ proc insert-cross-references {text} { ## ## see which we want to use ## - switch -exact $invert([lindex $offsets 0]) { + switch -exact -- $invert([lindex $offsets 0]) { anchor { if {$offset(end-anchor) < 0} { return [reference-error {Missing end anchor} $text] @@ -873,13 +1025,13 @@ proc insert-cross-references {text} { if {$offset(end-quote) < 0} { return [reference-error "Missing end quote" $text] } - if {$invert([lindex $offsets 1]) == "tk"} { + if {$invert([lindex $offsets 1]) eq "tk"} { set offsets [lreplace $offsets 1 1] } - if {$invert([lindex $offsets 1]) == "tcl"} { + if {$invert([lindex $offsets 1]) eq "tcl"} { set offsets [lreplace $offsets 1 1] } - switch -exact $invert([lindex $offsets 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}] \ @@ -900,14 +1052,16 @@ proc insert-cross-references {text} { return [reference-error "Uncaught quote case" $text] } bold { - if {$offset(end-bold) < 0} { return $text } - if {$invert([lindex $offsets 1]) == "tk"} { + if {$offset(end-bold) < 0} { + return $text + } + if {$invert([lindex $offsets 1]) eq "tk"} { set offsets [lreplace $offsets 1 1] } - if {$invert([lindex $offsets 1]) == "tcl"} { + if {$invert([lindex $offsets 1]) eq "tcl"} { set offsets [lreplace $offsets 1 1] } - switch -exact $invert([lindex $offsets 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}] \ @@ -964,9 +1118,8 @@ proc output-directive {line} { global manual # process format directive split-directive $line code rest - switch -exact $code { - .BS - - .BE { + switch -exact -- $code { + .BS - .BE { # man-puts <HR> } .SH - .SS { @@ -976,16 +1129,16 @@ proc output-directive {line} { # start our own stack of stuff set manual($manual(name)-$manual(section)) {} lappend manual(has-$manual(section)) $manual(name) - if {[string compare .SS $code]} { + if {$code ne ".SS"} { man-puts "<H3>[long-toc $manual(section)]</H3>" } else { man-puts "<H4>[long-toc $manual(section)]</H4>" } # some sections can simply free wheel their way through the text # some sections can be processed in their own loops - switch -exact $manual(section) { + switch -exact -- $manual(section) { NAME { - if {[lsearch {CrtImgType.3 CrtItemType.3 CrtPhImgFmt.3} $manual(tail)] >= 0} { + if {$manual(tail) in {CrtImgType.3 CrtItemType.3 CrtPhImgFmt.3}} { # these manual pages have two NAME sections if {[info exists manual($manual(tail)-NAME)]} { return @@ -1007,15 +1160,19 @@ proc output-directive {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]} { + if { + [next-op-is .nf rest] + || [next-op-is .br rest] + || [next-op-is .fi rest] + } then { continue } - if {[next-op-is .SH rest] - || [next-op-is .SS rest] - || [next-op-is .BE rest] - || [next-op-is .SO rest]} { + if { + [next-op-is .SH rest] + || [next-op-is .SS rest] + || [next-op-is .BE rest] + || [next-op-is .SO rest] + } then { backup-text 1 break } @@ -1028,12 +1185,11 @@ proc output-directive {line} { 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 - } + } + foreach more [split $more \n] { + man-puts $more<BR> + if {$manual(wing-file) in {TclLib TkLib}} { + lappend manual(section-toc) <DD>$more } } } @@ -1101,18 +1257,14 @@ proc output-directive {line} { return } .SO { + set targetPage $rest 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 - } - } + set opts [split $stuff \n\t] man-puts <DL> lappend manual(section-toc) <DL> - foreach option [lsort $opts] { - man-puts "<DT><B>[std-option-toc $option]</B>" + foreach option [lsort -dictionary $opts] { + man-puts "<DT><B>[std-option-toc $option $targetPage]</B>" } man-puts </DL> lappend manual(section-toc) </DL> @@ -1149,10 +1301,13 @@ proc output-directive {line} { } .DS { if {[next-op-is .ta rest]} { - + # skip the leading .ta directive if it is there } if {[match-text @stuff .DE]} { - man-puts <PRE>$stuff</PRE> + set td "<td><p style=\"font-size:12px;padding-left:.5em;padding-right:.5em;\">" + set bodyText [string map [list \n <tr>$td \t $td] \n$stuff] + man-puts "<dl><dd><table border=\"0\">$bodyText</table></dl>" + #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 { @@ -1162,7 +1317,7 @@ proc output-directive {line} { } .CS { if {[next-op-is .ta rest]} { - + # ??? } if {[match-text @stuff .CE]} { man-puts <PRE>$stuff</PRE> @@ -1180,7 +1335,7 @@ proc output-directive {line} { } .ta { # these are tab stop settings for short tables - switch -exact $manual(name):$manual(section) { + switch -exact -- $manual(name):$manual(section) { {bind:MODIFIERS} - {bind:EVENT TYPES} - {bind:BINDING SCRIPTS AND SUBSTITUTIONS} - @@ -1188,7 +1343,6 @@ proc output-directive {line} { {expr:MATH FUNCTIONS} - {history:DESCRIPTION} - {history:HISTORY REVISION} - - {re_syntax:BRACKET EXPRESSIONS} - {switch:DESCRIPTION} - {upvar:DESCRIPTION} { return; # fix.me @@ -1271,32 +1425,38 @@ proc output-directive {line} { ## merge copyright listings ## proc merge-copyrights {l1 l2} { + set merge {} + set re1 {^Copyright +(?:\(c\)|\\\(co|©) +(\w.*?)(?:all rights reserved)?(?:\. )*$} + set re2 {^(\d+) +(?:by +)?(\w.*)$} ;# date who + set re3 {^(\d+)-(\d+) +(?:by +)?(\w.*)$} ;# from to who + set re4 {^(\d+), *(\d+) +(?:by +)?(\w.*)$} ;# date1 date2 who foreach copyright [concat $l1 $l2] { - if {[regexp {^Copyright +\(c\) +(\d+) +(by +)?(\w.*)$} $copyright all date by who]} { - lappend dates($who) $date - continue - } - if {[regexp {^Copyright +\(c\) +(\d+)-(\d+) +(by +)?(\w.*)$} $copyright all from to by who]} { - for {set date $from} {$date <= $to} {incr date} { + if {[regexp -nocase -- $re1 $copyright -> info]} { + set info [string trimright $info ". "] ; # remove extra period + if {[regexp -- $re2 $info -> date who]} { lappend dates($who) $date + continue + } elseif {[regexp -- $re3 $info -> from to who]} { + for {set date $from} {$date <= $to} {incr date} { + lappend dates($who) $date + } + continue + } elseif {[regexp -- $re3 $info -> date1 date2 who]} { + lappend dates($who) $date1 $date2 + continue } - continue - } - if {[regexp {^Copyright +\(c\) +(\d+), *(\d+) +(by +)?(\w.*)$} $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" + set list [lsort -dictionary $dates($who)] + if {[llength $list] == 1 || [lindex $list 0] eq [lrange $list end end]} { + lappend merge "Copyright © [lindex $list 0] $who" } else { - lappend merge "Copyright (c) [lindex $list 0]-[lrange $list end end] $who" + lappend merge "Copyright © [lindex $list 0]-[lrange $list end end] $who" } } - return [lsort $merge] + return [lsort -dictionary $merge] } proc makedirhier {dir} { @@ -1306,35 +1466,64 @@ proc makedirhier {dir} { } } +proc addbuffer {args} { + global manual + if {$manual(partial-text) ne ""} { + append manual(partial-text) \n + } + append manual(partial-text) [join $args ""] +} +proc flushbuffer {} { + global manual + if {$manual(partial-text) ne ""} { + lappend manual(text) [process-text $manual(partial-text)] + set manual(partial-text) "" + } +} + ## ## 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 tcltkdesc + global manual overall_title tcltkdesc makedirhier $html + set cssfd [open $html/$::CSSFILE w] + puts $cssfd [gencss] + close $cssfd 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(short-toc-fp) [open $html/[indexfile] w] + puts $manual(short-toc-fp) [htmlhead $overall_title $overall_title] + puts $manual(short-toc-fp) "<DL class=\"keylist\">" set manual(merge-copyrights) {} foreach arg $args { - if {$arg == ""} {continue} + # preprocess to set up subheader for the rest of the files + if {![llength $arg]} { + continue + } + set name [lindex $arg 1] + set file [lindex $arg 2] + lappend manual(subheader) $name $file + } + foreach arg $args { + if {![llength $arg]} { + continue + } 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] + set manual(wing-toc-fp) [open $html/$manual(wing-file)/[indexfile] 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)" + puts $manual(short-toc-fp) "<DT><A HREF=\"$manual(wing-file)/[indexfile]\">$manual(wing-name)</A></DT><DD>$manual(wing-description)</DD>" # 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>" + puts $manual(wing-toc-fp) [htmlhead $manual(wing-name) \ + $manual(wing-name) $overall_title "../[indexfile]"] # initialize the short table of contents for this section set manual(wing-toc) {} # initialize the man directory for this section @@ -1342,19 +1531,26 @@ proc make-man-pages {html args} { # 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) [lsort -dictionary [glob $manual(wing-glob)]] + set n [lsearch -glob $manual(pages) */ttk_widget.n] + if {$n >= 0} { + set manual(pages) "[lindex $manual(pages) $n] [lreplace $manual(pages) $n $n]" + } + set n [lsearch -glob $manual(pages) */options.n] + if {$n >= 0} { 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) { + set LQ \u201c + set RQ \u201d + foreach manual_page $manual(pages) { + set manual(page) $manual_page # 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} { + if {$manual(name) in {case pack-old menubar}} { # obsolete manerror "discarding $manual(name)" continue @@ -1370,140 +1566,167 @@ proc make-man-pages {html args} { set manual(section-toc) {} set manual(section-toc-n) 1 set manual(copyrights) {} + lappend manual(copyrights) "Copyright © 1995-1997 Roger E. Critchlow Jr." 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]} { + if {[regexp {Copyright (?:\(c\)|\\\(co).*$} $line copyright]} { lappend manual(copyrights) $copyright } # comment continue } - if {"$line" == {'}} { + if {"$line" eq {'}} { # comment continue } - if {[parse-directive $line code rest]} { - switch -exact $code { - .ad - .na - .so - .ne - .AS - .VE - .VS - - . { - # ignore - continue + if {![parse-directive $line code rest]} { + addbuffer $line + continue + } + switch -exact -- $code { + .ad - .na - .so - .ne - .AS - .VE - .VS - . { + # ignore + continue + } + } + switch -exact -- $code { + .SH - .SS { + flushbuffer + if {[llength $rest] == 0} { + gets $manual(infp) rest } + lappend manual(text) "$code [unquote $rest]" } - if {"$manual(partial-text)" != {}} { - lappend manual(text) [process-text $manual(partial-text)] - set manual(partial-text) {} + .TH { + flushbuffer + lappend manual(text) "$code [unquote $rest]" } - switch -exact $code { - .SH - .SS { - if {[llength $rest] == 0} { - gets $manual(infp) rest - } - lappend manual(text) "$code [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 {^(.*) +\d+$} $rest all rest - lappend manual(text) ".IP [process-text [unquote [string trim $rest]]]" - } - .TP { - while {[is-a-directive [set next [gets $manual(infp)]]]} { - manerror "ignoring $next after .TP" - } - 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 + .QW { + set rest [regexp -all -inline {\"(?:[^""]+)\"|\S+} $rest] + addbuffer $LQ [unquote [lindex $rest 0]] $RQ \ + [unquote [lindex $rest 1]] + } + .PQ { + set rest [regexp -all -inline {\"(?:[^""]+)\"|\S+} $rest] + addbuffer ( $LQ [unquote [lindex $rest 0]] $RQ \ + [unquote [lindex $rest 1]] ) \ + [unquote [lindex $rest 2]] + } + .QR { + set rest [regexp -all -inline {\"(?:[^""]+)\"|\S+} $rest] + addbuffer $LQ [unquote [lindex $rest 0]] - \ + [unquote [lindex $rest 1]] $RQ \ + [unquote [lindex $rest 2]] + } + .MT { + addbuffer $LQ$RQ + } + .HS - .UL - .ta { + flushbuffer + lappend manual(text) "$code [unquote $rest]" + } + .BS - .BE - .br - .fi - .sp - .nf { + flushbuffer + if {"$rest" ne {}} { + manerror "unexpected argument: $line" } - .DE { - incr manual(.DS) -1 - lappend manual(text) $code + lappend manual(text) $code + } + .AP { + flushbuffer + lappend manual(text) [concat .IP [process-text "[lindex $rest 0] \\fB[lindex $rest 1]\\fR ([lindex $rest 2])"]] + } + .IP { + flushbuffer + regexp {^(.*) +\d+$} $rest all rest + lappend manual(text) ".IP [process-text [unquote [string trim $rest]]]" + } + .TP { + flushbuffer + while {[is-a-directive [set next [gets $manual(infp)]]]} { + manerror "ignoring $next after .TP" } - .CS { - incr manual(.CS) - lappend manual(text) $code + if {"$next" ne {'}} { + lappend manual(text) ".IP [process-text $next]" } - .CE { - incr manual(.CS) -1 - lappend manual(text) $code + } + .OP { + flushbuffer + lappend manual(text) [concat .OP [process-text \ + "\\fB[lindex $rest 0]\\fR \\fB[lindex $rest 1]\\fR \\fB[lindex $rest 2]\\fR"]] + } + .PP - .LP { + flushbuffer + lappend manual(text) {.PP} + } + .RS { + flushbuffer + incr manual(.RS) + lappend manual(text) $code + } + .RE { + flushbuffer + incr manual(.RS) -1 + lappend manual(text) $code + } + .SO { + flushbuffer + incr manual(.SO) + if {[llength $rest] == 0} { + lappend manual(text) "$code options" + } else { + lappend manual(text) "$code [unquote $rest]" } - .de { - while {[gets $manual(infp) line] >= 0} { - if {[string match "..*" $line]} { - break - } + } + .SE { + flushbuffer + incr manual(.SO) -1 + lappend manual(text) $code + } + .DS { + flushbuffer + incr manual(.DS) + lappend manual(text) $code + } + .DE { + flushbuffer + incr manual(.DS) -1 + lappend manual(text) $code + } + .CS { + flushbuffer + incr manual(.CS) + lappend manual(text) $code + } + .CE { + flushbuffer + incr manual(.CS) -1 + lappend manual(text) $code + } + .de { + while {[gets $manual(infp) line] >= 0} { + if {[string match "..*" $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 + .. { + error "found .. outside of .de" + } + default { + flushbuffer + manerror "unrecognized format directive: $line" } } } - if {$manual(partial-text) != ""} { - lappend manual(text) [process-text $manual(partial-text)] - } + flushbuffer close $manual(infp) # fixups if {$manual(.RS) != 0} { - if {$manual(name) != "selection"} { - puts "unbalanced .RS .RE" - } + puts "unbalanced .RS .RE" } if {$manual(.DS) != 0} { puts "unbalanced .DS .DE" @@ -1516,25 +1739,17 @@ proc make-man-pages {html args} { } # output conversion open-text + set haserror 0 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" + set manual($manual(name)-title) "[lindex $rest 0] manual page - [lrange $rest 4 end]" + } else { + set haserror 1 + manerror "no .HS or .TH record found" + } + if {!$haserror} { while {[more-text]} { set line [next-text] if {[is-a-directive $line]} { @@ -1543,19 +1758,13 @@ proc make-man-pages {html args} { 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>" + man-puts [copyout $manual(copyrights) "../"] 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>] + set manual(toc-$manual(wing-file)-$manual(name)) [concat <DL> $manual(section-toc) </DL>] } # @@ -1571,7 +1780,7 @@ proc make-man-pages {html args} { set nrows [expr {([llength $manual(wing-toc)]+$perline)/$perline}] set n 0 catch {unset rows} - foreach name [lsort $manual(wing-toc)] { + foreach name [lsort -dictionary $manual(wing-toc)] { set tail $manual(name-$name) if {[llength $tail] > 1} { manerror "$name is defined in more than one file: $tail" @@ -1591,12 +1800,8 @@ proc make-man-pages {html args} { # # 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>" + puts $manual(wing-toc-fp) [copyout $manual(wing-copyrights) "../"] + puts $manual(wing-toc-fp) "</BODY></HTML>" close $manual(wing-toc-fp) set manual(merge-copyrights) [merge-copyrights $manual(merge-copyrights) $manual(wing-copyrights)] } @@ -1604,66 +1809,68 @@ proc make-man-pages {html args} { ## ## build the keyword index. ## - proc strcasecmp {a b} { return [string compare -nocase $a $b] } - set keys [lsort -command strcasecmp [array names manual keyword-*]] + file delete -force -- $html/Keywords makedirhier $html/Keywords - catch {eval file delete -- [glob $html/Keywords/*]} - puts $manual(short-toc-fp) "<DT><A HREF=\"Keywords/contents.htm\">Keywords</A><DD>The keywords from the $tcltkdesc man pages." - set keyfp [open $html/Keywords/contents.htm w] - puts $keyfp "<HTML><HEAD><TITLE>$tcltkdesc Keywords</TITLE></HEAD>" - puts $keyfp "<BODY><HR><H3>$tcltkdesc 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 keyfp [open $html/Keywords/[indexfile] w] + puts $keyfp [htmlhead "$tcltkdesc Keywords" "$tcltkdesc Keywords" \ + $overall_title "../[indexfile]"] + set letters {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} + # Create header first + set keyheader {} + foreach a $letters { + set keys [array names manual "keyword-\[[string totitle $a$a]\]*"] + if {[llength $keys]} { + lappend keyheader "<A HREF=\"$a.htm\">$a</A>" + } else { + # No keywords for this letter + lappend keyheader $a + } + } + set keyheader "<H3>[join $keyheader " |\n"]</H3>" + puts $keyfp $keyheader + foreach a $letters { + set keys [array names manual "keyword-\[[string totitle $a$a]\]*"] + if {![llength $keys]} { + continue + } + # Per-keyword page set afp [open $html/Keywords/$a.htm w] - puts $afp "<HTML><HEAD><TITLE>$tcltkdesc Keywords - $a</TITLE></HEAD>" - puts $afp "<BODY><HR><H3>$tcltkdesc 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 {[string match -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 [htmlhead "$tcltkdesc Keywords - $a" \ + "$tcltkdesc Keywords - $a" \ + $overall_title "../[indexfile]"] + puts $afp $keyheader + puts $afp "<DL class=\"keylist\">" + foreach k [lsort -dictionary $keys] { + set k [string range $k 8 end] + puts $afp "<DT><A NAME=\"$k\">$k</A></DT>" + puts $afp "<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 {, }]</DD>" } - puts $afp "</DL><HR><PRE>" + puts $afp "</DL>" # 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>" + puts $afp [copyout $manual(merge-copyrights)] + puts $afp "</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> + puts $keyfp [copyout $manual(merge-copyrights)] + puts $keyfp "</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>" + puts $manual(short-toc-fp) "<DT><A HREF=\"Keywords/[indexfile]\">Keywords</A><DD>The keywords from the $tcltkdesc man pages." + puts $manual(short-toc-fp) "</DL>" # 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>" + puts $manual(short-toc-fp) [copyout $manual(merge-copyrights)] + puts $manual(short-toc-fp) "</BODY></HTML>" close $manual(short-toc-fp) ## @@ -1687,22 +1894,26 @@ proc make-man-pages {html args} { 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 GetDash - GetJustify GetPixels GetVisual ParseArgv QueueEvent - } $manual(tail)] >= 0} { + set outfd [open $html/$manual(wing-file)/$manual(name).htm w] + puts $outfd [htmlhead "$manual($manual(name)-title)" \ + $manual(name) $manual(wing-file) "[indexfile]" \ + $overall_title "../[indexfile]"] + if { + (($ntext > 60) && ($ntoc > 32)) || $manual(tail) in { + Hash LinkVar SetVar TraceVar ConfigWidg CrtImgType CrtItemType + CrtPhImgFmt DoOneEvent GetBitmap GetColor GetCursor GetDash + GetJustify GetPixels GetVisual ParseArgv QueueEvent + } + } then { foreach item $toc { - puts $manual(outfp) $item + puts $outfd $item } } foreach item $text { - puts $manual(outfp) [insert-cross-references $item] + puts $outfd [insert-cross-references $item] } - puts $manual(outfp) </BODY></HTML> - close $manual(outfp) + puts $outfd "</BODY></HTML>" + close $outfd } return {} } @@ -1710,16 +1921,28 @@ proc make-man-pages {html args} { parse_command_line set tcltkdesc ""; set cmdesc ""; set appdir "" -if {$build_tcl} {append tcltkdesc "Tcl"; append cmdesc "Tcl"; append appdir "$tcldir"} -if {$build_tcl && $build_tk} {append tcltkdesc "/"; append cmdesc " and "; append appdir ","} -if {$build_tk} {append tcltkdesc "Tk"; append cmdesc "Tk"; append appdir "$tkdir"} +if {$build_tcl} { + append tcltkdesc "Tcl" + append cmdesc "Tcl" + append appdir "$tcldir" +} +if {$build_tcl && $build_tk} { + append tcltkdesc "/" + append cmdesc " and " + append appdir "," +} +if {$build_tk} { + append tcltkdesc "Tk" + append cmdesc "Tk" + append appdir "$tkdir" +} set usercmddesc "The interpreters which implement $cmdesc." 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.} - + if {1} { if {[catch { make-man-pages $webdir \ |