summaryrefslogtreecommitdiffstats
path: root/tools
diff options
context:
space:
mode:
authorhobbs <hobbs>1999-12-21 23:59:28 (GMT)
committerhobbs <hobbs>1999-12-21 23:59:28 (GMT)
commit671c6e58fccb3a31aaaa79897e8c664ffb21fe82 (patch)
tree90375e3be8b6d06160b927c509f469b4b085fc89 /tools
parent569c90e5035bd0fbfc62dfd81479cea91d46fa61 (diff)
downloadtcl-671c6e58fccb3a31aaaa79897e8c664ffb21fe82.zip
tcl-671c6e58fccb3a31aaaa79897e8c664ffb21fe82.tar.gz
tcl-671c6e58fccb3a31aaaa79897e8c664ffb21fe82.tar.bz2
renamed tcl8.1-tk8.1-man-html.tcl tcltk-man2html.tcl, and rewrote
the internals to use 8.2+ string functions tcl.wse.in moved to 8.3b1
Diffstat (limited to 'tools')
-rw-r--r--tools/man2help.tcl12
-rw-r--r--tools/man2help2.tcl79
-rw-r--r--tools/tcl.wse.in2
-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 {\&amp;} text;
- regsub -all {\\\\} $text {\&#92;} text; # reverse solidus, ie backslash
- regsub -all {\\ } $text {\&nbsp;} text; # non breaking space
- regsub -all {\\%} $text {} text; # don't break word following?
- regsub -all "\\\\\n" $text "\n" text; #
- regsub -all \" $text {\&quot;} text;
- regsub -all {<} $text {\&lt;} text;
- regsub -all {>} $text {\&gt;} text;
+ set text [string map [list \
+ {\&} "\t" \
+ {&} {&amp;} \
+ {\\} {&#92;} \
+ {\e} {&#92;} \
+ {\ } {&nbsp;} \
+ {\|} {&nbsp;} \
+ {\0} { } \
+ {\%} {} \
+ "\\\n" "\n" \
+ \" {&quot;} \
+ {<} {&lt;} \
+ {>} {&gt;} \
+ {\(+-} {&#177;} \
+ {\fP} {\fR} \
+ {\.} . \
+ ] $text]
regsub -all {\\o'o\^'} $text {\&ocirc;} 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 {\&nbsp;} text; # a very thin space
- regsub -all {\\e} $text {\&#92;} text; # reverse solidus, ie backslash
- regsub -all {\\\(\+-} $text {\&#177;} 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> &#169; [lrange $copyright 2 end]";
+ man-puts "<A HREF=\"../copyright.htm\">Copyright</A> &#169; [lrange $copyright 2 end]"
}
- man-puts "<A HREF=\"../copyright.htm\">Copyright</A> &#169; 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> &#169; 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> &#169; [lrange $copyright 2 end]";
+ man-puts "<A HREF=\"../copyright.htm\">Copyright</A> &#169; [lrange $copyright 2 end]"
}
- man-puts "<A HREF=\"../copyright.htm\">Copyright</A> &#169; 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> &#169; 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> &#169; [lrange $copyright 2 end]";
+ puts $manual(wing-toc-fp) "<A HREF=\"../copyright.htm\">Copyright</A> &#169; [lrange $copyright 2 end]"
}
- puts $manual(wing-toc-fp) "<A HREF=\"../copyright.htm\">Copyright</A> &#169; 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> &#169; 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> &#169; [lrange $copyright 2 end]";
+ puts $afp "<A HREF=\"copyright.htm\">Copyright</A> &#169; [lrange $copyright 2 end]"
}
- puts $afp "<A HREF=\"copyright.htm\">Copyright</A> &#169; 1995-1997 Roger E. Critchlow Jr.";
+ puts $afp "<A HREF=\"copyright.htm\">Copyright</A> &#169; 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> &#169; [lrange $copyright 2 end]";
+ puts $keyfp "<A HREF=\"copyright.htm\">Copyright</A> &#169; [lrange $copyright 2 end]"
}
- puts $keyfp "<A HREF=\"copyright.htm\">Copyright</A> &#169; 1995-1997 Roger E. Critchlow Jr.";
+ puts $keyfp "<A HREF=\"copyright.htm\">Copyright</A> &#169; 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> &#169; [lrange $copyright 2 end]";
+ puts $manual(short-toc-fp) "<A HREF=\"copyright.htm\">Copyright</A> &#169; [lrange $copyright 2 end]"
}
- puts $manual(short-toc-fp) "<A HREF=\"copyright.htm\">Copyright</A> &#169; 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> &#169; 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
}
}