summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--library/tcltest/tcltest.tcl4
-rw-r--r--tools/checkLibraryDoc.tcl31
-rw-r--r--tools/eolFix.tcl18
-rwxr-xr-xtools/findBadExternals.tcl4
-rw-r--r--tools/genStubs.tcl12
-rw-r--r--tools/index.tcl10
-rwxr-xr-xtools/loadICU.tcl12
-rwxr-xr-xtools/makeTestCases.tcl132
-rw-r--r--tools/man2help.tcl2
-rw-r--r--tools/man2help2.tcl40
-rw-r--r--tools/man2html.tcl8
-rw-r--r--tools/man2html1.tcl18
-rw-r--r--tools/man2html2.tcl22
-rw-r--r--tools/mkdepend.tcl18
-rw-r--r--tools/regexpTestLib.tcl36
-rwxr-xr-xtools/tclZIC.tcl10
-rwxr-xr-xtools/tcltk-man2html.tcl2
-rw-r--r--tools/uniParse.tcl4
18 files changed, 194 insertions, 189 deletions
diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl
index e7f4288..4df25e4 100644
--- a/library/tcltest/tcltest.tcl
+++ b/library/tcltest/tcltest.tcl
@@ -3242,8 +3242,8 @@ proc tcltest::viewFile {name {directory ""}} {
# procedures that are supposed to accept strings with embedded NULL
# bytes.
# 2. Confirm that a string result has a certain pattern of bytes, for
-# instance to confirm that "\xe0\0" in a Tcl script is stored
-# internally in UTF-8 as the sequence of bytes "\xc3\xa0\xc0\x80".
+# instance to confirm that "\xE0\0" in a Tcl script is stored
+# internally in UTF-8 as the sequence of bytes "\xC3\xA0\xC0\x80".
#
# Generally, it's a bad idea to examine the bytes in a Tcl string or to
# construct improperly formed strings in this manner, because it involves
diff --git a/tools/checkLibraryDoc.tcl b/tools/checkLibraryDoc.tcl
index cd08c2a..224106e 100644
--- a/tools/checkLibraryDoc.tcl
+++ b/tools/checkLibraryDoc.tcl
@@ -1,9 +1,9 @@
# checkLibraryDoc.tcl --
#
-# This script attempts to determine what APIs exist in the source base that
-# have not been documented. By grepping through all of the doc/*.3 man
+# This script attempts to determine what APIs exist in the source base that
+# have not been documented. By grepping through all of the doc/*.3 man
# pages, looking for "Pkg_*" (e.g., Tcl_ or Tk_), and comparing this list
-# against the list of Pkg_ APIs found in the source (e.g., tcl8.2/*/*.[ch])
+# against the list of Pkg_ APIs found in the source (e.g., tcl8.5/*/*.[ch])
# we create six lists:
# 1) APIs in Source not in Docs.
# 2) APIs in Docs not in Source.
@@ -11,10 +11,10 @@
# 4) Misc APIs and structs that we are not documenting.
# 5) Command APIs (e.g., Tcl_ArrayObjCmd.)
# 6) Proc pointers (e.g., Tcl_CloseProc.)
-#
+#
# Note: Each list is "a best guess" approximation. If developers write
# non-standard code, this script will produce erroneous results. Each
-# list should be carefully checked for accuracy.
+# list should be carefully checked for accuracy.
#
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
@@ -86,7 +86,7 @@ set StructList {
Tk_Window \
}
-# Misc junk that appears in the comments of the source. This just
+# Misc junk that appears in the comments of the source. This just
# allows us to filter comments that "fool" the script.
set CommentList {
@@ -99,14 +99,13 @@ set CommentList {
# Main entry point to this script.
proc main {} {
- global argv0
- global argv
+ global argv0
+ global argv
set len [llength $argv]
if {($len != 2) && ($len != 3)} {
puts "usage: $argv0 pkgName pkgDir \[outFile\]"
puts " pkgName == Tcl,Tk"
- puts " pkgDir == /home/surles/cvs/tcl8.2"
exit 1
}
@@ -121,12 +120,12 @@ proc main {} {
foreach {c d} [compare [grepCode $dir $pkg] [grepDocs $dir $pkg]] {}
filter $c $d $dir $pkg $file
- if {$file != "stdout"} {
+ if {$file ne "stdout"} {
close $file
}
return
}
-
+
# Intersect the two list and write out the sets of APIs in one
# list that is not in the other.
@@ -145,7 +144,7 @@ proc filter {code docs dir pkg {outFile stdout}} {
# This list should just be verified for accuracy.
set cmds {}
-
+
# A list of proc pointer structs. These are not documented.
# This list should just be verified for accuracy.
@@ -162,7 +161,7 @@ proc filter {code docs dir pkg {outFile stdout}} {
set misc [grepMisc $dir $pkg]
set pat1 ".*(${pkg}_\[A-z0-9]+).*$"
-
+
# A list of APIs in the source, not in the docs.
# This list should just be verified for accuracy.
@@ -196,7 +195,7 @@ proc filter {code docs dir pkg {outFile stdout}} {
# Print the list of APIs if the list is not null.
proc dump {list title file} {
- if {$list != {}} {
+ if {$list ne ""} {
puts $file ""
puts $file $title
puts $file "---------------------------------------------------------"
@@ -240,7 +239,7 @@ proc grepDocs {dir pkg} {
# (e.g., Tcl_Export). Return a list of APIs.
proc grepDecl {dir pkg} {
- set file [file join $dir generic "[string tolower $pkg]IntDecls.h"]
+ set file [file join $dir generic "[string tolower $pkg]IntDecls.h"]
set apis [myGrep "^EXTERN.*\[ \t\]${pkg}_.*" $file]
set pat1 ".*(${pkg}_\[A-z0-9]+).*$"
@@ -258,7 +257,7 @@ proc grepDecl {dir pkg} {
proc grepMisc {dir pkg} {
global CommentList
global StructList
-
+
set apis [myGrep "^EXTERN.*\[ \t\]${pkg}_Db.*" "${dir}/\*/\*\.\[ch\]"]
set pat1 ".*(${pkg}_\[A-z0-9]+).*$"
diff --git a/tools/eolFix.tcl b/tools/eolFix.tcl
index ed3ec7c..3f35ed4 100644
--- a/tools/eolFix.tcl
+++ b/tools/eolFix.tcl
@@ -13,16 +13,18 @@ namespace eval ::EOL {
variable outMode crlf
}
-proc EOL::fix {filename {newfilename ""}} {
+proc EOL::fix {filename {newfilename {}}} {
variable outMode
- if {![file exists $filename]} { return }
+ if {![file exists $filename]} {
+ return
+ }
puts "EOL Fixing: $filename"
file rename ${filename} ${filename}.o
set fhnd [open ${filename}.o r]
- if {$newfilename != ""} {
+ if {$newfilename ne ""} {
set newfhnd [open ${newfilename} w]
} else {
set newfhnd [open ${filename} w]
@@ -63,12 +65,12 @@ proc EOL::fixall {args} {
}
if {$tcl_interactive == 0 && $argc > 0} {
- if {[string index [lindex $argv 0] 0] == "-"} {
+ if {[string index [lindex $argv 0] 0] eq "-"} {
switch -- [lindex $argv 0] {
- -cr { set ::EOL::outMode cr }
- -crlf { set ::EOL::outMode crlf }
- -lf { set ::EOL::outMode lf }
- default { puts stderr "improper mode switch" ; exit 1 }
+ -cr {set ::EOL::outMode cr}
+ -crlf {set ::EOL::outMode crlf}
+ -lf {set ::EOL::outMode lf}
+ default {puts stderr "improper mode switch"; exit 1}
}
set argv [lrange $argv 1 end]
}
diff --git a/tools/findBadExternals.tcl b/tools/findBadExternals.tcl
index 7592f17..2228357 100755
--- a/tools/findBadExternals.tcl
+++ b/tools/findBadExternals.tcl
@@ -1,5 +1,5 @@
# findBadExternals.tcl --
-#
+#
# This script scans the Tcl load library for exported symbols
# that do not begin with 'Tcl' or 'tcl'. It reports them on the
# standard output. It is used to make sure that the library does
@@ -29,7 +29,7 @@ proc main {argc argv} {
macosx {
set status [catch {
exec nm --extern-only --defined-only [lindex $argv 0]
- } result]
+ } result]
}
windows {
set status [catch {
diff --git a/tools/genStubs.tcl b/tools/genStubs.tcl
index 2eb6638..67b5112 100644
--- a/tools/genStubs.tcl
+++ b/tools/genStubs.tcl
@@ -382,7 +382,7 @@ proc genStubs::parseDecl {decl} {
return
}
set rtype [string trim $rtype]
- if {$args == ""} {
+ if {$args eq ""} {
return [list $rtype $fname {}]
}
foreach arg [split $args ,] {
@@ -430,14 +430,14 @@ proc genStubs::parseDecl {decl} {
proc genStubs::parseArg {arg} {
if {![regexp {^(.+[ ][*]*)([^][ *]+)(\[\])?$} $arg all type name array]} {
- if {$arg == "void"} {
+ if {$arg eq "void"} {
return $arg
} else {
return
}
}
set result [list [string trim $type] $name]
- if {$array != ""} {
+ if {$array ne ""} {
lappend result $array
}
return $result
@@ -460,7 +460,7 @@ proc genStubs::makeDecl {name decl index} {
lassign $decl rtype fname args
append text "/* $index */\n"
- if {$rtype != "void"} {
+ if {$rtype ne "void"} {
regsub -all void $rtype VOID rtype
}
set line "$scspec $rtype"
@@ -640,7 +640,7 @@ proc genStubs::makeSlot {name decl index} {
# Returns the formatted declaration string.
proc genStubs::makeInit {name decl index} {
- if {[lindex $decl 2] == ""} {
+ if {[lindex $decl 2] eq ""} {
append text " &" [lindex $decl 1] ", /* " $index " */\n"
} else {
append text " " [lindex $decl 1] ", /* " $index " */\n"
@@ -982,7 +982,7 @@ proc genStubs::emitHeader {name} {
set capName [string toupper [string index $name 0]]
append capName [string range $name 1 end]
- if {$epoch != ""} {
+ if {$epoch ne ""} {
set CAPName [string toupper $name]
append text "\n"
append text "#define ${CAPName}_STUBS_EPOCH $epoch\n"
diff --git a/tools/index.tcl b/tools/index.tcl
index 7b11e3f..71329c2 100644
--- a/tools/index.tcl
+++ b/tools/index.tcl
@@ -12,7 +12,7 @@
# Global variables used by these scripts:
#
# state - state variable that controls action of text proc.
-#
+#
# topics - array indexed by (package,section,topic) with value
# of topic ID.
#
@@ -135,7 +135,7 @@ proc macro {name args} {
switch $args {
NAME {
- if {$state == "INIT" } {
+ if {$state eq "INIT" } {
set state NAME
}
}
@@ -144,7 +144,7 @@ proc macro {name args} {
KEYWORDS {set state KEY}
default {set state OFF}
}
-
+
}
TH {
global state curID curPkg curSect topics keywords
@@ -176,7 +176,7 @@ proc macro {name args} {
proc dash {} {
global state
- if {$state == "NAME"} {
+ if {$state eq "NAME"} {
set state DASH
}
}
@@ -185,7 +185,7 @@ proc dash {} {
# initGlobals, tab, font, char, macro2 --
#
-# These procedures do nothing during the first pass.
+# These procedures do nothing during the first pass.
#
# Arguments:
# None.
diff --git a/tools/loadICU.tcl b/tools/loadICU.tcl
index 1cdd12f..506b6e4 100755
--- a/tools/loadICU.tcl
+++ b/tools/loadICU.tcl
@@ -432,7 +432,7 @@ proc handleLocaleFile { localeName fileName msgFileName } {
if { ![info exists format($localeName,TIME_FORMAT)] } {
for { set i 3 } { $i >= 0 } { incr i -1 } {
- if { [regexp H [lindex $items(DateTimePatterns) $i]]
+ if { [regexp H [lindex $items(DateTimePatterns) $i]]
&& [regexp s [lindex $items(DateTimePatterns) $i]] } {
break
}
@@ -464,7 +464,7 @@ proc handleLocaleFile { localeName fileName msgFileName } {
if { ![info exists format($localeName,TIME_FORMAT_12)] } {
for { set i 3 } { $i >= 0 } { incr i -1 } {
- if { [regexp h [lindex $items(DateTimePatterns) $i]]
+ if { [regexp h [lindex $items(DateTimePatterns) $i]]
&& [regexp s [lindex $items(DateTimePatterns) $i]] } {
break
}
@@ -489,7 +489,7 @@ proc handleLocaleFile { localeName fileName msgFileName } {
# Date and time... Prefer 24-hour format to 12-hour format.
- if { ![info exists format($localeName,DATE_TIME_FORMAT)]
+ if { ![info exists format($localeName,DATE_TIME_FORMAT)]
&& [info exists format($localeName,DATE_FORMAT)]
&& [info exists format($localeName,TIME_FORMAT)]} {
set format($localeName,DATE_TIME_FORMAT) \
@@ -497,7 +497,7 @@ proc handleLocaleFile { localeName fileName msgFileName } {
append format($localeName,DATE_TIME_FORMAT) \
" " $format($localeName,TIME_FORMAT) " %z"
}
- if { ![info exists format($localeName,DATE_TIME_FORMAT)]
+ if { ![info exists format($localeName,DATE_TIME_FORMAT)]
&& [info exists format($localeName,DATE_FORMAT)]
&& [info exists format($localeName,TIME_FORMAT_12)]} {
set format($localeName,DATE_TIME_FORMAT) \
@@ -517,7 +517,7 @@ proc handleLocaleFile { localeName fileName msgFileName } {
# Write the string sets to the file.
- foreach key {
+ foreach key {
LOCALE_NUMERALS LOCALE_DATE_FORMAT LOCALE_TIME_FORMAT
LOCALE_DATE_TIME_FORMAT LOCALE_ERAS LOCALE_YEAR_FORMAT
} {
@@ -588,7 +588,7 @@ proc backslashify { string } {
set retval {}
foreach char [split $string {}] {
scan $char %c ccode
- if { $ccode >= 0x0020 && $ccode < 0x007F && $char ne "\""
+ if { $ccode >= 0x20 && $ccode < 0x7F && $char ne "\""
&& $char ne "\{" && $char ne "\}" && $char ne "\["
&& $char ne "\]" && $char ne "\\" && $char ne "\$" } {
append retval $char
diff --git a/tools/makeTestCases.tcl b/tools/makeTestCases.tcl
index c230d57..70213e0 100755
--- a/tools/makeTestCases.tcl
+++ b/tools/makeTestCases.tcl
@@ -40,7 +40,7 @@ namespace eval ::tcl::clock {
l li lii liii liv lv lvi lvii lviii lix
lx lxi lxii lxiii lxiv lxv lxvi lxvii lxviii lxix
lxx lxxi lxxii lxxiii lxxiv lxxv lxxvi lxxvii lxxviii lxxix
- lxxx lxxxi lxxxii lxxxiii lxxxiv lxxxv lxxxvi lxxxvii lxxxviii
+ lxxx lxxxi lxxxii lxxxiii lxxxiv lxxxv lxxxvi lxxxvii lxxxviii
lxxxix
xc xci xcii xciii xciv xcv xcvi xcvii xcviii xcix
c
@@ -62,7 +62,7 @@ namespace eval ::tcl::clock {
#
# Parameters:
# startOfYearArray - Name of an array in caller's scope that will
-# be initialized as
+# be initialized as
# Results:
# None
#
@@ -106,7 +106,7 @@ proc listYears { startOfYearArray } {
set s $s2
incr y
}
-
+
# List years before 1970
set y 1970
@@ -138,7 +138,7 @@ proc listYears { startOfYearArray } {
#----------------------------------------------------------------------
#
-# processFile -
+# processFile -
#
# Processes the 'clock.test' file, updating the test cases in it.
#
@@ -153,7 +153,7 @@ proc listYears { startOfYearArray } {
proc processFile {d} {
# Open two files
-
+
set f1 [open [file join $d tests/clock.test] r]
set f2 [open [file join $d tests/clock.new] w]
@@ -164,7 +164,7 @@ proc processFile {d} {
switch -exact -- $state {
{} {
puts $f2 $line
- if { [regexp "^\# BEGIN (.*)" $line -> cases]
+ if { [regexp "^\# BEGIN (.*)" $line -> cases]
&& [string compare {} [info commands $cases]] } {
set state inCaseSet
$cases $f2
@@ -213,7 +213,7 @@ proc testcases2 { f2 } {
listYears startOfYear
# Define the roman numerals
-
+
set roman {
? i ii iii iv v vi vii viii ix
x xi xii xiii xiv xv xvi xvii xviii xix
@@ -235,20 +235,20 @@ proc testcases2 { f2 } {
}
# Names of the months
-
+
set short {{} Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec}
set long {
{} January February March April May June July August September
October November December
}
-
+
# Put out a header describing the tests
-
+
puts $f2 ""
puts $f2 "\# Test formatting of Gregorian year, month, day, all formats"
puts $f2 "\# Formats tested: %b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y %EY"
puts $f2 ""
-
+
# Generate the test cases for the first and last day of every month
# from 1896 to 2045
@@ -262,7 +262,7 @@ proc testcases2 { f2 } {
if { $m == 2 && ( $y%4 == 0 && $y%100 != 0 || $y%400 == 0 ) } {
incr hath
}
-
+
set b [lindex $short $m]
set B [lindex $long $m]
set C [format %02d [expr { $y / 100 }]]
@@ -271,9 +271,9 @@ proc testcases2 { f2 } {
set mm [format %02d $m]
set N [format %2d $m]
set yy [format %02d [expr { $y % 100 }]]
-
+
set J [expr { ( $s / 86400 ) + 2440588 }]
-
+
set dt $y-$mm-01
set result ""
append result $b " " $B " " \
@@ -296,17 +296,17 @@ proc testcases2 { f2 } {
puts $f2 "\t-format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \\"
puts $f2 "\t-gmt true -locale en_US_roman"
puts $f2 "} {$result}"
-
+
set hm1 [expr { $hath - 1 }]
incr s [expr { 86400 * ( $hath - 1 ) }]
incr yd $hm1
-
+
set dd [format %02d $hath]
set ee [format %2d $hath]
set j [format %03d $yd]
-
+
set J [expr { ( $s / 86400 ) + 2440588 }]
-
+
set dt $y-$mm-$dd
set result ""
append result $b " " $B " " \
@@ -332,7 +332,7 @@ proc testcases2 { f2 } {
puts $f2 "\t-format {%b %B %c %Ec %C %EC %d %Od %e %Oe %h %j %J %m %Om %N %x %Ex %y %Oy %Y} \\"
puts $f2 "\t-gmt true -locale en_US_roman"
puts $f2 "} {$result}"
-
+
incr s 86400
incr yd
}
@@ -451,7 +451,7 @@ proc testcases3 { f2 } {
testISO $f2 $ym1 52 1 [expr { $secs - 5*86400 }]
testISO $f2 $ym1 52 6 $secs
testISO $f2 $ym1 52 7 [expr { $secs + 86400 }]
- }
+ }
testISO $f2 $y 1 1 [expr { $secs + 2*86400 }]
testISO $f2 $y 1 6 [expr { $secs + 7*86400 }]
testISO $f2 $y 1 7 [expr { $secs + 8*86400 }]
@@ -466,10 +466,10 @@ proc testcases3 { f2 } {
proc testISO { f2 G V u secs } {
upvar 1 case case
-
+
set longdays {Sunday Monday Tuesday Wednesday Thursday Friday Saturday Sunday}
set shortdays {Sun Mon Tue Wed Thu Fri Sat Sun}
-
+
puts $f2 "test clock-3.[incr case] {ISO week-based calendar [format %04d-W%02d-%d $G $V $u]} {"
puts $f2 " clock format $secs -format {%a %A %g %G %u %U %V %w %W} -gmt true; \# $G-W[format %02d $V]-$u"
puts $f2 "} {[lindex $shortdays $u] [lindex $longdays $u]\
@@ -478,7 +478,7 @@ proc testISO { f2 G V u secs } {
[clock format $secs -format %U -gmt true]\
[format %02d $V] [expr { $u % 7 }]\
[clock format $secs -format %W -gmt true]}"
-
+
}
#----------------------------------------------------------------------
@@ -504,15 +504,15 @@ proc testcases4 { f2 } {
puts $f2 "\# Test formatting of time of day"
puts $f2 "\# Format groups tested: %H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+"
puts $f2 {}
-
+
set i 0
set fmt "%H %OH %I %OI %k %Ok %l %Ol %M %OM %p %P %r %R %S %OS %T %X %EX %+"
- foreach { h romanH I romanI am } {
- 0 ? 12 xii AM
- 1 i 1 i AM
- 11 xi 11 xi AM
- 12 xii 12 xii PM
- 13 xiii 1 i PM
+ foreach { h romanH I romanI am } {
+ 0 ? 12 xii AM
+ 1 i 1 i AM
+ 11 xi 11 xi AM
+ 12 xii 12 xii PM
+ 13 xiii 1 i PM
23 xxiii 11 xi PM
} {
set hh [format %02d $h]
@@ -547,7 +547,7 @@ proc testcases4 { f2 } {
puts "testcases4: $i test cases."
}
-
+
#----------------------------------------------------------------------
#
# testcases5 --
@@ -572,9 +572,9 @@ proc testcases5 { f2 } {
puts $f2 {}
puts $f2 "\# Test formatting of Daylight Saving Time"
puts $f2 {}
-
+
set fmt {%H:%M:%S %z %Z}
-
+
set i 0
puts $f2 "test clock-5.[incr i] {does Detroit exist} {"
puts $f2 " clock format 0 -format {} -timezone :America/Detroit"
@@ -587,7 +587,7 @@ proc testcases5 { f2 } {
puts $f2 " concat {ok}"
puts $f2 " }"
puts $f2 "} ok"
-
+
foreach row $TZData(:America/Detroit) {
foreach { t offset isdst tzname } $row break
if { $t > -4000000000000 } {
@@ -648,12 +648,12 @@ proc testcases5 { f2 } {
proc testcases8 { f2 } {
# Put out a header describing the tests
-
+
puts $f2 ""
puts $f2 "\# Test parsing of ccyymmdd"
puts $f2 ""
-
- set n 0
+
+ set n 0
foreach year {1970 1971 2000 2001} {
foreach month {01 12} {
foreach day {02 31} {
@@ -670,7 +670,7 @@ proc testcases8 { f2 } {
puts $f2 "} $scanned"
}
}
- }
+ }
foreach fmt {%x %D} {
set string [clock format $scanned \
-format $fmt \
@@ -708,11 +708,11 @@ proc testcases8 { f2 } {
proc testcases11 { f2 } {
# Put out a header describing the tests
-
+
puts $f2 ""
puts $f2 "\# Test precedence among yyyymmdd and yyyyddd"
puts $f2 ""
-
+
array set v {
Y 1970
m 01
@@ -771,12 +771,12 @@ proc testcases11 { f2 } {
proc testcases12 { f2 } {
# Put out a header describing the tests
-
+
puts $f2 ""
puts $f2 "\# Test parsing of ccyyWwwd"
puts $f2 ""
-
- set n 0
+
+ set n 0
foreach year {1970 1971 2000 2001} {
foreach month {01 12} {
foreach day {02 31} {
@@ -817,12 +817,12 @@ proc testcases12 { f2 } {
proc testcases14 { f2 } {
# Put out a header describing the tests
-
+
puts $f2 ""
puts $f2 "\# Test parsing of yymmdd"
puts $f2 ""
-
- set n 0
+
+ set n 0
foreach year {1938 1970 2000 2037} {
foreach month {01 12} {
foreach day {02 31} {
@@ -839,7 +839,7 @@ proc testcases14 { f2 } {
puts $f2 "} $scanned"
}
}
- }
+ }
}
}
}
@@ -868,12 +868,12 @@ proc testcases14 { f2 } {
proc testcases17 { f2 } {
# Put out a header describing the tests
-
+
puts $f2 ""
puts $f2 "\# Test parsing of yyWwwd"
puts $f2 ""
-
- set n 0
+
+ set n 0
foreach year {1970 1971 2000 2001} {
foreach month {01 12} {
foreach day {02 31} {
@@ -914,12 +914,12 @@ proc testcases17 { f2 } {
proc testcases19 { f2 } {
# Put out a header describing the tests
-
+
puts $f2 ""
puts $f2 "\# Test parsing of mmdd"
puts $f2 ""
-
- set n 0
+
+ set n 0
foreach year {1938 1970 2000 2037} {
set base [clock scan ${year}0101 -gmt true]
foreach month {01 12} {
@@ -935,7 +935,7 @@ proc testcases19 { f2 } {
puts $f2 " [list clock scan $string -format [list $mm $dd] -locale en_US_roman -base $base -gmt 1]"
puts $f2 "} $scanned"
}
- }
+ }
}
}
}
@@ -964,12 +964,12 @@ proc testcases19 { f2 } {
proc testcases22 { f2 } {
# Put out a header describing the tests
-
+
puts $f2 ""
puts $f2 "\# Test parsing of Wwwd"
puts $f2 ""
-
- set n 0
+
+ set n 0
foreach year {1970 1971 2000 2001} {
set base [clock scan ${year}0104 -gmt true]
foreach month {03 10} {
@@ -1011,12 +1011,12 @@ proc testcases22 { f2 } {
proc testcases24 { f2 } {
# Put out a header describing the tests
-
+
puts $f2 ""
puts $f2 "\# Test parsing of naked day-of-month"
puts $f2 ""
-
- set n 0
+
+ set n 0
foreach year {1970 2000} {
foreach month {01 12} {
set base [clock scan ${year}${month}01 -gmt true]
@@ -1030,7 +1030,7 @@ proc testcases24 { f2 } {
puts $f2 "test clock-24.[incr n] {parse naked day of month} {"
puts $f2 " [list clock scan $string -format $dd -locale en_US_roman -base $base -gmt 1]"
puts $f2 "} $scanned"
- }
+ }
}
}
}
@@ -1059,12 +1059,12 @@ proc testcases24 { f2 } {
proc testcases26 { f2 } {
# Put out a header describing the tests
-
+
puts $f2 ""
puts $f2 "\# Test parsing of naked day of week"
puts $f2 ""
-
- set n 0
+
+ set n 0
foreach year {1970 2001} {
foreach week {01 52} {
set base [clock scan ${year}W${week}4 \
@@ -1108,7 +1108,7 @@ proc testcases26 { f2 } {
proc testcases29 { f2 } {
# Put out a header describing the tests
-
+
puts $f2 ""
puts $f2 "\# Test parsing of time of day"
puts $f2 ""
@@ -1172,7 +1172,7 @@ proc testcases29 { f2 } {
}
}
}
-
+
}
puts "testcases29: $n test cases"
}
diff --git a/tools/man2help.tcl b/tools/man2help.tcl
index 018fa84..ca29226 100644
--- a/tools/man2help.tcl
+++ b/tools/man2help.tcl
@@ -36,7 +36,7 @@ proc generateContents {basename version files} {
set lastTopic {}
foreach topic [getTopics $package $section] {
if {[string compare $lastTopic $topic]} {
- set id $topics($package,$section,$topic)
+ set id $topics($package,$section,$topic)
puts $fd "2 $topic=$id"
set lastTopic $topic
}
diff --git a/tools/man2help2.tcl b/tools/man2help2.tcl
index 75f4249..91c81be 100644
--- a/tools/man2help2.tcl
+++ b/tools/man2help2.tcl
@@ -12,7 +12,7 @@
# Global variables used by these scripts:
#
# state - state variable that controls action of text proc.
-#
+#
# topics - array indexed by (package,section,topic) with value
# of topic ID.
#
@@ -157,7 +157,7 @@ proc text {string} {
"\t" {\tab } \
'' "\\rdblquote " \
`` "\\ldblquote " \
- "\u00b7" "\\bullet " \
+ "\xB7" "\\bullet " \
] $string]
# Check if this is the beginning of an international character string.
@@ -176,12 +176,12 @@ proc text {string} {
}
switch $state(textState) {
- REF {
+ REF {
if {$state(inTP) == 0} {
set string [insertRef $string]
}
}
- SEE {
+ SEE {
global topics curPkg curSect
foreach i [split $string] {
if {![regexp -nocase {^[a-z_0-9]+} [string trim $i] i ]} {
@@ -231,7 +231,7 @@ proc insertRef {string} {
}
}
- if {($ref != {}) && ($ref != $curID)} {
+ if {($ref != "") && ($ref != $curID)} {
set string [link $string $ref]
}
return $string
@@ -273,7 +273,7 @@ proc macro {name args} {
# next page and previous page
}
br {
- lineBreak
+ lineBreak
}
BS {}
BE {}
@@ -388,12 +388,12 @@ proc macro {name args} {
set state(noFill) 1
}
so {
- if {$args != "man.macros"} {
+ if {$args ne "man.macros"} {
puts stderr "Unknown macro: .$name [join $args " "]"
}
}
sp { ;# needs work
- if {$args == ""} {
+ if {$args eq ""} {
set count 1
} else {
set count [lindex $args 0]
@@ -472,14 +472,14 @@ proc font {type} {
P -
R {
endFont
- if {$state(textState) == "REF"} {
+ if {$state(textState) eq "REF"} {
set state(textState) INSERT
}
}
C -
B {
beginFont Code
- if {$state(textState) == "INSERT"} {
+ if {$state(textState) eq "INSERT"} {
set state(textState) REF
}
}
@@ -507,7 +507,7 @@ proc font {type} {
proc formattedText {text} {
global chars
- while {$text != ""} {
+ while {$text ne ""} {
set index [string first \\ $text]
if {$index < 0} {
text $text
@@ -709,11 +709,15 @@ proc char {name} {
textSetup
puts -nonewline $file "\\'a9 "
}
+ {\(mi} {
+ textSetup
+ puts -nonewline $file "-"
+ }
{\(mu} {
textSetup
puts -nonewline $file "\\'d7 "
}
- {\(em} {
+ {\(em} - {\(en} {
textSetup
puts -nonewline $file "-"
}
@@ -760,7 +764,7 @@ proc SHmacro {argList {style section}} {
}
# control what the text proc does with text
-
+
switch $args {
NAME {set state(textState) NAME}
DESCRIPTION {set state(textState) INSERT}
@@ -820,10 +824,10 @@ proc IPmacro {argList} {
set indent 5
}
if {$text == {\(bu}} {
- set text "\u00b7"
+ set text "\xB7"
}
- set tab [expr $indent * 0.1]i
+ set tab [expr {$indent * 0.1}]i
newPara $tab -$tab
set state(sb) 80
setTabs $tab
@@ -885,7 +889,7 @@ proc THmacro {argList} {
set curVer [lindex $argList 2] ;# 7.4
set curPkg [lindex $argList 3] ;# Tcl
set curSect [lindex $argList 4] ;# {Tcl Library Procedures}
-
+
regsub -all {\\ } $curSect { } curSect ;# Clean up for [incr\ Tcl]
puts $file "#{\\footnote $curID}" ;# Context string
@@ -950,7 +954,7 @@ proc newPara {leftIndent {firstIndent 0i}} {
if $state(paragraph) {
puts -nonewline $file "\\line\n"
}
- if {$leftIndent != ""} {
+ if {$leftIndent ne ""} {
set state(leftIndent) [expr {$state(leftMargin) \
+ ($state(offset) * $state(nestingLevel)) \
+ [getTwips $leftIndent]}]
@@ -1020,7 +1024,7 @@ proc incrNestingLevel {} {
proc decrNestingLevel {} {
global state
-
+
if {$state(nestingLevel) == 0} {
puts stderr "Nesting level decremented below 0"
} else {
diff --git a/tools/man2html.tcl b/tools/man2html.tcl
index 444462b..2d03ab6 100644
--- a/tools/man2html.tcl
+++ b/tools/man2html.tcl
@@ -25,8 +25,8 @@ proc sarray {file args} {
if {![array exists array]} {
puts "sarray: \"$a\" isn't an array"
break
- }
-
+ }
+
foreach name [lsort [array names array]] {
regsub -all " " $name "\\ " name1
puts $file "set ${a}($name1) \{$array($name)\}"
@@ -139,12 +139,12 @@ proc main {argv} {
foreach package $packages {
file mkdir $html_dir/$package
-
+
# build hyperlink database arrays: NAME_file and KEY_file
#
puts "\nScanning man pages in $tcl_dir/$package/doc..."
uplevel \#0 [list source $homeDir/man2html1.tcl]
-
+
doDir $tcl_dir/$package/doc
# clean up the NAME_file and KEY_file database arrays
diff --git a/tools/man2html1.tcl b/tools/man2html1.tcl
index a668e1b..64982ff 100644
--- a/tools/man2html1.tcl
+++ b/tools/man2html1.tcl
@@ -8,7 +8,7 @@
# Global variables used by these scripts:
#
# state - state variable that controls action of text proc.
-#
+#
# curFile - tail of current man page.
#
# file - file pointer; for both xref.tcl and contents.html
@@ -21,7 +21,7 @@
#
# lib - contains package name. Used to label section in contents.html
#
-# inDT - in dictionary term.
+# inDT - in dictionary term.
# text --
@@ -30,7 +30,7 @@
# and KEY_file.
#
# DT: might do this: if first word of $dt matches $name and [llength $name==1]
-# and [llength $dt > 1], then add to NAME_file.
+# and [llength $dt > 1], then add to NAME_file.
#
# Arguments:
# string - Text to index.
@@ -84,7 +84,7 @@ proc macro {name args} {
KEYWORDS {set state KEY}
default {set state OFF}
}
-
+
}
TP {
global inDT
@@ -136,7 +136,7 @@ proc newline {} {
# initGlobals, tab, font, char, macro2 --
#
-# These procedures do nothing during the first pass.
+# These procedures do nothing during the first pass.
#
# Arguments:
# None.
@@ -212,9 +212,9 @@ proc doListing {file pattern} {
proc doContents {file packageName} {
global footer
-
+
set file [open $file w]
-
+
puts $file "<HTML><HEAD><TITLE>$packageName Manual</TITLE></HEAD><BODY>"
puts $file "<H3>$packageName</H3>"
doListing $file "*.1"
@@ -235,8 +235,8 @@ proc doContents {file packageName} {
#
# This is the toplevel procedure that searches a man page
# for hypertext links. It builds a data base consisting of
-# two arrays: NAME_file and KEY file. It runs the man2tcl
-# program to turn the man page into a script, then it evals
+# two arrays: NAME_file and KEY file. It runs the man2tcl
+# program to turn the man page into a script, then it evals
# that script.
#
# Arguments:
diff --git a/tools/man2html2.tcl b/tools/man2html2.tcl
index e4ccedf..8483204 100644
--- a/tools/man2html2.tcl
+++ b/tools/man2html2.tcl
@@ -114,9 +114,9 @@ proc text string {
set pos [string first "\t" $string]
if {$pos >= 0} {
- text [string range $string 0 [expr $pos-1]]
+ text [string range $string 0 [expr {$pos-1}]]
tab
- text [string range $string [expr $pos+1] end]
+ text [string range $string [expr {$pos+1}] end]
return
}
if {$inTable} {
@@ -471,27 +471,27 @@ 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]
+ 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]
}
default {
puts stderr "Unknown sequence: \\$c"
- set text [string range $text [expr $index+2] end]
+ set text [string range $text [expr {$index+2}] end]
}
}
}
@@ -527,7 +527,7 @@ proc tab {} {
global inPRE charCnt tabString file
# ? charCnt
if {$inPRE == 1} {
- set pos [expr $charCnt % [string length $tabString] ]
+ set pos [expr {$charCnt % [string length $tabString]}]
set spaces [string first "1" [string range $tabString $pos end] ]
text [format "%*s" [incr spaces] " "]
} else {
diff --git a/tools/mkdepend.tcl b/tools/mkdepend.tcl
index de5fdba..b1ad076 100644
--- a/tools/mkdepend.tcl
+++ b/tools/mkdepend.tcl
@@ -10,20 +10,20 @@
# above copyright notice and the following two paragraphs appear in
# all copies of this software.
#
-# IN NO EVENT SHALL THE AUTHOR BE LIABLE TO ANY PARTY FOR DIRECT, INDIRECT,
-# SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OF
-# THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE AUTHOR HAS BEEN ADVISED
+# IN NO EVENT SHALL THE AUTHOR BE LIABLE TO ANY PARTY FOR DIRECT, INDIRECT,
+# SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OF
+# THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE AUTHOR HAS BEEN ADVISED
# OF THE POSSIBILITY OF SUCH DAMAGE.
#
-# THE AUTHOR SPECIFICALLY DISCLAIMS ANY WARRANTIES, INCLUDING, BUT NOT
-# LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
-# PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS ON AN "AS IS"
+# THE AUTHOR SPECIFICALLY DISCLAIMS ANY WARRANTIES, INCLUDING, BUT NOT
+# LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+# PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS ON AN "AS IS"
# BASIS, AND THE AUTHOR HAS NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT,
# UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
#==============================================================================
#
# Modified heavily by David Gravereaux <davygrvy@pobox.com> about 9/17/2006.
-# Original can be found @
+# Original can be found @
# http://web.archive.org/web/20070616205924/http://www.doc.ic.ac.uk/~np2/software/mkdepend.html
#==============================================================================
@@ -88,7 +88,7 @@ proc readDepends {chan} {
set line ""
array set depends {}
- while {[gets $chan line] != -1} {
+ while {[gets $chan line] >= 0} {
if {[regexp {^#line [0-9]+ \"(.*)\"$} $line dummy fname] != 0} {
set fname [file normalize $fname]
if {![info exists target]} {
@@ -98,7 +98,7 @@ proc readDepends {chan} {
} else {
# don't include ourselves as a dependency of ourself.
if {![string compare $fname $target]} {continue}
- # store in an array so multiple occurances are not counted.
+ # store in an array so multiple occurrences are not counted.
set depends($target|$fname) ""
}
}
diff --git a/tools/regexpTestLib.tcl b/tools/regexpTestLib.tcl
index 86f2a3e..8379159 100644
--- a/tools/regexpTestLib.tcl
+++ b/tools/regexpTestLib.tcl
@@ -17,13 +17,13 @@ proc readInputFile {} {
set len [string length $line]
- if {($len > 0) && ([string index $line [expr $len - 1]] == "\\")} {
+ if {($len > 0) && ([string index $line [expr {$len - 1}]] == "\\")} {
if {[info exists lineArray(c$i)] == 0} {
set lineArray(c$i) 1
} else {
incr lineArray(c$i)
}
- set line [string range $line 0 [expr $len - 2]]
+ set line [string range $line 0 [expr {$len - 2}]]
append lineArray($i) $line
continue
}
@@ -43,7 +43,7 @@ proc readInputFile {} {
#
# strings with embedded @'s are truncated
# unpreceeded @'s are replaced by {}
-#
+#
proc removeAts {ls} {
set len [llength $ls]
set newLs {}
@@ -94,7 +94,7 @@ proc writeOutputFile {numLines fcn} {
global outFileName
global lineArray
- # open output file and write file header info to it.
+ # open output file and write file header info to it.
set fileId [open $outFileName w]
@@ -133,7 +133,7 @@ proc writeOutputFile {numLines fcn} {
puts $fileId $currentLine
incr srcLineNum $lineArray(c$lineNum)
incr lineNum
- continue
+ continue
}
set len [llength $currentLine]
@@ -144,7 +144,7 @@ proc writeOutputFile {numLines fcn} {
puts $fileId "\n"
incr srcLineNum $lineArray(c$lineNum)
incr lineNum
- continue
+ continue
}
if {($len < 3)} {
puts "warning: test is too short --\n\t$currentLine"
@@ -204,26 +204,26 @@ proc convertTestLine {currentLine len lineNum srcLineNum} {
# find the test result
- set numVars [expr $len - 3]
+ set numVars [expr {$len - 3}]
set vars {}
set vals {}
set result 0
set v 0
-
+
if {[regsub {\*} "$flags" "" newFlags] == 1} {
# an error is expected
-
+
if {[string compare $str "EMPTY"] == 0} {
# empty regexp is not an error
# skip this test
-
+
return "\# skipping the empty-re test from line $srcLineNum\n"
}
set flags $newFlags
set result "\{1 \{[convertErrCode $str]\}\}"
} elseif {$numVars > 0} {
# at least 1 match is made
-
+
if {[regexp {s} $flags] == 1} {
set result "\{0 1\}"
} else {
@@ -240,7 +240,7 @@ proc convertTestLine {currentLine len lineNum srcLineNum} {
}
} else {
# no match is made
-
+
set result "\{0 0\}"
}
@@ -248,16 +248,16 @@ proc convertTestLine {currentLine len lineNum srcLineNum} {
set cmd [prepareCmd $flags $re $str $vars $noBraces]
if {$cmd == -1} {
- return "\# skipping test with metasyntax from line $srcLineNum\n"
+ return "\# skipping test with metasyntax from line $srcLineNum\n"
}
set test "test regexp-1.$srcLineNum \{converted from line $srcLineNum\} \{\n"
append test "\tcatch {unset var}\n"
- append test "\tlist \[catch \{ \n"
- append test "\t\tset match \[$cmd\] \n"
- append test "\t\tlist \$match $vals \n"
- append test "\t\} msg\] \$msg \n"
- append test "\} $result \n"
+ append test "\tlist \[catch \{\n"
+ append test "\t\tset match \[$cmd\]\n"
+ append test "\t\tlist \$match $vals\n"
+ append test "\t\} msg\] \$msg\n"
+ append test "\} $result\n"
return $test
}
diff --git a/tools/tclZIC.tcl b/tools/tclZIC.tcl
index 1fa34be..85c9ba9 100755
--- a/tools/tclZIC.tcl
+++ b/tools/tclZIC.tcl
@@ -356,7 +356,7 @@ proc parseON {on} {
# third possibility - lastWeekday - field 5
last([[:alpha:]]+)
)$
- } $on -> dom1 wday2 dir2 num2 wday3]} then {
+ } $on -> dom1 wday2 dir2 num2 wday3]} {
error "can't parse ON field \"$on\""
}
if {$dom1 ne ""} {
@@ -507,7 +507,7 @@ proc parseTOD {tod} {
(?:
([wsugz]) # field 4 - type indicator
)?
- } $tod -> hour minute second ind]} then {
+ } $tod -> hour minute second ind]} {
puts stderr "$fileName:$lno:can't parse time field \"$tod\""
incr errorCount
}
@@ -556,7 +556,7 @@ proc parseOffsetTime {offset} {
:([[:digit:]]{2}) # field 4 - second
)?
)?
- } $offset -> signum hour minute second]} then {
+ } $offset -> signum hour minute second]} {
puts stderr "$fileName:$lno:can't parse offset time \"$offset\""
incr errorCount
}
@@ -938,7 +938,7 @@ proc applyRules {ruleSet year startSecs stdGMTOffset DSTOffset nextGMTOffset
if {
$earliestSecs > $startSecs &&
($until eq "" || $earliestSecs < $untilSecs)
- } then {
+ } {
# Test if the initial transition has been done.
# If not, do it now.
@@ -987,7 +987,7 @@ proc applyRules {ruleSet year startSecs stdGMTOffset DSTOffset nextGMTOffset
set date [::tcl::clock::GetJulianDayFromEraYearMonthDay \
[dict create era CE year $year month 1 dayOfMonth 1] 2361222]
set startSecs [expr {
- [dict get $date julianDay] * wide(86400) - 210866803200
+ [dict get $date julianDay] * wide(86400) - 210866803200
- $stdGMTOffset - $DSTOffset
}]
diff --git a/tools/tcltk-man2html.tcl b/tools/tcltk-man2html.tcl
index 04891eb..a09bf79 100755
--- a/tools/tcltk-man2html.tcl
+++ b/tools/tcltk-man2html.tcl
@@ -1427,7 +1427,7 @@ proc output-directive {line} {
}
##
## merge copyright listings
-##
+##
proc merge-copyrights {l1 l2} {
set merge {}
set re1 {^Copyright +(?:\(c\)|\\\(co|&copy;) +(\w.*?)(?:all rights reserved)?(?:\. )*$}
diff --git a/tools/uniParse.tcl b/tools/uniParse.tcl
index a451096..545afc4 100644
--- a/tools/uniParse.tcl
+++ b/tools/uniParse.tcl
@@ -68,7 +68,7 @@ proc uni::getGroup {value} {
variable groups
set gIndex [lsearch -exact $groups $value]
- if {$gIndex == -1} {
+ if {$gIndex < 0} {
set gIndex [llength $groups]
lappend groups $value
}
@@ -81,7 +81,7 @@ proc uni::addPage {info} {
variable shift
set pIndex [lsearch -exact $pages $info]
- if {$pIndex == -1} {
+ if {$pIndex < 0} {
set pIndex [llength $pages]
lappend pages $info
}
generated by cgit v0.12 at 2025-11-04 00:34:31 (GMT)