summaryrefslogtreecommitdiffstats
path: root/library
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2013-01-30 17:46:30 (GMT)
committerdgp <dgp@users.sourceforge.net>2013-01-30 17:46:30 (GMT)
commit91a7a404d263838b97b97250353e43c2e0244026 (patch)
tree2b6f271802dff517ab1ac014a845780edd5ee2d3 /library
parent1f7f9de6851bbf13e8435d152784c17481753e26 (diff)
downloadtcl-91a7a404d263838b97b97250353e43c2e0244026.zip
tcl-91a7a404d263838b97b97250353e43c2e0244026.tar.gz
tcl-91a7a404d263838b97b97250353e43c2e0244026.tar.bz2
In the script library, selected modernizations from Patrick Fradin.
Diffstat (limited to 'library')
-rw-r--r--library/auto.tcl23
-rw-r--r--library/init.tcl50
-rw-r--r--library/word.tcl10
3 files changed, 43 insertions, 40 deletions
diff --git a/library/auto.tcl b/library/auto.tcl
index 55fc90f..b0fb61d 100644
--- a/library/auto.tcl
+++ b/library/auto.tcl
@@ -20,19 +20,20 @@
# None.
proc auto_reset {} {
- if {[array exists ::auto_index]} {
- foreach cmdName [array names ::auto_index] {
+ global auto_execs auto_index auto_path
+ if {[array exists auto_index]} {
+ foreach cmdName [array names auto_index] {
set fqcn [namespace which $cmdName]
if {$fqcn eq ""} {continue}
rename $fqcn {}
}
}
- unset -nocomplain ::auto_execs ::auto_index ::tcl::auto_oldpath
- if {[catch {llength $::auto_path}]} {
- set ::auto_path [list [info library]]
+ unset -nocomplain auto_execs auto_index ::tcl::auto_oldpath
+ if {[catch {llength $auto_path}]} {
+ set auto_path [list [info library]]
} else {
- if {[info library] ni $::auto_path} {
- lappend ::auto_path [info library]
+ if {[info library] ni $auto_path} {
+ lappend auto_path [info library]
}
}
}
@@ -53,7 +54,7 @@ proc auto_reset {} {
proc tcl_findLibrary {basename version patch initScript enVarName varName} {
upvar #0 $varName the_library
- global env
+ global auto_path env tcl_platform
set dirs {}
set errors {}
@@ -86,10 +87,10 @@ proc tcl_findLibrary {basename version patch initScript enVarName varName} {
# 3. Relative to auto_path directories. This checks relative to the
# Tcl library as well as allowing loading of libraries added to the
# auto_path that is not relative to the core library or binary paths.
- foreach d $::auto_path {
+ foreach d $auto_path {
lappend dirs [file join $d $basename$version]
- if {$::tcl_platform(platform) eq "unix"
- && $::tcl_platform(os) eq "Darwin"} {
+ if {$tcl_platform(platform) eq "unix"
+ && $tcl_platform(os) eq "Darwin"} {
# 4. On MacOSX, check the Resources/Scripts subdir too
lappend dirs [file join $d $basename$version Resources Scripts]
}
diff --git a/library/init.tcl b/library/init.tcl
index 1e7e2cd..21e0370 100644
--- a/library/init.tcl
+++ b/library/init.tcl
@@ -12,6 +12,7 @@
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
+# 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]"
}
@@ -116,9 +117,10 @@ namespace eval tcl {
if {(![interp issafe]) && ($tcl_platform(platform) eq "windows")} {
namespace eval tcl {
proc EnvTraceProc {lo n1 n2 op} {
- set x $::env($n2)
- set ::env($lo) $x
- set ::env([string toupper $lo]) $x
+ global env
+ set x $env($n2)
+ set env($lo) $x
+ set env([string toupper $lo]) $x
}
proc InitWinEnv {} {
global env tcl_platform
@@ -159,8 +161,8 @@ if {[interp issafe]} {
} else {
# Set up search for Tcl Modules (TIP #189).
# and setup platform specific unknown package handlers
- if {$::tcl_platform(os) eq "Darwin"
- && $::tcl_platform(platform) eq "unix"} {
+ if {$tcl_platform(os) eq "Darwin"
+ && $tcl_platform(platform) eq "unix"} {
package unknown {::tcl::tm::UnknownHandler \
{::tcl::MacOSXPkgUnknown ::tclPkgUnknown}}
} else {
@@ -235,7 +237,7 @@ if {[namespace which -command tclLog] eq ""} {
proc unknown args {
variable ::tcl::UnknownPending
- global auto_noexec auto_noload env tcl_interactive
+ global auto_noexec auto_noload env tcl_interactive errorInfo errorCode
# If the command word has the form "namespace inscope ns cmd"
# then concatenate its arguments onto the end and evaluate it.
@@ -250,8 +252,8 @@ proc unknown args {
return -options $opts $result
}
- catch {set savedErrorInfo $::errorInfo}
- catch {set savedErrorCode $::errorCode}
+ catch {set savedErrorInfo $errorInfo}
+ catch {set savedErrorCode $errorCode}
set name $cmd
if {![info exists auto_noload]} {
#
@@ -280,9 +282,9 @@ proc unknown args {
unset -nocomplain ::errorCode
}
if {[info exists savedErrorInfo]} {
- set ::errorInfo $savedErrorInfo
+ set errorInfo $savedErrorInfo
} else {
- unset -nocomplain ::errorInfo
+ unset -nocomplain errorInfo
}
set code [catch {uplevel 1 $args} msg opts]
if {$code == 1} {
@@ -291,8 +293,8 @@ proc unknown args {
# Note the dependence on how Tcl_AddErrorInfo, etc.
# construct the stack trace.
#
- set errorInfo [dict get $opts -errorinfo]
- set errorCode [dict get $opts -errorcode]
+ set errInfo [dict get $opts -errorinfo]
+ set errCode [dict get $opts -errorcode]
set cinfo $args
if {[string bytelength $cinfo] > 150} {
set cinfo [string range $cinfo 0 150]
@@ -309,7 +311,7 @@ proc unknown args {
# and trim the extra contribution from the matching case
#
set expect "$msg\n while executing\n\"$cinfo"
- if {$errorInfo eq $expect} {
+ if {$errInfo eq $expect} {
#
# The stack has only the eval from the expanded command
# Do not generate any stack trace here.
@@ -324,18 +326,18 @@ proc unknown args {
#
set expect "\n invoked from within\n\"$cinfo"
set exlen [string length $expect]
- set eilen [string length $errorInfo]
+ set eilen [string length $errInfo]
set i [expr {$eilen - $exlen - 1}]
- set einfo [string range $errorInfo 0 $i]
+ set einfo [string range $errInfo 0 $i]
#
- # For now verify that $errorInfo consists of what we are about
+ # For now verify that $errInfo consists of what we are about
# to return plus what we expected to trim off.
#
- if {$errorInfo ne "$einfo$expect"} {
+ if {$errInfo ne "$einfo$expect"} {
error "Tcl bug: unexpected stack trace in \"unknown\"" {} \
- [list CORE UNKNOWN BADTRACE $einfo $expect $errorInfo]
+ [list CORE UNKNOWN BADTRACE $einfo $expect $errInfo]
}
- return -code error -errorcode $errorCode \
+ return -code error -errorcode $errCode \
-errorinfo $einfo $msg
} else {
dict incr opts -level
@@ -344,7 +346,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]
@@ -797,7 +799,7 @@ proc tcl::CopyDirectory {action src dest} {
lappend existing {*}[glob -nocomplain -directory $dest \
-type hidden * .*]
foreach s $existing {
- if {([file tail $s] ne ".") && ([file tail $s] ne "..")} {
+ if {[file tail $s] ni {. ..}} {
return -code error "error $action \"$src\" to\
\"$dest\": file already exists"
}
@@ -805,7 +807,7 @@ proc tcl::CopyDirectory {action src dest} {
}
} else {
if {[string first $nsrc $ndest] != -1} {
- set srclen [expr {[llength [file split $nsrc]] -1}]
+ set srclen [expr {[llength [file split $nsrc]] - 1}]
set ndest [lindex [file split $ndest] $srclen]
if {$ndest eq [file tail $nsrc]} {
return -code error "error $action \"$src\" to\
@@ -825,8 +827,8 @@ proc tcl::CopyDirectory {action src dest} {
[glob -nocomplain -directory $src -types hidden *]]
foreach s [lsort -unique $filelist] {
- if {([file tail $s] ne ".") && ([file tail $s] ne "..")} {
- file copy -force $s [file join $dest [file tail $s]]
+ if {[file tail $s] ni {. ..}} {
+ file copy -force -- $s [file join $dest [file tail $s]]
}
}
return
diff --git a/library/word.tcl b/library/word.tcl
index 16a4638..b8f34a5 100644
--- a/library/word.tcl
+++ b/library/word.tcl
@@ -67,7 +67,7 @@ namespace eval ::tcl {
proc tcl_wordBreakAfter {str start} {
variable ::tcl::WordBreakRE
set result {-1 -1}
- regexp -indices -start $start $WordBreakRE(after) $str result
+ regexp -indices -start $start -- $WordBreakRE(after) $str result
return [lindex $result 1]
}
@@ -85,7 +85,7 @@ proc tcl_wordBreakAfter {str start} {
proc tcl_wordBreakBefore {str start} {
variable ::tcl::WordBreakRE
set result {-1 -1}
- regexp -indices $WordBreakRE(before) [string range $str 0 $start] result
+ regexp -indices -- $WordBreakRE(before) [string range $str 0 $start] result
return [lindex $result 1]
}
@@ -104,7 +104,7 @@ proc tcl_wordBreakBefore {str start} {
proc tcl_endOfWord {str start} {
variable ::tcl::WordBreakRE
set result {-1 -1}
- regexp -indices -start $start $WordBreakRE(end) $str result
+ regexp -indices -start $start -- $WordBreakRE(end) $str result
return [lindex $result 1]
}
@@ -122,7 +122,7 @@ proc tcl_endOfWord {str start} {
proc tcl_startOfNextWord {str start} {
variable ::tcl::WordBreakRE
set result {-1 -1}
- regexp -indices -start $start $WordBreakRE(next) $str result
+ regexp -indices -start $start -- $WordBreakRE(next) $str result
return [lindex $result 1]
}
@@ -138,7 +138,7 @@ proc tcl_startOfNextWord {str start} {
proc tcl_startOfPreviousWord {str start} {
variable ::tcl::WordBreakRE
set word {-1 -1}
- regexp -indices $WordBreakRE(previous) [string range $str 0 $start-1] \
+ regexp -indices -- $WordBreakRE(previous) [string range $str 0 $start-1] \
result word
return [lindex $word 0]
}