diff options
Diffstat (limited to 'tools')
| -rw-r--r-- | tools/man2help.tcl | 12 | ||||
| -rw-r--r-- | tools/man2help2.tcl | 79 | ||||
| -rw-r--r-- | tools/tcl.wse.in | 2 | ||||
| -rwxr-xr-x[-rw-r--r--] | tools/tcltk-man2html.tcl (renamed from tools/tcl8.1-tk8.1-man-html.tcl) | 1148 |
4 files changed, 626 insertions, 615 deletions
diff --git a/tools/man2help.tcl b/tools/man2help.tcl index e86e78b..efe254b 100644 --- a/tools/man2help.tcl +++ b/tools/man2help.tcl @@ -6,7 +6,7 @@ # # Copyright (c) 1996 by Sun Microsystems, Inc. # -# RCS: @(#) $Id: man2help.tcl,v 1.4 1999/02/19 02:14:56 stanton Exp $ +# RCS: @(#) $Id: man2help.tcl,v 1.5 1999/12/21 23:59:28 hobbs Exp $ # # @@ -17,7 +17,6 @@ proc generateContents {basename version files} { global curID topics set curID 0 foreach f $files { - regsub -all -- {-} [file tail $f] {} curFile puts "Pass 1 -- $f" flush stdout doFile $f @@ -30,7 +29,7 @@ proc generateContents {basename version files} { puts $fd "1 $section" set lastTopic {} foreach topic [getTopics $package $section] { - if {[string compare $lastTopic $topic] != 0} { + if {[string equal $lastTopic $topic]} { set id $topics($package,$section,$topic) puts $fd "2 $topic=$id" set lastTopic $topic @@ -55,12 +54,11 @@ proc generateHelp {basename files} { lappend id_keywords($id) $key } } - + set file [open "$basename.rtf" w] fconfigure $file -translation crlf puts $file "\{\\rtf1\\ansi \\deff0\\deflang1033\{\\fonttbl\{\\f0\\froman\\fcharset0\\fprq2 Times New Roman\;\}\}" foreach f $files { - regsub -all -- {-} [file tail $f] {} curFile puts "Pass 2 -- $f" flush stdout initGlobals @@ -117,11 +115,11 @@ set version [lindex $argv 1] set files {} foreach i [lrange $argv 2 end] { set i [file join $i] - if [file isdir $i] { + if {[file isdir $i]} { foreach f [lsort [glob [file join $i *.\[13n\]]]] { lappend files $f } - } elseif [file exists $i] { + } elseif {[file exists $i]} { lappend files $i } } diff --git a/tools/man2help2.tcl b/tools/man2help2.tcl index dce162f..df04a6c 100644 --- a/tools/man2help2.tcl +++ b/tools/man2help2.tcl @@ -9,7 +9,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: man2help2.tcl,v 1.3 1998/09/14 18:40:15 stanton Exp $ +# RCS: @(#) $Id: man2help2.tcl,v 1.4 1999/12/21 23:59:29 hobbs Exp $ # # Global variables used by these scripts: @@ -82,7 +82,7 @@ proc beginFont {font} { global file state textSetup - if {$state(curFont) == $font} { + if {[string equal $state(curFont) $font]} { return } endFont @@ -101,7 +101,7 @@ proc beginFont {font} { proc endFont {} { global state file - if {$state(curFont) != ""} { + if {[string compare $state(curFont) ""]} { puts -nonewline $file $state(end$state(curFont)) set state(curFont) "" } @@ -144,14 +144,18 @@ proc text {string} { global file state chars textSetup - regsub -all "(\[\\\\\{\}\])" $string {\\\1} string - regsub -all { } $string {\\tab } string - regsub -all '' $string \" string - regsub -all `` $string \" string - -# Check if this is the beginning of an international character string. -# If so, look up the sequence in the chars table and substitute the -# appropriate hex value. + set string [string map [list \ + "\\" "\\\\" \ + "\{" "\\\{" \ + "\}" "\}" \ + "\t" {\tab } \ + '' \" \ + `` \" \ + ] $string] + + # Check if this is the beginning of an international character string. + # If so, look up the sequence in the chars table and substitute the + # appropriate hex value. if {$state(intl)} { if {[regexp {^'([^']*)'} $string dummy ch]} { @@ -173,10 +177,10 @@ proc text {string} { SEE { global topics curPkg curSect foreach i [split $string] { - if ![regexp -nocase {^[a-z_0-9]+} [string trim $i] i ] { + if {![regexp -nocase {^[a-z_0-9]+} [string trim $i] i ]} { continue } - if ![catch {set ref $topics($curPkg,$curSect,$i)} ] { + if {![catch {set ref $topics($curPkg,$curSect,$i)} ]} { regsub $i $string [link $i $ref] string } } @@ -204,7 +208,7 @@ proc insertRef {string} { set path {} set string [string trim $string] set ref {} - if [info exists topics($curPkg,$curSect,$string)] { + if {[info exists topics($curPkg,$curSect,$string)]} { set ref $topics($curPkg,$curSect,$string) } else { set sites [array names topics "$curPkg,*,$string"] @@ -220,7 +224,7 @@ proc insertRef {string} { } } - if {([string compare $ref {}] != 0) && ($ref != $curID)} { + if {([string equal $ref {}]) && ($ref != $curID)} { set string [link $string $ref] } return $string @@ -476,39 +480,38 @@ proc formattedText {text} { text $text return } - text [string range $text 0 [expr $index-1]] - set c [string index $text [expr $index+1]] + text [string range $text 0 [expr {$index-1}]] + set c [string index $text [expr {$index+1}]] switch -- $c { f { - font [string index $text [expr $index+2]] - set text [string range $text [expr $index+3] end] + font [string index $text [expr {$index+2}]] + set text [string range $text [expr {$index+3}] end] } e { - text \\ - set text [string range $text [expr $index+2] end] + text "\\" + set text [string range $text [expr {$index+2}] end] } - { dash - set text [string range $text [expr $index+2] end] + set text [string range $text [expr {$index+2}] end] } | { - set text [string range $text [expr $index+2] end] + set text [string range $text [expr {$index+2}] end] } o { - text \\' + text "\\'" regexp "'([^']*)'(.*)" $text all ch text text $chars($ch) } default { puts stderr "Unknown sequence: \\$c" - set text [string range $text [expr $index+2] end] + set text [string range $text [expr {$index+2}] end] } } } } - # dash -- # # This procedure is invoked to handle dash characters ("\-" in @@ -519,7 +522,7 @@ proc formattedText {text} { proc dash {} { global state - if {$state(textState) == "NAME"} { + if {[string equal $state(textState) "NAME"]} { set state(textState) 0 } text "-" @@ -554,10 +557,9 @@ proc setTabs {tabList} { global file state foreach arg $tabList { - set distance [expr $state(leftMargin) \ - + $state(offset) * $state(nestingLevel) \ - + [getTwips $arg]] - puts $file [format "\\tx%.0f" [expr round($distance)]] + set distance [expr {$state(leftMargin) \ + + ($state(offset) * $state(nestingLevel)) + [getTwips $arg]}] + puts $file [format "\\tx%.0f" [expr {round($distance)}]] } } @@ -590,10 +592,10 @@ proc lineBreak {} { proc newline {} { global state - if $state(inTP) { + if {$state(inTP)} { set state(inTP) 0 lineBreak - } elseif $state(noFill) { + } elseif {$state(noFill)} { lineBreak } else { text " " @@ -792,7 +794,7 @@ proc TPmacro {argList} { if {$length == 0} { set val 0.5i } else { - set val [expr ([lindex $argList 0] * 100.0)/1440]i + set val [expr {([lindex $argList 0] * 100.0)/1440}]i } newPara $val -$val setTabs $val @@ -887,9 +889,8 @@ proc newPara {leftIndent {firstIndent 0i}} { if $state(paragraph) { puts -nonewline $file "\\line\n" } - set state(leftIndent) [expr $state(leftMargin) \ - + $state(offset) * $state(nestingLevel) \ - + [getTwips $leftIndent]] + set state(leftIndent) [expr {$state(leftMargin) \ + + ($state(offset) * $state(nestingLevel)) +[getTwips $leftIndent]}] set state(firstIndent) [getTwips $firstIndent] set state(paragraphPending) 1 } @@ -911,10 +912,10 @@ proc getTwips {arg} { } switch -- $units { c { - set distance [expr $distance * 567] + set distance [expr {$distance * 567}] } i { - set distance [expr $distance * 1440] + set distance [expr {$distance * 1440}] } default { puts stderr "bad units in distance \"$arg\"" diff --git a/tools/tcl.wse.in b/tools/tcl.wse.in index 20e7a2c..61de5cf 100644 --- a/tools/tcl.wse.in +++ b/tools/tcl.wse.in @@ -12,7 +12,7 @@ item: Global Log Pathname=%MAINDIR%\INSTALL.LOG Message Font=MS Sans Serif Font Size=8 - Disk Label=tcl8.3a1 + Disk Label=tcl8.3b1 Disk Filename=setup Patch Flags=0000000000000001 Patch Threshold=85 diff --git a/tools/tcl8.1-tk8.1-man-html.tcl b/tools/tcltk-man2html.tcl index cb51f34..3893e55 100644..100755 --- a/tools/tcl8.1-tk8.1-man-html.tcl +++ b/tools/tcltk-man2html.tcl @@ -1,5 +1,9 @@ -#!/usr/local/bin/tclsh8.0 -# +#!/bin/sh +# The next line is executed by /bin/sh, but not tcl \ +exec tclsh8.2 "$0" ${1+"$@"} + +package require Tcl 8.2 + # Convert Ousterhout format man pages into highly crosslinked # hypertext. # @@ -61,7 +65,7 @@ # Oct 24, 1997 - moved from 8.0b1 to 8.0 release # -set Version "0.14" +set Version "0.20" proc parse_command_line {} { global argv Version @@ -77,8 +81,8 @@ proc parse_command_line {} { 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} + set tclDirList {tcl8.3 tcl8.2 tcl8.1 tcl8.0 tcl} + set tkDirList {tk8.3 tk8.2 tk8.1 tk8.0 tk} # Handle arguments a la GNU: # --version @@ -149,76 +153,77 @@ proc parse_command_line {} { } proc capitalize {string} { - return [string toupper [string index $string 0]][string range $string 1 end] + return [string toupper $string 0] } ## ## ## -set manual(report-level) 1; +set manual(report-level) 1 proc manerror {msg} { - global manual; - set name {}; - set subj {}; + global manual + set name {} + set subj {} if {[info exists manual(name)]} { - set name $manual(name); + set name $manual(name) } - if {[info exists manual(section)] && "$manual(section)" != {}} { - puts stderr "$name: $manual(section): $msg"; + if {[info exists manual(section)] && [string length $manual(section)]} { + puts stderr "$name: $manual(section): $msg" } else { - puts stderr "$name: $msg"; + puts stderr "$name: $msg" } } proc manreport {level msg} { - global manual; + global manual if {$level < $manual(report-level)} { - manerror $msg; + manerror $msg } } proc fatal {msg} { - global manual; - manerror $msg; - exit 1; + global manual + manerror $msg + exit 1 } ## ## parsing ## proc unquote arg { - regsub -all \" $arg {} arg; - return $arg; + return [string map [list \" {}] $arg] } proc parse-directive {line codename restname} { - upvar $codename code $restname rest; - return [regexp {^(\.[.a-zA-Z0-9]*) *(.*)} $line all code rest]; + upvar $codename code $restname rest + return [regexp {^(\.[.a-zA-Z0-9]*) *(.*)} $line all code rest] } proc process-text {text} { - global manual; + 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; + set text [string map [list \ + {\&} "\t" \ + {&} {&} \ + {\\} {\} \ + {\e} {\} \ + {\ } { } \ + {\|} { } \ + {\0} { } \ + {\%} {} \ + "\\\n" "\n" \ + \" {"} \ + {<} {<} \ + {>} {>} \ + {\(+-} {±} \ + {\fP} {\fR} \ + {\.} . \ + ] $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 + regsub -all "\\\\\n" $text "\\&\#92;\n" text; # backslashed newline while {[regexp {\\} $text]} { # C R if {[regsub {^([^\\]*)\\fC([^\\]*)\\fR(.*)$} $text {\1<TT>\2</TT>\3} text]} continue @@ -234,157 +239,160 @@ proc process-text {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"; - set text $ntext; - continue; + manerror "process-text: impotent font change: $text" + set text $ntext + continue } # unrecognized manerror "process-text: uncaught backslash: $text" - regsub -all {\\} $text {#92;} text + set text [string map [list "\\" "#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; + 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)]; + global manual + return [expr {$manual(text-pointer) < $manual(text-length)}] } proc next-text {} { - global manual; + global manual if {[more-text]} { - set text [lindex $manual(text) $manual(text-pointer)]; - incr manual(text-pointer); - return $text; + set text [lindex $manual(text) $manual(text-pointer)] + incr manual(text-pointer) + return $text } - manerror "read past end of text"; - error "fatal"; + 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]]; + 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; + 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; + set text [lindex $manual(text) $manual(text-pointer)] + if {[string equal -length 3 $text $op]} { + set rest [string range $text 4 end] + incr manual(text-pointer) + return 1 } } - return 0; + return 0 } proc backup-text {n} { - global manual; + global manual if {$manual(text-pointer)-$n >= 0} { - incr manual(text-pointer) -$n; + incr manual(text-pointer) -$n } } proc match-text args { - global manual; - set nargs [llength $args]; + global manual + set nargs [llength $args] if {$manual(text-pointer) + $nargs > $manual(text-length)} { - return 0; + return 0 } - set nback 0; + set nback 0 foreach arg $args { - if { ! [more-text]} { - backup-text $nback; - return 0; + 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; + set arg [string trim $arg] + set targ [string trim [lindex $manual(text) $manual(text-pointer)]] + if {[string equal $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; + 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]\ + && [string equal $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; + 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]; + 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; + global manual + lappend manual(output-$manual(wing-file)-$manual(name)) $text } ## ## build hypertext links to tables of contents ## proc long-toc {text} { - global manual; + 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>"; + 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}} { + 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 {"$manual(name):$manual(section)" == {options:DESCRIPTION}} { + 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>"; + 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)"; + error "option-toc in $manual(name) section $manual(section)" } } proc std-option-toc {name} { - global manual; + global manual if {[info exists manual(standard-option-$name)]} { - lappend manual(section-toc) <DD>$manual(standard-option-$name); - return $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>"; + 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 @@ -392,91 +400,91 @@ proc std-option-toc {name} { ## proc output-widget-options {rest} { global manual - man-puts <DL>; - lappend manual(section-toc) <DL>; - backup-text 1; + 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]; + 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]; + set switch [lrange $rest 0 2] + set name [lindex $rest 3] + set class [lindex $rest 4] } default { - fatal "bad .OP $rest"; + 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"; + 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"; + 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]*)(</.>)$} $name all oname name cname]} { + error "not Name: $name" } - if { ! [regexp {^(<.>)([a-zA-Z0-9]*)(</.>)$} $class all oclass class cclass]} { - error "not Class: $class"; + 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]; + 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>; + man-puts </DL> + lappend manual(section-toc) </DL> } ## ## process .RS lists ## proc output-RS-list {} { - global manual; + global manual if {[next-op-is .IP rest]} { - output-IP-list .RS .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; + return } if {[next-op-is .RE rest]} { - return; + return } } - man-puts <DL><P><DD>; + man-puts <DL><P><DD> while {[more-text]} { - set line [next-text]; + set line [next-text] if {[is-a-directive $line]} { split-directive $line code rest switch -exact $code { .RE { - break; + break } .SH { - manerror "unbalanced .RS at section end"; - backup-text 1; - break; + manerror "unbalanced .RS at section end" + backup-text 1 + break } default { - output-directive $line; + output-directive $line } } } else { - man-puts $line; + man-puts $line } } - man-puts </DL>; + man-puts </DL> } ## @@ -484,56 +492,58 @@ proc output-RS-list {} { ## numeric lists, or definition lists ## proc output-IP-list {context code rest} { - global manual; - if {"$rest" == {}} { + global manual + if {[string equal $rest {}]} { # blank label, plain indent, no contents entry man-puts <DL><P><DD> while {[more-text]} { - set line [next-text]; + set line [next-text] if {[is-a-directive $line]} { split-directive $line code rest - if {"$code" == {.IP} && "$rest" == {}} { - man-puts "<P>"; - continue; + if {[string equal $code ".IP"] && [string equal $rest {}]} { + man-puts "<P>" + continue } if {[lsearch {.br .DS .RS} $code] >= 0} { - output-directive $line; + output-directive $line } else { - backup-text 1; - break; + backup-text 1 + break } } else { - man-puts $line; + man-puts $line } } - man-puts </DL>; + man-puts </DL> } else { # labelled list, make contents - if {"$context" != {.SH}} { - man-puts <P>; + if {[string compare $context ".SH"]} { + man-puts <P> } man-puts <DL> - lappend manual(section-toc) <DL>; + lappend manual(section-toc) <DL> backup-text 1 set accept_RE 0 while {[more-text]} { - set line [next-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; + continue } - if {"$manual(section)" == {ARGUMENTS} || [regexp {^\[[0-9]+\]$} $rest]} { - man-puts "<P><DT>$rest<DD>"; + if {[string equal $manual(section) "ARGUMENTS"] || \ + [regexp {^\[[0-9]+\]$} $rest]} { + man-puts "<P><DT>$rest<DD>" } else { - man-puts "<P><DT>[long-toc $rest]<DD>"; + man-puts "<P><DT>[long-toc $rest]<DD>" } - if {"$manual(name):$manual(section)" == {selection:DESCRIPTION}} { + if {[string equal $manual(name):$manual(section) \ + "selection:DESCRIPTION"]} { if {[match-text .RE @rest .RS .RS]} { - man-puts <DT>[long-toc $rest]<DD>; + man-puts <DT>[long-toc $rest]<DD> } } } @@ -541,23 +551,23 @@ proc output-IP-list {context code rest} { .br - .DS - .CS { - output-directive $line; + output-directive $line } .RS { if {[match-text .RS]} { - output-directive $line; - incr accept_RE 1; + output-directive $line + incr accept_RE 1 } elseif {[match-text .CS]} { output-directive .CS - incr accept_RE 1; + incr accept_RE 1 } elseif {[match-text .PP]} { output-directive .PP - incr accept_RE 1; + incr accept_RE 1 } elseif {[match-text .DS]} { output-directive .DS - incr accept_RE 1; + incr accept_RE 1 } else { - output-directive $line; + output-directive $line } } .PP { @@ -565,13 +575,13 @@ proc output-IP-list {context code rest} { # yet another nroff kludge as above man-puts "<P><DT>[long-toc $rest1]" man-puts "<DT>[long-toc $rest2]<DD>" - incr accept_RE 1; + 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; + break } else { man-puts "<P>$rest" incr accept_RE -1 @@ -580,27 +590,27 @@ proc output-IP-list {context code rest} { output-directive $line } else { backup-text 1 - break; + break } } .RE { if { ! $accept_RE} { - backup-text 1; - break; + backup-text 1 + break } incr accept_RE -1 } default { - backup-text 1; - break; + backup-text 1 + break } } } else { - man-puts $line; + man-puts $line } } - man-puts <P></DL>; - lappend manual(section-toc) </DL>; + man-puts <P></DL> + lappend manual(section-toc) </DL> if {$accept_RE} { manerror "missing .RE in output-IP-list" } @@ -613,45 +623,46 @@ proc output-IP-list {context code rest} { ## followed by a hyphen and a short description. ## proc output-name {line} { - global manual; + global manual # split name line into pieces - regexp {^([^-]+) - (.*)$} $line all head tail; + 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]; + set name [string trim $name] if {[llength $name] > 1} { - manerror "name has a space: {$name}\nfrom: $line"; + manerror "name has a space: {$name}\nfrom: $line" } - lappend manual(wing-toc) $name; - lappend manual(name-$name) $manual(wing-file)/$manual(name); + 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; + global manual if {[string match Tcl_* $ref]} { - set lref $ref; + set lref $ref } elseif {[string match Tk_* $ref]} { - set lref $ref; - } elseif {"$ref" == {Tcl}} { - set lref $ref; + set lref $ref + } elseif {[string equal $ref "Tcl"]} { + set lref $ref } else { - set lref [string tolower $ref]; + 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>"; + after clipboard grab image option pack place selection tk tkwait update winfo wm} { + if {[regexp "^$name \[a-z0-9]*\$" $lref] && \ + [string compare $manual(tail) "$name.n"]} { + return "<A HREF=\"../$manual(name-$name).htm\">$ref</A>" } } if {[lsearch {stdin stdout stderr end} $lref] >= 0} { @@ -659,35 +670,35 @@ proc cross-reference {ref} { # tcl tokens? # also end } - return $ref; + return $ref } ## ## would be a self reference ## foreach name $manual(name-$lref) { if {[lsearch $name $manual(wing-file)/$manual(name)] >= 0} { - return $ref; + 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]; + 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>"; + 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>"; + 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>"; + 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; + puts stderr "multiple cross reference to $ref in $manual(name-$lref) from $manual(wing-file)/$manual(tail)" + return $ref } ## ## exceptions, sigh, to the rule @@ -695,76 +706,76 @@ proc cross-reference {ref} { switch $manual(tail) { canvas.n { if {$lref == {focus}} { - upvar tail tail; - set clue [string first command $tail]; + upvar tail tail + set clue [string first command $tail] if {$clue < 0 || $clue > 5} { - return $ref; + return $ref } } if {[lsearch {bitmap image text} $lref] >= 0} { - return $ref; + return $ref } } checkbutton.n - radiobutton.n { if {[lsearch {image} $lref] >= 0} { - return $ref; + return $ref } } menu.n { if {[lsearch {checkbutton radiobutton} $lref] >= 0} { - return $ref; + return $ref } } options.n { if {[lsearch {bitmap image set} $lref] >= 0} { - return $ref; + return $ref } } regexp.n { if {[lsearch {string} $lref] >= 0} { - return $ref; + return $ref } } source.n { if {[lsearch {text} $lref] >= 0} { - return $ref; + return $ref } } history.n { if {[lsearch {exec} $lref] >= 0} { - return $ref; + return $ref } } return.n { if {[lsearch {error continue break} $lref] >= 0} { - return $ref; + return $ref } } scrollbar.n { if {[lsearch {set} $lref] >= 0} { - return $ref; + return $ref } } } ## ## return the cross reference ## - return "<A HREF=\"../$manual(name-$lref).htm\">$ref</A>"; + 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; + 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; + global manual ## ## we identify cross references by: ## ``quotation'' @@ -778,44 +789,44 @@ proc insert-cross-references {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] \ - ]; + 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); + set invert($offset($name)) $name + lappend offsets $offset($name) } } ## ## if nothing, then we're done. ## if { ! [info exists offsets]} { - return $text; + return $text } ## ## sort the offsets ## - set offsets [lsort -integer $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]; + 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 { @@ -825,18 +836,18 @@ proc insert-cross-references {text} { 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]; + 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]; + set tail [string range $text [expr $offset(end-quote)+2] end] + return $head[insert-cross-references $tail] } } - return [reference-error {Uncaught quote case} $text]; + return [reference-error {Uncaught quote case} $text] } bold { if {$offset(end-bold) < 0} { return $text; } @@ -845,42 +856,42 @@ proc insert-cross-references {text} { 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]; + 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]; + set tail [string range $text [expr $offset(end-bold)+4] end] + return $head[insert-cross-references $tail] } } - return [reference-error {Uncaught bold case} $text]; + 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]; + 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]; + 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]; + 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]; + 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 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]; + 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]; + return [reference-error "Out of place $invert([lindex $offsets 0])" $text] } } } @@ -888,22 +899,22 @@ proc insert-cross-references {text} { ## process formatting directives ## proc output-directive {line} { - global manual; + global manual # process format directive split-directive $line code rest switch -exact $code { .BS - .BE { - # man-puts <HR>; + # man-puts <HR> } .SH { # drain any open lists # announce the subject - set manual(section) $rest; + 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>"; + 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) { @@ -911,194 +922,194 @@ proc output-directive {line} { 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; + return } set manual($manual(tail)-NAME) 1 } set names {} while {1} { - set line [next-text]; + set line [next-text] if {[is-a-directive $line]} { - backup-text 1; + backup-text 1 output-name [join $names { }] - return; + return } else { lappend names [string trim $line] } } } SYNOPSIS { - lappend manual(section-toc) <DL>; + lappend manual(section-toc) <DL> while {1} { if {[next-op-is .nf rest] || [next-op-is .br rest] || [next-op-is .fi rest]} { - continue; + continue } if {[next-op-is .SH rest] || [next-op-is .BE rest] || [next-op-is .SO rest]} { - backup-text 1; - break; + backup-text 1 + break } if {[next-op-is .sp rest]} { - #man-puts <P>; - continue; + #man-puts <P> + continue } - set more [next-text]; + set more [next-text] if {[is-a-directive $more]} { - manerror "in SYNOPSIS found $more"; - backup-text 1; - break; + manerror "in SYNOPSIS found $more" + backup-text 1 + break } else { foreach more [split $more \n] { - man-puts $more<BR>; + man-puts $more<BR> if {[lsearch {TclLib TkLib} $manual(wing-file)] < 0} { - lappend manual(section-toc) <DD>$more; + lappend manual(section-toc) <DD>$more } } } } - lappend manual(section-toc) </DL>; - return; + lappend manual(section-toc) </DL> + return } {SEE ALSO} { while {[more-text]} { if {[next-op-is .SH rest]} { - backup-text 1; - return; + backup-text 1 + return } - set more [next-text]; + set more [next-text] if {[is-a-directive $more]} { - manerror "$more"; - backup-text 1; - return; + manerror "$more" + backup-text 1 + return } - set nmore {}; + set nmore {} foreach cr [split $more ,] { - set cr [string trim $cr]; + set cr [string trim $cr] if { ! [regexp {^<B>.*</B>$} $cr]} { - set cr <B>$cr</B>; + set cr <B>$cr</B> } if {[regexp {^<B>(.*)\([13n]\)</B>$} $cr all name]} { set cr <B>$name</B> } - lappend nmore $cr; + lappend nmore $cr } - man-puts [join $nmore {, }]; + man-puts [join $nmore {, }] } - return; + return } KEYWORDS { while {[more-text]} { if {[next-op-is .SH rest]} { - backup-text 1; - return; + backup-text 1 + return } - set more [next-text]; + set more [next-text] if {[is-a-directive $more]} { - manerror "$more"; - backup-text 1; - return; + 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]; + 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; + return } } if {[next-op-is .IP rest]} { - output-IP-list .SH .IP $rest; - return; + output-IP-list .SH .IP $rest + return } if {[next-op-is .PP rest]} { - return; + return } - return; + return } .SO { if {[match-text @stuff .SE]} { - output-directive {.SH STANDARD OPTIONS}; - set opts {}; + output-directive {.SH STANDARD OPTIONS} + set opts {} foreach line [split $stuff \n] { foreach option [split $line \t] { - lappend opts $option; + lappend opts $option } } - man-puts <DL>; - lappend manual(section-toc) <DL>; + man-puts <DL> + lappend manual(section-toc) <DL> foreach option [lsort $opts] { - man-puts "<DT><B>[std-option-toc $option]</B>"; + man-puts "<DT><B>[std-option-toc $option]</B>" } - man-puts </DL>; - lappend manual(section-toc) </DL>; + man-puts </DL> + lappend manual(section-toc) </DL> } else { - manerror "unexpected .SO format:\n[expand-next-text 2]"; + manerror "unexpected .SO format:\n[expand-next-text 2]" } } .OP { - output-widget-options $rest; - return; + output-widget-options $rest + return } .IP { - output-IP-list .IP .IP $rest; - return; + output-IP-list .IP .IP $rest + return } .PP { - man-puts <P>; + man-puts <P> } .RS { - output-RS-list; - return; + output-RS-list + return } .RE { - manerror "unexpected .RE"; - return; + manerror "unexpected .RE" + return } .br { - man-puts <BR>; - return; + man-puts <BR> + return } .DE { - manerror "unexpected .DE"; - return; + manerror "unexpected .DE" + return } .DS { if {[next-op-is .ta rest]} { - ; + } if {[match-text @stuff .DE]} { - man-puts <PRE>$stuff</PRE>; + 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>"; + man-puts "<PRE>[lindex $ul1 1][lindex $ul2 1]\n$stuff</PRE>" } else { - manerror "unexpected .DS format:\n[expand-next-text 2]"; + manerror "unexpected .DS format:\n[expand-next-text 2]" } - return; + return } .CS { if {[next-op-is .ta rest]} { - ; + } if {[match-text @stuff .CE]} { - man-puts <PRE>$stuff</PRE>; + man-puts <PRE>$stuff</PRE> } else { - manerror "unexpected .CS format:\n[expand-next-text 2]"; + manerror "unexpected .CS format:\n[expand-next-text 2]" } - return; + return } .CE { - manerror "unexpected .CE"; - return; + manerror "unexpected .CE" + return } .sp { - man-puts <P>; + man-puts <P> } .ta { # these are tab stop settings for short tables @@ -1115,76 +1126,76 @@ proc output-directive {line} { return; # fix.me } default { - manerror "ignoring $line"; + manerror "ignoring $line" } } } .nf { if {[match-text @more .fi]} { foreach more [split $more \n] { - man-puts $more<BR>; + man-puts $more<BR> } } elseif {[match-text .RS @more .RE .fi]} { - man-puts <DL><DD>; + man-puts <DL><DD> foreach more [split $more \n] { - man-puts $more<BR>; + man-puts $more<BR> } - man-puts </DL>; + man-puts </DL> } elseif {[match-text .RS @more .RS @more2 .RE .RE .fi]} { - man-puts <DL><DD>; + man-puts <DL><DD> foreach more [split $more \n] { - man-puts $more<BR>; + man-puts $more<BR> } - man-puts <DL><DD>; + man-puts <DL><DD> foreach more2 [split $more2 \n] { - man-puts $more2<BR>; + man-puts $more2<BR> } - man-puts </DL></DL>; + man-puts </DL></DL> } elseif {[match-text .RS @more .RS @more2 .RE @more3 .RE .fi]} { - man-puts <DL><DD>; + man-puts <DL><DD> foreach more [split $more \n] { - man-puts $more<BR>; + man-puts $more<BR> } - man-puts <DL><DD>; + man-puts <DL><DD> foreach more2 [split $more2 \n] { - man-puts $more2<BR>; + man-puts $more2<BR> } - man-puts </DL><DD>; + man-puts </DL><DD> foreach more3 [split $more3 \n] { - man-puts $more3<BR>; + man-puts $more3<BR> } - man-puts </DL>; + man-puts </DL> } elseif {[match-text .sp .RS @more .RS @more2 .sp .RE .RE .fi]} { - man-puts <P><DL><DD>; + man-puts <P><DL><DD> foreach more [split $more \n] { - man-puts $more<BR>; + man-puts $more<BR> } - man-puts <DL><DD>; + man-puts <DL><DD> foreach more2 [split $more2 \n] { - man-puts $more2<BR>; + man-puts $more2<BR> } - man-puts </DL></DL><P>; + man-puts </DL></DL><P> } elseif {[match-text .RS .sp @more .sp .RE .fi]} { - man-puts <P><DL><DD>; + man-puts <P><DL><DD> foreach more [split $more \n] { - man-puts $more<BR>; + man-puts $more<BR> } - man-puts </DL><P>; + man-puts </DL><P> } else { - manerror "ignoring $line"; + manerror "ignoring $line" } } .fi { - manerror "ignoring $line"; + manerror "ignoring $line" } .na - .ad - .UL - .ne { - manerror "ignoring $line"; + manerror "ignoring $line" } default { - manerror "unrecognized format directive: $line"; + manerror "unrecognized format directive: $line" } } } @@ -1194,38 +1205,38 @@ proc output-directive {line} { 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; + 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; + lappend dates($who) $date } - continue; + 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; + lappend dates($who) $date1 $date2 + continue } - puts "oops: $copyright"; + puts "oops: $copyright" } foreach who [array names dates] { - set list [lsort $dates($who)]; + set list [lsort $dates($who)] if {[llength $list] == 1 || [lindex $list 0] == [lrange $list end end]} { - lappend merge "Copyright (c) [lindex $list 0] $who"; + lappend merge "Copyright (c) [lindex $list 0] $who" } else { - lappend merge "Copyright (c) [lindex $list 0]-[lrange $list end end] $who"; + lappend merge "Copyright (c) [lindex $list 0]-[lrange $list end end] $who" } } - return [lsort $merge]; + return [lsort $merge] } proc makedirhier {dir} { if { ! [file isdirectory $dir]} { - makedirhier [file dirname $dir]; + makedirhier [file dirname $dir] if { ! [file isdirectory $dir]} { if {[catch {exec mkdir $dir} error]} { - error "cannot create directory $dir: $error"; + error "cannot create directory $dir: $error" } } } @@ -1237,80 +1248,80 @@ proc makedirhier {dir} { ## specified by html. ## proc make-man-pages {html args} { - global env manual overall_title; - makedirhier $html; + global env manual overall_title + makedirhier $html if { ! [file isdirectory $html]} { - exec mkdir $html; + exec mkdir $html } - set manual(short-toc-n) 1; - set manual(short-toc-fp) [open $html/contents.htm w]; + 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>"; + 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]; + 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)"; + 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)/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>"; + 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) {}; + set manual(wing-toc) {} # initialize the man directory for this section - makedirhier $html/$manual(wing-file); + makedirhier $html/$manual(wing-file) # initialize the long table of contents for this section - set manual(long-toc-n) 1; + set manual(long-toc-n) 1 # get the manual pages for this section - set manual(pages) [lsort [glob $manual(wing-glob)]]; + 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 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]; + # 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) {}; + 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; + manerror "discarding $manual(name)" + continue } - set manual(infp) [open "$manual(page)"]; - set manual(text) {}; - set manual(partial-text) {}; + 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($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)"; + 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; + manreport 100 $line if {[regexp {^[`'][/\\]} $line]} { if {[regexp {Copyright \(c\).*$} $line copyright]} { - lappend manual(copyrights) $copyright; + lappend manual(copyrights) $copyright } # comment - continue; + continue } if {"$line" == {'}} { # comment - continue; + continue } if {[parse-directive $line code rest]} { switch -exact $code { @@ -1323,27 +1334,27 @@ proc make-man-pages {html args} { .VS - . { # ignore - continue; + continue } } if {"$manual(partial-text)" != {}} { - lappend manual(text) [process-text $manual(partial-text)]; - set 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; + gets $manual(infp) rest } - lappend manual(text) ".SH [unquote $rest]"; + lappend manual(text) ".SH [unquote $rest]" } .TH { - lappend manual(text) "$code [unquote $rest]"; + lappend manual(text) "$code [unquote $rest]" } .HS - .UL - .ta { - lappend manual(text) "$code [unquote $rest]"; + lappend manual(text) "$code [unquote $rest]" } .BS - .BE - @@ -1352,203 +1363,203 @@ proc make-man-pages {html args} { .sp - .nf { if {"$rest" != {}} { - manerror "unexpected argument: $line"; + manerror "unexpected argument: $line" } - lappend manual(text) $code; + lappend manual(text) $code } .AP { - lappend manual(text) [concat .IP [process-text "[lindex $rest 0] \\fB[lindex $rest 1]\\fR ([lindex $rest 2])"]]; + 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]]]"; + lappend manual(text) ".IP [process-text [unquote [string trim $rest]]]" } .TP { - set next [gets $manual(infp)]; + set next [gets $manual(infp)] if {"$next" != {'}} { - lappend manual(text) ".IP [process-text $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"]]; + "\\fB[lindex $rest 0]\\fR \\fB[lindex $rest 1]\\fR \\fB[lindex $rest 2]\\fR"]] } .PP - .LP { - lappend manual(text) {.PP}; + lappend manual(text) {.PP} } .RS { - incr manual(.RS); - lappend manual(text) $code; + incr manual(.RS) + lappend manual(text) $code } .RE { - incr manual(.RS) -1; - lappend manual(text) $code; + incr manual(.RS) -1 + lappend manual(text) $code } .SO { - incr manual(.SO); - lappend manual(text) $code; + incr manual(.SO) + lappend manual(text) $code } .SE { - incr manual(.SO) -1; - lappend manual(text) $code; + incr manual(.SO) -1 + lappend manual(text) $code } .DS { - incr manual(.DS); - lappend manual(text) $code; + incr manual(.DS) + lappend manual(text) $code } .DE { - incr manual(.DS) -1; - lappend manual(text) $code; + incr manual(.DS) -1 + lappend manual(text) $code } .CS { - incr manual(.CS); - lappend manual(text) $code; + incr manual(.CS) + lappend manual(text) $code } .CE { - incr manual(.CS) -1; - lappend manual(text) $code; + incr manual(.CS) -1 + lappend manual(text) $code } .de { while {[gets $manual(infp) line] >= 0} { if {[regexp {^\.\.} $line]} { - break; + break } } } .. { - error "found .. outside of .de"; + error "found .. outside of .de" } default { - manerror "unrecognized format directive: $line"; + manerror "unrecognized format directive: $line" } } } else { if {"$manual(partial-text)" == {}} { - set manual(partial-text) $line; + set manual(partial-text) $line } else { - append manual(partial-text) \n$line; + append manual(partial-text) \n$line } } } if {"$manual(partial-text)" != {}} { - lappend manual(text) [process-text $manual(partial-text)]; + lappend manual(text) [process-text $manual(partial-text)] } - close $manual(infp); + 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"; + puts "unbalanced .DS .DE" } if {$manual(.CS) != 0} { - puts "unbalanced .CS .CE"; + puts "unbalanced .CS .CE" } if {$manual(.SO) != 0} { - puts "unbalanced .SO .SE"; + puts "unbalanced .SO .SE" } # output conversion - open-text; + open-text if {[next-op-is .HS rest]} { - set manual($manual(name)-title) "[lrange $rest 1 end] [lindex $rest 0] manual page"; + set manual($manual(name)-title) "[lrange $rest 1 end] [lindex $rest 0] manual page" while {[more-text]} { - set line [next-text]; + set line [next-text] if {[is-a-directive $line]} { - output-directive $line; + output-directive $line } else { - man-puts $line; + man-puts $line } } - man-puts <HR><PRE>; + 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> © [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)]; + 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) "[lrange $rest 4 end] - [lindex $rest 0] manual page" while {[more-text]} { - set line [next-text]; + set line [next-text] if {[is-a-directive $line]} { - output-directive $line; + output-directive $line } else { - man-puts $line; + man-puts $line } } - man-puts <HR><PRE>; + 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> © [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)]; + 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"; + 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><HR>] } # # make the wing table of contents for the section # - set width 0; + set width 0 foreach name $manual(wing-toc) { if {[string length $name] > $width} { - set width [string length $name]; + set width [string length $name] } } - set perline [expr 120 / $width]; + set perline [expr 120 / $width] set nrows [expr ([llength $manual(wing-toc)]+$perline)/$perline] - set n 0; + set n 0 catch {unset rows} foreach name [lsort $manual(wing-toc)] { - set tail $manual(name-$name); + 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]]; + manerror "$name is defined in more than one file: $tail" + set tail [lindex $tail [expr [llength $tail]-1]] } - set tail [file tail $tail]; + set tail [file tail $tail] append rows([expr $n%$nrows]) "<td> <a href=\"$tail.htm\">$name</a>" - incr n; + incr n } - puts $manual(wing-toc-fp) <table>; + 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>; + 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> © [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)]; + 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-*]]; + proc strcasecmp {a b} { return [string compare -nocase $a $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 $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]; + 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} { @@ -1561,19 +1572,19 @@ proc make-man-pages {html args} { puts $afp "<DT><A NAME=\"$k\">$k</A><DD>" set refs {} foreach man $manual(keyword-$k) { - set name [lindex $man 0]; + set name [lindex $man 0] set file [lindex $man 1] - lappend refs "<A HREF=\"../$file\">$name</A>"; + lappend refs "<A HREF=\"../$file\">$name</A>" } - puts $afp [join $refs {, }]; + 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> © [lrange $copyright 2 end]" } - puts $afp "<A HREF=\"copyright.htm\">Copyright</A> © 1995-1997 Roger E. Critchlow Jr."; + puts $afp "<A HREF=\"copyright.htm\">Copyright</A> © 1995-1997 Roger E. Critchlow Jr." puts $afp "</PRE></BODY></HTML>" close $afp } @@ -1581,63 +1592,64 @@ proc make-man-pages {html args} { # 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> © [lrange $copyright 2 end]" } - puts $keyfp "<A HREF=\"copyright.htm\">Copyright</A> © 1995-1997 Roger E. Critchlow Jr."; + puts $keyfp "<A HREF=\"copyright.htm\">Copyright</A> © 1995-1997 Roger E. Critchlow Jr." puts $keyfp </PRE><HR></BODY></HTML> - close $keyfp; + 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) "</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> © [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); + 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); + 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; + 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; + incr ntext [llength [split $item \n]] + incr ntext } - set toc $manual(toc-$manual(wing-file)-$manual(name)); - set ntoc 0; + set toc $manual(toc-$manual(wing-file)-$manual(name)) + set ntoc 0 foreach item $toc { - incr ntoc [llength [split $item \n]]; - incr ntoc; + 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 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} { + 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} { foreach item $toc { - puts $manual(outfp) $item; + puts $manual(outfp) $item } } foreach item $text { - puts $manual(outfp) [insert-cross-references $item]; + puts $manual(outfp) [insert-cross-references $item] } - puts $manual(outfp) </BODY></HTML>; - close $manual(outfp); + puts $manual(outfp) </BODY></HTML> + close $manual(outfp) } - return {}; + return {} } set usercmddesc {The interpreters which implement Tcl and Tk.} @@ -1657,7 +1669,7 @@ if {1} { "$tcltkdir/$tcldir/doc/*.3 {Tcl Library} TclLib {$tcllibdesc}" \ "$tcltkdir/$tkdir/doc/*.3 {Tk Library} TkLib {$tklibdesc}" } error]} { - puts $error\n$errorInfo; + puts $error\n$errorInfo } } |