summaryrefslogtreecommitdiffstats
path: root/library/init.tcl
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)
commit3475ea5378a063cc71bc3c0e35ae338c31d0426f (patch)
tree2b6f271802dff517ab1ac014a845780edd5ee2d3 /library/init.tcl
parent46d5769e5f4e9edd66b356958496b14cb9265f4e (diff)
downloadtcl-3475ea5378a063cc71bc3c0e35ae338c31d0426f.zip
tcl-3475ea5378a063cc71bc3c0e35ae338c31d0426f.tar.gz
tcl-3475ea5378a063cc71bc3c0e35ae338c31d0426f.tar.bz2
In the script library, selected modernizations from Patrick Fradin.
Diffstat (limited to 'library/init.tcl')
-rw-r--r--library/init.tcl50
1 files changed, 26 insertions, 24 deletions
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