In the script library, selected modernizations from Patrick Fradin.

3 files changed, 45 insertions, 73 deletions

diff --git a/library/auto.tcl b/library/auto.tcl
index 4bd860d..e86257e 100644
--- a/library/auto.tcl
+++ b/library/auto.tcl
@@ -20,8 +20,9 @@
 # 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
@@ -29,11 +30,11 @@ proc auto_reset {} {
 	    rename $fqcn {}
 	}
     }
-    unset -nocomplain ::auto_execs ::auto_index ::tcl::auto_oldpath
-    if {[catch {llength $::auto_path}]} {
-	set ::auto_path [list [info library]]
-    } elseif {[info library] ni $::auto_path} {
-	lappend ::auto_path [info library]
+    unset -nocomplain auto_execs auto_index ::tcl::auto_oldpath
+    if {[catch {llength $auto_path}]} {
+	set auto_path [list [info library]]
+    } elseif {[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 {}
@@ -83,12 +84,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"
-	    } then {
+	    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 e836df9..bedc06e 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 {
@@ -233,14 +235,13 @@ 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 {[info exists ::errorInfo]} {
-	set savedErrorInfo $::errorInfo
+    if {[info exists errorInfo]} {
+	set savedErrorInfo $errorInfo
     }
-    if {[info exists ::errorCode]} {
-	set savedErrorCode $::errorCode
+    if {[info exists errorCode]} {
+	set savedErrorCode $errorCode
     }
 
     set name [lindex $args 0]
@@ -271,9 +272,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} {
@@ -282,8 +283,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]
@@ -300,7 +301,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.
@@ -315,18 +316,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
@@ -335,7 +336,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]
@@ -788,7 +789,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"
 		}
@@ -796,7 +797,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\
@@ -816,37 +817,9 @@ 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
 }
-
-# TIP 131
-if 0 {
-proc tcl::rmmadwiw {} {
-    set magic {
-        42 83 fe f6 ff f8 f1 e5 c6 f9 eb fd ff fb f1 e5 cc f5 ec f5 e3 fd fe
-        ff f5 fa f3 e1 c7 f9 f2 fd ff f9 fe f9 ed f4 fa f6 e6 f9 f2 e6 fd f9
-        ff f9 f6 e6 fa fd ff fc fb fc f9 f1 ed
-    }
-    foreach mystic [lassign $magic tragic] {
-        set comic [expr (0x$mystic ^ 0x$tragic) - 255 + 0x$tragic]
-        append logic [format %x $comic]
-        set tragic $mystic
-    }
-    binary format H* $logic
-}
-
-proc tcl::mathfunc::rmmadwiw {} {
-    set age [expr {9*6}]
-    set mind ""
-    while {$age} {
-        lappend mind [expr {$age%13}]
-        set age [expr {$age/13}]
-    }
-    set matter [lreverse $mind]
-    return [join $matter ""]
-}
-}
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]
 }