summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--generic/tclUniData.c6
-rw-r--r--generic/tclUtf.c125
-rw-r--r--library/init.tcl4
-rw-r--r--library/msgcat/msgcat.tcl14
-rw-r--r--library/opt/optparse.tcl4
-rw-r--r--library/package.tcl2
-rw-r--r--library/platform/platform.tcl2
-rw-r--r--library/safe.tcl4
-rw-r--r--library/tcltest/tcltest.tcl40
-rw-r--r--tests/httpd11.tcl10
-rwxr-xr-xtools/findBadExternals.tcl4
-rwxr-xr-xtools/loadICU.tcl12
-rwxr-xr-xtools/makeTestCases.tcl132
-rw-r--r--tools/man2help.tcl2
-rw-r--r--tools/man2html.tcl8
-rw-r--r--tools/man2html1.tcl18
-rw-r--r--tools/mkdepend.tcl14
-rw-r--r--tools/uniParse.tcl6
-rw-r--r--unix/tclUnixNotfy.c4
19 files changed, 240 insertions, 171 deletions
diff --git a/generic/tclUniData.c b/generic/tclUniData.c
index d2f66fe..1ca119d 100644
--- a/generic/tclUniData.c
+++ b/generic/tclUniData.c
@@ -1556,4 +1556,8 @@ enum {
* Unicode character tables.
*/
-#define GetUniCharInfo(ch) (groups[groupMap[pageMap[((ch) & 0xffff) >> OFFSET_BITS] | ((ch) & ((1 << OFFSET_BITS)-1))]])
+#if TCL_UTF_MAX > 3
+# define GetUniCharInfo(ch) (groups[groupMap[pageMap[((ch) & 0x1fffff) >> OFFSET_BITS] | ((ch) & ((1 << OFFSET_BITS)-1))]])
+#else
+# define GetUniCharInfo(ch) (groups[groupMap[pageMap[((ch) & 0xffff) >> OFFSET_BITS] | ((ch) & ((1 << OFFSET_BITS)-1))]])
+#endif
diff --git a/generic/tclUtf.c b/generic/tclUtf.c
index 15529c7..b878149 100644
--- a/generic/tclUtf.c
+++ b/generic/tclUtf.c
@@ -117,19 +117,10 @@ UtfCount(
if (ch <= 0x7FF) {
return 2;
}
- if (ch <= 0xFFFF) {
- return 3;
- }
#if TCL_UTF_MAX > 3
- if (ch <= 0x1FFFFF) {
+ if ((ch > 0xFFFF) && (ch <= 0x10FFFF)) {
return 4;
}
- if (ch <= 0x3FFFFFF) {
- return 5;
- }
- if (ch <= 0x7FFFFFFF) {
- return 6;
- }
#endif
return 3;
}
@@ -172,6 +163,23 @@ Tcl_UniCharToUtf(
return 2;
}
if (ch <= 0xFFFF) {
+#if TCL_UTF_MAX == 4
+ if ((ch & 0xF800) == 0xD800) {
+ if (ch & 0x0400) {
+ /* Low surrogate */
+ buf[3] = (char) ((ch | 0x80) & 0xBF);
+ buf[2] |= (char) (((ch >> 6) | 0x80) & 0x8F);
+ return 4;
+ } else {
+ /* High surrogate */
+ ch += 0x40;
+ buf[2] = (char) (((ch << 4) | 0x80) & 0xB0);
+ buf[1] = (char) (((ch >> 2) | 0x80) & 0xBF);
+ buf[0] = (char) (((ch >> 8) | 0xF0) & 0xF7);
+ return 0;
+ }
+ }
+#endif
three:
buf[2] = (char) ((ch | 0x80) & 0xBF);
buf[1] = (char) (((ch >> 6) | 0x80) & 0xBF);
@@ -180,30 +188,13 @@ Tcl_UniCharToUtf(
}
#if TCL_UTF_MAX > 3
- if (ch <= 0x1FFFFF) {
+ if (ch <= 0x10FFFF) {
buf[3] = (char) ((ch | 0x80) & 0xBF);
buf[2] = (char) (((ch >> 6) | 0x80) & 0xBF);
buf[1] = (char) (((ch >> 12) | 0x80) & 0xBF);
buf[0] = (char) ((ch >> 18) | 0xF0);
return 4;
}
- if (ch <= 0x3FFFFFF) {
- buf[4] = (char) ((ch | 0x80) & 0xBF);
- buf[3] = (char) (((ch >> 6) | 0x80) & 0xBF);
- buf[2] = (char) (((ch >> 12) | 0x80) & 0xBF);
- buf[1] = (char) (((ch >> 18) | 0x80) & 0xBF);
- buf[0] = (char) ((ch >> 24) | 0xF8);
- return 5;
- }
- if (ch <= 0x7FFFFFFF) {
- buf[5] = (char) ((ch | 0x80) & 0xBF);
- buf[4] = (char) (((ch >> 6) | 0x80) & 0xBF);
- buf[3] = (char) (((ch >> 12) | 0x80) & 0xBF);
- buf[2] = (char) (((ch >> 18) | 0x80) & 0xBF);
- buf[1] = (char) (((ch >> 24) | 0x80) & 0xBF);
- buf[0] = (char) ((ch >> 30) | 0xFC);
- return 6;
- }
#endif
}
@@ -1365,6 +1356,11 @@ int
Tcl_UniCharIsAlnum(
int ch) /* Unicode character to test. */
{
+#if TCL_UTF_MAX > 3
+ if (UNICODE_OUT_OF_RANGE(ch)) {
+ return 0;
+ }
+#endif
return (((ALPHA_BITS | DIGIT_BITS) >> GetCategory(ch)) & 1);
}
@@ -1388,6 +1384,11 @@ int
Tcl_UniCharIsAlpha(
int ch) /* Unicode character to test. */
{
+#if TCL_UTF_MAX > 3
+ if (UNICODE_OUT_OF_RANGE(ch)) {
+ return 0;
+ }
+#endif
return ((ALPHA_BITS >> GetCategory(ch)) & 1);
}
@@ -1411,6 +1412,18 @@ int
Tcl_UniCharIsControl(
int ch) /* Unicode character to test. */
{
+#if TCL_UTF_MAX > 3
+ if (UNICODE_OUT_OF_RANGE(ch)) {
+ ch &= 0x1fffff;
+ if ((ch == 0xe0001) || ((ch >= 0xe0020) && (ch <= 0xe007f))) {
+ return 1;
+ }
+ if ((ch >= 0xf0000) && ((ch & 0xffff) <= 0xfffd)) {
+ return 1;
+ }
+ return 0;
+ }
+#endif
return ((CONTROL_BITS >> GetCategory(ch)) & 1);
}
@@ -1434,6 +1447,11 @@ int
Tcl_UniCharIsDigit(
int ch) /* Unicode character to test. */
{
+#if TCL_UTF_MAX > 3
+ if (UNICODE_OUT_OF_RANGE(ch)) {
+ return 0;
+ }
+#endif
return (GetCategory(ch) == DECIMAL_DIGIT_NUMBER);
}
@@ -1457,6 +1475,12 @@ int
Tcl_UniCharIsGraph(
int ch) /* Unicode character to test. */
{
+#if TCL_UTF_MAX > 3
+ if (UNICODE_OUT_OF_RANGE(ch)) {
+ ch &= 0x1fffff;
+ return (ch >= 0xe0100) && (ch <= 0xe01ef);
+ }
+#endif
return ((GRAPH_BITS >> GetCategory(ch)) & 1);
}
@@ -1480,6 +1504,11 @@ int
Tcl_UniCharIsLower(
int ch) /* Unicode character to test. */
{
+#if TCL_UTF_MAX > 3
+ if (UNICODE_OUT_OF_RANGE(ch)) {
+ return 0;
+ }
+#endif
return (GetCategory(ch) == LOWERCASE_LETTER);
}
@@ -1503,6 +1532,12 @@ int
Tcl_UniCharIsPrint(
int ch) /* Unicode character to test. */
{
+#if TCL_UTF_MAX > 3
+ if (UNICODE_OUT_OF_RANGE(ch)) {
+ ch &= 0x1fffff;
+ return (ch >= 0xe0100) && (ch <= 0xe01ef);
+ }
+#endif
return (((GRAPH_BITS|SPACE_BITS) >> GetCategory(ch)) & 1);
}
@@ -1526,6 +1561,11 @@ int
Tcl_UniCharIsPunct(
int ch) /* Unicode character to test. */
{
+#if TCL_UTF_MAX > 3
+ if (UNICODE_OUT_OF_RANGE(ch)) {
+ return 0;
+ }
+#endif
return ((PUNCT_BITS >> GetCategory(ch)) & 1);
}
@@ -1549,16 +1589,27 @@ int
Tcl_UniCharIsSpace(
int ch) /* Unicode character to test. */
{
+#if TCL_UTF_MAX > 3
+ /* Ignore upper 11 bits. */
+ ch &= 0x1fffff;
+#else
+ /* Ignore upper 16 bits. */
+ ch &= 0xffff;
+#endif
+
/*
* If the character is within the first 127 characters, just use the
* standard C function, otherwise consult the Unicode table.
*/
- if (((Tcl_UniChar) ch) < ((Tcl_UniChar) 0x80)) {
+ if (ch < 0x80) {
return TclIsSpaceProc((char) ch);
- } else if ((Tcl_UniChar) ch == 0x0085 || (Tcl_UniChar) ch == 0x180e
- || (Tcl_UniChar) ch == 0x200b || (Tcl_UniChar) ch == 0x2060
- || (Tcl_UniChar) ch == 0x202f || (Tcl_UniChar) ch == 0xfeff) {
+#if TCL_UTF_MAX > 3
+ } else if (UNICODE_OUT_OF_RANGE(ch)) {
+ return 0;
+#endif
+ } else if (ch == 0x0085 || ch == 0x180e || ch == 0x200b
+ || ch == 0x202f || ch == 0x2060 || ch == 0xfeff) {
return 1;
} else {
return ((SPACE_BITS >> GetCategory(ch)) & 1);
@@ -1585,6 +1636,11 @@ int
Tcl_UniCharIsUpper(
int ch) /* Unicode character to test. */
{
+#if TCL_UTF_MAX > 3
+ if (UNICODE_OUT_OF_RANGE(ch)) {
+ return 0;
+ }
+#endif
return (GetCategory(ch) == UPPERCASE_LETTER);
}
@@ -1608,6 +1664,11 @@ int
Tcl_UniCharIsWordChar(
int ch) /* Unicode character to test. */
{
+#if TCL_UTF_MAX > 3
+ if (UNICODE_OUT_OF_RANGE(ch)) {
+ return 0;
+ }
+#endif
return ((WORD_BITS >> GetCategory(ch)) & 1);
}
diff --git a/library/init.tcl b/library/init.tcl
index 05ac4a3..9bb28e9 100644
--- a/library/init.tcl
+++ b/library/init.tcl
@@ -12,7 +12,7 @@
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# This test intentionally written in pre-7.5 Tcl
+# This test intentionally written in pre-7.5 Tcl
if {[info commands package] == ""} {
error "version mismatch: library\nscripts expect Tcl version 7.5b1 or later but the loaded version is\nonly [info patchlevel]"
}
@@ -332,7 +332,7 @@ proc unknown args {
}
}
- if {([info level] == 1) && ([info script] eq "")
+ if {([info level] == 1) && ([info script] eq "")
&& [info exists tcl_interactive] && $tcl_interactive} {
if {![info exists auto_noexec]} {
set new [auto_execok $name]
diff --git a/library/msgcat/msgcat.tcl b/library/msgcat/msgcat.tcl
index 5ed9f3a..a43f13e 100644
--- a/library/msgcat/msgcat.tcl
+++ b/library/msgcat/msgcat.tcl
@@ -262,7 +262,7 @@ proc msgcat::mcexists {args} {
}
}
set src [lindex $args 0]
-
+
while {$ns ne ""} {
foreach loc $loclist {
if {[dict exists $Msgs $ns $loc $src]} {
@@ -305,7 +305,7 @@ proc msgcat::mclocale {args} {
}
if {[lindex $Loclist 0] ne $newLocale} {
set Loclist [GetPreferences $newLocale]
-
+
# locale not loaded jet
LoadAll $Loclist
# Invoke callback
@@ -463,7 +463,7 @@ proc msgcat::mcpackagelocale {subcommand {locale ""}} {
set locale [string tolower $locale]
}
set ns [uplevel 1 {::namespace current}]
-
+
switch -exact -- $subcommand {
get { return [lindex [PackagePreferences $ns] 0] }
preferences { return [PackagePreferences $ns] }
@@ -646,7 +646,7 @@ proc msgcat::mcpackageconfig {subcommand option {value ""}} {
isset { return [dict exists $PackageConfig $option $ns] }
unset { dict unset PackageConfig $option $ns }
set { # Set option
-
+
if {$option eq "mcfolder"} {
set value [file normalize $value]
}
@@ -779,7 +779,7 @@ proc msgcat::LoadAll {locales} {
set locales [ListComplement $LoadedLocales $locales]
if {0 == [llength $locales]} { return {} }
lappend LoadedLocales {*}$locales
-
+
set packages [lsort -unique [concat\
[dict keys [dict get $PackageConfig loadcmd]]\
[dict keys [dict get $PackageConfig mcfolder]]]]
@@ -812,14 +812,14 @@ proc msgcat::Load {ns locales {callbackonly 0}} {
# Invoke callback
Invoke loadcmd $locales $ns
-
+
if {$callbackonly || ![dict exists $PackageConfig mcfolder $ns]} {
return 0
}
# Invoke file load
set langdir [dict get $PackageConfig mcfolder $ns]
-
+
# Save the file locale if we are recursively called
if {[info exists FileLocale]} {
set nestedFileLocale $FileLocale
diff --git a/library/opt/optparse.tcl b/library/opt/optparse.tcl
index fc77fa1..869a2b6 100644
--- a/library/opt/optparse.tcl
+++ b/library/opt/optparse.tcl
@@ -435,7 +435,7 @@ proc ::tcl::OptProcArgGiven {argname} {
} elseif {$state == "optValue"} {
set state next; # not used, for debug only
# go to next state
- return
+ return
} else {
return -code error [OptMissingValue $descriptions]
}
@@ -538,7 +538,7 @@ proc ::tcl::OptKeyParse {descKey arglist} {
# Analyse the result
# Walk through the tree:
- OptTreeVars $desc "#[expr {[info level]-1}]"
+ OptTreeVars $desc "#[expr {[info level]-1}]"
}
# determine string length for nice tabulated output
diff --git a/library/package.tcl b/library/package.tcl
index 52daa0e..44e3b28 100644
--- a/library/package.tcl
+++ b/library/package.tcl
@@ -726,7 +726,7 @@ proc ::tcl::Pkg::Create {args} {
foreach key {load source} {
foreach filespec $opts(-$key) {
lassign $filespec filename proclist
-
+
if { [llength $proclist] == 0 } {
set cmd "\[list $key \[file join \$dir [list $filename]\]\]"
lappend cmdList $cmd
diff --git a/library/platform/platform.tcl b/library/platform/platform.tcl
index 1bce7b5..e0bcce6 100644
--- a/library/platform/platform.tcl
+++ b/library/platform/platform.tcl
@@ -323,7 +323,7 @@ proc ::platform::patterns {id} {
lappend res macosx-universal macosx-i386-x86_64
}
macosx*-* {
- # 10.5+
+ # 10.5+
if {[regexp {macosx([^-]*)-(.*)} $id -> v cpu]} {
switch -exact -- $cpu {
diff --git a/library/safe.tcl b/library/safe.tcl
index 394aa97..ea6391d 100644
--- a/library/safe.tcl
+++ b/library/safe.tcl
@@ -853,7 +853,7 @@ proc ::safe::AliasSource {slave args} {
return -code error $msg
}
set file [lindex $args $at]
-
+
# get the real path from the virtual one.
if {[catch {
set realfile [TranslatePath $slave $file]
@@ -861,7 +861,7 @@ proc ::safe::AliasSource {slave args} {
Log $slave $msg
return -code error "permission denied"
}
-
+
# check that the path is in the access path of that slave
if {[catch {
FileInAccessPath $slave $realfile
diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl
index 8e43859..29ef778 100644
--- a/library/tcltest/tcltest.tcl
+++ b/library/tcltest/tcltest.tcl
@@ -347,7 +347,7 @@ namespace eval tcltest {
# This is very subtle and tricky, so let me try to explain.
# (Hopefully this longer comment will be clear when I come
# back in a few months, unlike its predecessor :) )
- #
+ #
# The [outputChannel] command (and underlying variable) have to
# be kept in sync with the [configure -outfile] configuration
# option ( and underlying variable Option(-outfile) ). This is
@@ -362,12 +362,12 @@ namespace eval tcltest {
# configuration options to parse the command line option the first
# time they are read. These traces are cancelled whenever the
# program itself calls [configure].
- #
+ #
# OK, then so to support tcltest 1 compatibility, it seems we want
# to get the return from [outputFile] to trigger the read traces,
# just in case.
#
- # BUT! A little known feature of Tcl variable traces is that
+ # BUT! A little known feature of Tcl variable traces is that
# traces are disabled during the handling of other traces. So,
# if we trigger read traces on Option(-outfile) and that triggers
# command line parsing which turns around and sets an initial
@@ -608,7 +608,7 @@ namespace eval tcltest {
set code [catch {Configure {*}$args} msg]
return -code $code $msg
}
-
+
proc AcceptVerbose { level } {
set level [AcceptList $level]
if {[llength $level] == 1} {
@@ -639,7 +639,7 @@ namespace eval tcltest {
skipped tests if 's' is specified, the bodies of failed tests if
'b' is specified, and when tests start if 't' is specified.
ErrorInfo is displayed if 'e' is specified. Source file line
- information of failed tests is displayed if 'l' is specified.
+ information of failed tests is displayed if 'l' is specified.
} AcceptVerbose verbose
# Match and skip patterns default to the empty list, except for
@@ -687,7 +687,7 @@ namespace eval tcltest {
# some additional output regarding operations of the test harness.
# The tcltest package currently implements only up to debug level 3.
Option -debug 0 {
- Internal debug level
+ Internal debug level
} AcceptInteger debug
proc SetSelectedConstraints args {
@@ -715,7 +715,7 @@ namespace eval tcltest {
}
Option -limitconstraints 0 {
whether to run only tests with the constraints
- } AcceptBoolean limitConstraints
+ } AcceptBoolean limitConstraints
trace add variable Option(-limitconstraints) write \
[namespace code {ClearUnselectedConstraints ;#}]
@@ -728,7 +728,7 @@ namespace eval tcltest {
# Default is to run each test file in a separate process
Option -singleproc 0 {
whether to run all tests in one process
- } AcceptBoolean singleProcess
+ } AcceptBoolean singleProcess
proc AcceptTemporaryDirectory { directory } {
set directory [AcceptAbsolutePath $directory]
@@ -1257,7 +1257,7 @@ proc tcltest::DefineConstraintInitializers {} {
# setting files into nonblocking mode.
ConstraintInitializer nonBlockFiles {
- set code [expr {[catch {set f [open defs r]}]
+ set code [expr {[catch {set f [open defs r]}]
|| [catch {chan configure $f -blocking off}]}]
catch {close $f}
set code
@@ -1271,7 +1271,7 @@ proc tcltest::DefineConstraintInitializers {} {
# (Mark Diekhans).
ConstraintInitializer asyncPipeClose {expr {
- !([string equal unix $::tcl_platform(platform)]
+ !([string equal unix $::tcl_platform(platform)]
&& ([catch {exec uname -X | fgrep {Release = 3.2v}}] == 0))}}
# Test to see if we have a broken version of sprintf with respect
@@ -1954,7 +1954,7 @@ proc tcltest::test {name description args} {
return
}
- # Save information about the core file.
+ # Save information about the core file.
if {[preserveCore]} {
if {[file exists [file join [workingDirectory] core]]} {
set coreModTime [file mtime [file join [workingDirectory] core]]
@@ -2060,7 +2060,7 @@ proc tcltest::test {name description args} {
} else {
set coreFailure 1
}
-
+
if {([preserveCore] > 1) && ($coreFailure)} {
append coreMsg "\nMoving file to:\
[file join [temporaryDirectory] core-$name]"
@@ -2100,7 +2100,7 @@ proc tcltest::test {name description args} {
variable currentFailure true
if {![IsVerbose body]} {
set body ""
- }
+ }
puts [outputChannel] "\n"
if {[IsVerbose line]} {
if {![catch {set testFrame [info frame -1]}] &&
@@ -2121,7 +2121,7 @@ proc tcltest::test {name description args} {
puts [outputChannel] "$testFile:$testLine: error: test failed:\
$name [string trim $description]"
}
- }
+ }
puts [outputChannel] "==== $name\
[string trim $description] FAILED"
if {[string length $body]} {
@@ -2277,7 +2277,7 @@ proc tcltest::Skipped {name constraints} {
}
}
}
-
+
if {!$doTest} {
if {[IsVerbose skip]} {
puts [outputChannel] "++++ $name SKIPPED: $constraints"
@@ -2834,9 +2834,9 @@ proc tcltest::runAllTests { {shell ""} } {
set dir [file tail $directory]
puts [outputChannel] [string repeat ~ 44]
puts [outputChannel] "$dir test began at [eval $timeCmd]\n"
-
+
uplevel 1 [list ::source [file join $directory all.tcl]]
-
+
set endTime [eval $timeCmd]
puts [outputChannel] "\n$dir test ended at $endTime"
puts [outputChannel] ""
@@ -3019,7 +3019,7 @@ proc tcltest::removeFile {name {directory ""}} {
DebugDo 1 {
Warn "removeFile removing \"$fullName\":\n not created by makeFile"
}
- }
+ }
if {![file isfile $fullName]} {
DebugDo 1 {
Warn "removeFile removing \"$fullName\":\n not a file"
@@ -3090,7 +3090,7 @@ proc tcltest::removeDirectory {name {directory ""}} {
Warn "removeDirectory removing \"$fullName\":\n not created\
by makeDirectory"
}
- }
+ }
if {![file isdirectory $fullName]} {
DebugDo 1 {
Warn "removeDirectory removing \"$fullName\":\n not a directory"
@@ -3285,7 +3285,7 @@ proc tcltest::threadReap {} {
testthread errorproc ThreadError
return [llength [testthread names]]
} elseif {[info commands thread::id] ne {}} {
-
+
# Thread extension
thread::errorproc ThreadNullError
diff --git a/tests/httpd11.tcl b/tests/httpd11.tcl
index 267f409..6eae2b7 100644
--- a/tests/httpd11.tcl
+++ b/tests/httpd11.tcl
@@ -44,7 +44,7 @@ proc get-chunks {data {compression gzip}} {
deflate { set data [zlib deflate $data] }
compress { set data [zlib compress $data] }
}
-
+
set data ""
set chunker [make-chunk-generator $data 512]
while {[string length [set chunk [$chunker]]]} {
@@ -59,7 +59,7 @@ proc blow-chunks {data {ochan stdout} {compression gzip}} {
deflate { set data [zlib deflate $data] }
compress { set data [zlib compress $data] }
}
-
+
set chunker [make-chunk-generator $data 512]
while {[string length [set chunk [$chunker]]]} {
puts -nonewline $ochan $chunk
@@ -156,7 +156,7 @@ proc Service {chan addr port} {
set code "200 OK"
set close [expr {[dict get? $meta connection] eq "close"}]
}
-
+
if {$protocol eq "HTTP/1.1"} {
foreach enc [split [dict get? $meta accept-encoding] ,] {
set enc [string trim $enc]
@@ -169,7 +169,7 @@ proc Service {chan addr port} {
} else {
set close 1
}
-
+
foreach pair [split $query &] {
if {[scan $pair {%[^=]=%s} key val] != 2} {set val ""}
switch -exact -- $key {
@@ -209,7 +209,7 @@ proc Service {chan addr port} {
} else {
puts -nonewline $chan $data
}
-
+
if {$close} {
chan event $chan readable {}
close $chan
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/loadICU.tcl b/tools/loadICU.tcl
index 5b09e2c..31f1e54 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 >= 0x0020 && $ccode < 0x007f && $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 d96a221..6cc033b 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/man2html.tcl b/tools/man2html.tcl
index fa57b03..6d4724f 100644
--- a/tools/man2html.tcl
+++ b/tools/man2html.tcl
@@ -27,8 +27,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)\}"
@@ -141,12 +141,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 f2b2e43..e8d29e8 100644
--- a/tools/man2html1.tcl
+++ b/tools/man2html1.tcl
@@ -10,7 +10,7 @@ package require Tcl 8.4
# 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
@@ -23,7 +23,7 @@ package require Tcl 8.4
#
# lib - contains package name. Used to label section in contents.html
#
-# inDT - in dictionary term.
+# inDT - in dictionary term.
# text --
@@ -32,7 +32,7 @@ package require Tcl 8.4
# 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.
@@ -86,7 +86,7 @@ proc macro {name args} {
KEYWORDS {set state KEY}
default {set state OFF}
}
-
+
}
TP {
global inDT
@@ -138,7 +138,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.
@@ -214,9 +214,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"
@@ -237,8 +237,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/mkdepend.tcl b/tools/mkdepend.tcl
index de5fdba..ecb2206 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
#==============================================================================
diff --git a/tools/uniParse.tcl b/tools/uniParse.tcl
index e33b3c7..8125790 100644
--- a/tools/uniParse.tcl
+++ b/tools/uniParse.tcl
@@ -396,7 +396,11 @@ enum {
* Unicode character tables.
*/
-#define GetUniCharInfo(ch) (groups\[groupMap\[pageMap\[((ch) & 0xffff) >> OFFSET_BITS\] | ((ch) & ((1 << OFFSET_BITS)-1))\]\])
+#if TCL_UTF_MAX > 3
+# define GetUniCharInfo(ch) (groups\[groupMap\[pageMap\[((ch) & 0x1fffff) >> OFFSET_BITS\] | ((ch) & ((1 << OFFSET_BITS)-1))\]\])
+#else
+# define GetUniCharInfo(ch) (groups\[groupMap\[pageMap\[((ch) & 0xffff) >> OFFSET_BITS\] | ((ch) & ((1 << OFFSET_BITS)-1))\]\])
+#endif
"
close $f
diff --git a/unix/tclUnixNotfy.c b/unix/tclUnixNotfy.c
index 693eeac..dc6c6fd 100644
--- a/unix/tclUnixNotfy.c
+++ b/unix/tclUnixNotfy.c
@@ -962,7 +962,7 @@ Tcl_WaitForEvent(
}
#endif /* __CYGWIN */
- pthread_mutex_lock(&notifierInitMutex);
+ pthread_mutex_lock(&notifierMutex);
if (timePtr != NULL && timePtr->sec == 0 && (timePtr->usec == 0
#if defined(__APPLE__) && defined(__LP64__)
@@ -1146,7 +1146,7 @@ Tcl_WaitForEvent(
filePtr->readyMask = mask;
}
#ifdef TCL_THREADS
- pthread_mutex_unlock(&notifierInitMutex);
+ pthread_mutex_unlock(&notifierMutex);
#endif /* TCL_THREADS */
return 0;
}
generated by cgit v0.12 at 2024-11-21 15:12:30 (GMT)