* library/auto.tcl: Updates to the Tcl script library to make

        * library/history.tcl:  use of Tcl 8.4 feautures.  Thanks to
        * library/init.tcl:     Patrick Fradin for prompting on this.
        * library/package.tcl:  [Patch 1237755].
        * library/safe.tcl:
        * library/word.tcl:

1 files changed, 19 insertions, 18 deletions

diff --git a/library/package.tcl b/library/package.tcl
index fa6f445..fa6b01c 100644
--- a/library/package.tcl
+++ b/library/package.tcl
@@ -3,7 +3,7 @@
 # utility procs formerly in init.tcl which can be loaded on demand
 # for package management.
 #
-# RCS: @(#) $Id: package.tcl,v 1.23.2.2 2003/07/24 08:23:17 rmax Exp $
+# RCS: @(#) $Id: package.tcl,v 1.23.2.3 2005/07/22 21:59:41 dgp Exp $
 #
 # Copyright (c) 1991-1993 The Regents of the University of California.
 # Copyright (c) 1994-1998 Sun Microsystems, Inc.
@@ -33,8 +33,8 @@ namespace eval ::pkg {
 
 proc pkg_compareExtension { fileName {ext {}} } {
     global tcl_platform
-    if {![string length $ext]} {set ext [info sharedlibextension]}
-    if {[string equal $tcl_platform(platform) "windows"]} {
+    if {$ext eq ""} {set ext [info sharedlibextension]}
+    if {$tcl_platform(platform) eq "windows"} {
         return [string equal -nocase [file extension $fileName] $ext]
     } else {
         # Some unices add trailing numbers after the .so, so
@@ -42,7 +42,7 @@ proc pkg_compareExtension { fileName {ext {}} } {
         set root $fileName
         while {1} {
             set currExt [file extension $root]
-            if {[string equal $currExt $ext]} {
+            if {$currExt eq $ext} {
                 return 1
             } 
 
@@ -140,7 +140,7 @@ proc pkg_mkIndex {args} {
     set oldDir [pwd]
     cd $dir
 
-    if {[catch {eval glob $patternList} fileList]} {
+    if {[catch {eval [linsert $patternList 0 glob --]} fileList]} {
 	global errorCode errorInfo
 	cd $oldDir
 	return -code error -errorcode $errorCode -errorinfo $errorInfo $fileList
@@ -151,7 +151,7 @@ proc pkg_mkIndex {args} {
 	# interpreter, and get a list of the new commands and packages
 	# that are defined.
 
-	if {[string equal $file "pkgIndex.tcl"]} {
+	if {$file eq "pkgIndex.tcl"} {
 	    continue
 	}
 
@@ -165,7 +165,7 @@ proc pkg_mkIndex {args} {
 	# Load into the child any packages currently loaded in the parent
 	# interpreter that match the -load pattern.
 
-	if {[string length $loadPat]} {
+	if {$loadPat ne ""} {
 	    if {$doVerbose} {
 		tclLog "currently loaded packages: '[info loaded]'"
 		tclLog "trying to load all packages matching $loadPat"
@@ -191,7 +191,7 @@ proc pkg_mkIndex {args} {
 	    } elseif {$doVerbose} {
 		tclLog "loaded [lindex $pkg 0] [lindex $pkg 1]"
 	    }
-	    if {[string equal [lindex $pkg 1] "Tk"]} {
+	    if {[lindex $pkg 1] eq "Tk"} {
 		# Withdraw . if Tk was loaded, to avoid showing a window.
 		$c eval [list wm withdraw .]
 	    }
@@ -206,7 +206,7 @@ proc pkg_mkIndex {args} {
 	    proc package {what args} {
 		switch -- $what {
 		    require { return ; # ignore transitive requires }
-		    default { eval __package_orig {$what} $args }
+		    default { uplevel 1 [linsert $args 0 __package_orig $what] }
 		}
 	    }
 	    proc tclPkgUnknown args {}
@@ -261,7 +261,8 @@ proc pkg_mkIndex {args} {
 		proc ::tcl::GetAllNamespaces {{root ::}} {
 		    set list $root
 		    foreach ns [namespace children $root] {
-			eval lappend list [::tcl::GetAllNamespaces $ns]
+			eval [linsert [::tcl::GetAllNamespaces $ns] 0 \
+				lappend list]
 		    }
 		    return $list
 		}
@@ -272,7 +273,7 @@ proc pkg_mkIndex {args} {
 		    set ::tcl::namespaces($::tcl::x) 1
 		}
 		foreach ::tcl::x [package names] {
-		    if {[string compare [package provide $::tcl::x] ""]} {
+		    if {[package provide $::tcl::x] ne ""} {
 			set ::tcl::packages($::tcl::x) 1
 		    }
 		}
@@ -320,7 +321,7 @@ proc pkg_mkIndex {args} {
 			    set ::tcl::newCmds($::tcl::x) 1
 			}
 			foreach ::tcl::x $::tcl::origCmds {
-			    catch {unset ::tcl::newCmds($::tcl::x)}
+			    unset -nocomplain ::tcl::newCmds($::tcl::x)
 			}
 			foreach ::tcl::x [array names ::tcl::newCmds] {
 			    # determine which namespace a command comes from
@@ -333,7 +334,7 @@ proc pkg_mkIndex {args} {
 			    set ::tcl::abs \
 				    [lindex [auto_qualify $::tcl::abs ::] 0]
 			    
-			    if {[string compare $::tcl::x $::tcl::abs]} {
+			    if {$::tcl::x ne $::tcl::abs} {
 				# Name changed during qualification
 				
 				set ::tcl::newCmds($::tcl::abs) 1
@@ -347,7 +348,7 @@ proc pkg_mkIndex {args} {
 		# a version provided, then record it
 
 		foreach ::tcl::x [package names] {
-		    if {[string compare [package provide $::tcl::x] ""] \
+		    if {[package provide $::tcl::x] ne ""
 			    && ![info exists ::tcl::packages($::tcl::x)]} {
 			lappend ::tcl::newPkgs \
 			    [list $::tcl::x [package provide $::tcl::x]]
@@ -447,7 +448,7 @@ proc tclPkgSetup {dir pkg version files} {
 	set f [lindex $fileInfo 0]
 	set type [lindex $fileInfo 1]
 	foreach cmd [lindex $fileInfo 2] {
-	    if {[string equal $type "load"]} {
+	    if {$type eq "load"} {
 		set auto_index($cmd) [list load [file join $dir $f] $pkg]
 	    } else {
 		set auto_index($cmd) [list source [file join $dir $f]]
@@ -595,7 +596,7 @@ proc tcl::MacOSXPkgUnknown {original name version {exact {}}} {
 	    }
 	}
 	set use_path [lrange $use_path 0 end-1]
-	if {[string compare $old_path $auto_path]} {
+	if {$old_path ne $auto_path} {
 	    foreach dir $auto_path {
 		lappend use_path $dir
 	    }
@@ -640,7 +641,7 @@ proc tcl::MacPkgUnknown {original name version {exact {}}} {
 		    if {[file isfile $x]} {
 			set res [resource open $x]
 			foreach y [resource list TEXT $res] {
-			    if {[string equal $y "pkgIndex"]} {source -rsrc pkgIndex}
+			    if {$y eq "pkgIndex"} {source -rsrc pkgIndex}
 			}
 			catch {resource close $res}
 		    }
@@ -649,7 +650,7 @@ proc tcl::MacPkgUnknown {original name version {exact {}}} {
 	    }
 	}
 	set use_path [lrange $use_path 0 end-1]
-	if {[string compare $old_path $auto_path]} {
+	if {$old_path ne $auto_path} {
 	    foreach dir $auto_path {
 		lappend use_path $dir
 	    }