* 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:

7 files changed, 124 insertions, 122 deletions

diff --git a/ChangeLog b/ChangeLog
index 1de88f6..8907845 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,12 @@
+2005-07-22  Don Porter  <dgp@users.sourceforge.net>
+
+	* 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:
+
 2005-07-07  Jeff Hobbs  <jeffh@ActiveState.com>
 
 	* unix/tcl.m4, unix/configure: Backported [Bug 1095909], removing
diff --git a/library/auto.tcl b/library/auto.tcl
index b02b77f..90f8b14 100644
--- a/library/auto.tcl
+++ b/library/auto.tcl
@@ -3,7 +3,7 @@
 # utility procs formerly in init.tcl dealing with auto execution
 # of commands and can be auto loaded themselves.
 #
-# RCS: @(#) $Id: auto.tcl,v 1.12.2.8 2005/06/27 18:20:26 dgp Exp $
+# RCS: @(#) $Id: auto.tcl,v 1.12.2.9 2005/07/22 21:59:39 dgp Exp $
 #
 # Copyright (c) 1991-1993 The Regents of the University of California.
 # Copyright (c) 1994-1998 Sun Microsystems, Inc.
@@ -33,9 +33,7 @@ proc auto_reset {} {
 	    rename $p {}
 	}
     }
-    catch {unset auto_execs}
-    catch {unset auto_index}
-    catch {unset auto_oldpath}
+    unset -nocomplain auto_execs auto_index auto_oldpath
 }
 
 # tcl_findLibrary --
@@ -61,8 +59,7 @@ proc tcl_findLibrary {basename version patch initScript enVarName varName} {
 
     # The C application may have hardwired a path, which we honor
 
-    set variableSet [info exists the_library]
-    if {$variableSet && $the_library ne ""} {
+    if {[info exists the_library] && $the_library ne ""} {
 	lappend dirs $the_library
     } else {
 
@@ -164,9 +161,7 @@ proc tcl_findLibrary {basename version patch initScript enVarName varName} {
             }
         }
     }
-    if {!$variableSet} {
-	unset the_library
-    }
+    unset -nocomplain the_library
     set msg "Can't find a usable $initScript in the following directories: \n"
     append msg "    $dirs\n\n"
     append msg "$errors\n\n"
@@ -219,12 +214,12 @@ proc auto_mkindex {dir args} {
     append index "# sets an element in the auto_index array, where the\n"
     append index "# element name is the name of a command and the value is\n"
     append index "# a script that loads the command.\n\n"
-    if {$args == ""} {
+    if {[llength $args] == 0} {
 	set args *.tcl
     }
 
     auto_mkindex_parser::init
-    foreach file [eval glob $args] {
+    foreach file [eval [linsert $args 0 glob --]] {
         if {[catch {auto_mkindex_parser::mkindex $file} msg] == 0} {
             append index $msg
         } else {
@@ -257,10 +252,10 @@ proc auto_mkindex_old {dir args} {
     append index "# sets an element in the auto_index array, where the\n"
     append index "# element name is the name of a command and the value is\n"
     append index "# a script that loads the command.\n\n"
-    if {[string equal $args ""]} {
+    if {[llength $args] == 0} {
 	set args *.tcl
     }
-    foreach file [eval glob $args] {
+    foreach file [eval [linsert $args 0 glob --]] {
 	set f ""
 	set error [catch {
 	    set f [open $file]
@@ -378,7 +373,7 @@ proc auto_mkindex_parser::mkindex {file} {
     # in case there were any $ in the proc name.  This will cause a problem
     # if somebody actually tries to have a \0 in their proc name.  Too bad
     # for them.
-    regsub -all {\$} $contents "\0" contents
+    set contents [string map "$ \u0000" $contents]
     
     set index ""
     set contextStack ""
@@ -456,12 +451,10 @@ proc auto_mkindex_parser::commandInit {name arglist body} {
 
     set ns [namespace qualifiers $name]
     set tail [namespace tail $name]
-    if {[string equal $ns ""]} {
-        set fakeName "[namespace current]::_%@fake_$tail"
+    if {$ns eq ""} {
+        set fakeName [namespace current]::_%@fake_$tail
     } else {
-        set fakeName "_%@fake_$name"
-        regsub -all {::} $fakeName "_" fakeName
-        set fakeName "[namespace current]::$fakeName"
+        set fakeName [namespace current]::[string map {:: _} _%@fake_$name]
     }
     proc $fakeName $arglist $body
 
@@ -470,7 +463,7 @@ proc auto_mkindex_parser::commandInit {name arglist body} {
     # we have to build procs with the fully qualified names, and
     # have the procs point to the aliases.
 
-    if {[regexp {::} $name]} {
+    if {[string match *::* $name]} {
         set exportCmd [list _%@namespace export [namespace tail $name]]
         $parser eval [list _%@namespace eval $ns $exportCmd]
  
@@ -520,7 +513,7 @@ proc auto_mkindex_parser::fullname {name} {
         }
     }
 
-    if {[string equal [namespace qualifiers $name] ""]} {
+    if {[namespace qualifiers $name] eq ""} {
         set name [namespace tail $name]
     } elseif {![string match ::* $name]} {
         set name "::$name"
@@ -528,8 +521,7 @@ proc auto_mkindex_parser::fullname {name} {
     
     # Earlier, mkindex replaced all $'s with \0.  Now, we have to reverse
     # that replacement.
-    regsub -all "\0" $name "\$" name
-    return $name
+    return [string map "\u0000 $" $name]
 }
 
 # Register all of the procedures for the auto_mkindex parser that
@@ -561,7 +553,7 @@ auto_mkindex_parser::command proc {name args} {
 
 auto_mkindex_parser::hook {
     if {![catch {package require tbcload}]} {
-	if {[llength [info commands tbcload::bcproc]] == 0} {
+	if {[namespace which -command tbcload::bcproc] ne ""} {
 	    auto_load tbcload::bcproc
 	}
 	load {} tbcload $auto_mkindex_parser::parser
@@ -612,7 +604,7 @@ auto_mkindex_parser::command namespace {op args} {
             variable parser
             variable imports
             foreach pattern $args {
-                if {[string compare $pattern "-force"]} {
+                if {$pattern ne "-force"} {
                     lappend imports $pattern
                 }
             }
diff --git a/library/history.tcl b/library/history.tcl
index d75c354..b8e27ce 100644
--- a/library/history.tcl
+++ b/library/history.tcl
@@ -2,7 +2,7 @@
 #
 # Implementation of the history command.
 #
-# RCS: @(#) $Id: history.tcl,v 1.5 2001/05/17 08:18:56 hobbs Exp $
+# RCS: @(#) $Id: history.tcl,v 1.5.14.1 2005/07/22 21:59:40 dgp Exp $
 #
 # Copyright (c) 1997 Sun Microsystems, Inc.
 #
@@ -168,14 +168,14 @@ proc history {args} {
     variable history
 
     # Do not add empty commands to the history
-    if {[string trim $command] == ""} {
+    if {[string trim $command] eq ""} {
 	return ""
     }
 
     set i [incr history(nextid)]
     set history($i) $command
     set j [incr history(oldest)]
-    if {[info exists history($j)]} {unset history($j)}
+    unset -nocomplain history($j)
     if {[string match e* $exec]} {
 	return [uplevel #0 $command]
     } else {
@@ -198,13 +198,13 @@ proc history {args} {
 
  proc tcl::HistKeep {{limit {}}} {
     variable history
-    if {[string length $limit] == 0} {
+    if {$limit eq ""} {
 	return $history(keep)
     } else {
 	set oldold $history(oldest)
 	set history(oldest) [expr {$history(nextid) - $limit}]
 	for {} {$oldold <= $history(oldest)} {incr oldold} {
-	    if {[info exists history($oldold)]} {unset history($oldold)}
+	    unset -nocomplain history($oldold)
 	}
 	set history(keep) $limit
     }
@@ -246,7 +246,7 @@ proc history {args} {
 
  proc tcl::HistInfo {{num {}}} {
     variable history
-    if {$num == {}} {
+    if {$num eq ""} {
 	set num [expr {$history(keep) + 1}]
     }
     set result {}
@@ -256,8 +256,7 @@ proc history {args} {
 	if {![info exists history($i)]} {
 	    continue
 	}
-	set cmd [string trimright $history($i) \ \n]
-	regsub -all \n $cmd "\n\t" cmd
+	set cmd [string map [list \n \n\t] [string trimright $history($i) \ \n]]
 	append result $newline[format "%6d  %s" $i $cmd]
 	set newline \n
     }
@@ -281,7 +280,7 @@ proc history {args} {
 
  proc tcl::HistRedo {{event -1}} {
     variable history
-    if {[string length $event] == 0} {
+    if {$event eq ""} {
 	set event -1
     }
     set i [HistIndex $event]
diff --git a/library/init.tcl b/library/init.tcl
index ea1cd85..8105642 100644
--- a/library/init.tcl
+++ b/library/init.tcl
@@ -3,7 +3,7 @@
 # Default system startup file for Tcl-based applications.  Defines
 # "unknown" procedure and auto-load facilities.
 #
-# RCS: @(#) $Id: init.tcl,v 1.55.2.5 2005/04/28 05:34:40 dgp Exp $
+# RCS: @(#) $Id: init.tcl,v 1.55.2.6 2005/07/22 21:59:40 dgp Exp $
 #
 # Copyright (c) 1991-1993 The Regents of the University of California.
 # Copyright (c) 1994-1996 Sun Microsystems, Inc.
@@ -48,7 +48,7 @@ if {![info exists auto_path]} {
 }
 namespace eval tcl {
     variable Dir
-    if {[info library] != ""} {
+    if {[info library] ne ""} {
 	foreach Dir [list [info library] [file dirname [info library]]] {
 	    if {[lsearch -exact $::auto_path $Dir] < 0} {
 		lappend ::auto_path $Dir
@@ -71,7 +71,7 @@ namespace eval tcl {
   
 # Windows specific end of initialization
 
-if {(![interp issafe]) && [string equal $tcl_platform(platform) "windows"]} {
+if {(![interp issafe]) && $tcl_platform(platform) eq "windows"} {
     namespace eval tcl {
 	proc EnvTraceProc {lo n1 n2 op} {
 	    set x $::env($n2)
@@ -82,23 +82,23 @@ if {(![interp issafe]) && [string equal $tcl_platform(platform) "windows"]} {
 	    global env tcl_platform
 	    foreach p [array names env] {
 		set u [string toupper $p]
-		if {![string equal $u $p]} {
+		if {$u ne $p} {
 		    switch -- $u {
 			COMSPEC -
 			PATH {
 			    if {![info exists env($u)]} {
 				set env($u) $env($p)
 			    }
-			    trace variable env($p) w \
+			    trace add variable env($p) write \
 				    [namespace code [list EnvTraceProc $p]]
-			    trace variable env($u) w \
+			    trace add variable env($u) write \
 				    [namespace code [list EnvTraceProc $p]]
 			}
 		    }
 		}
 	    }
 	    if {![info exists env(COMSPEC)]} {
-		if {[string equal $tcl_platform(os) "Windows NT"]} {
+		if {$tcl_platform(os) eq "Windows NT"} {
 		    set env(COMSPEC) cmd.exe
 		} else {
 		    set env(COMSPEC) command.com
@@ -115,18 +115,18 @@ package unknown tclPkgUnknown
 
 if {![interp issafe]} {
     # setup platform specific unknown package handlers
-    if {[string equal $::tcl_platform(platform) "unix"] && \
-	    [string equal $::tcl_platform(os) "Darwin"]} {
+    if {$::tcl_platform(platform) eq "unix"
+	    && $::tcl_platform(os) eq "Darwin"} {
 	package unknown [list tcl::MacOSXPkgUnknown [package unknown]]
     }
-    if {[string equal $::tcl_platform(platform) "macintosh"]} {
+    if {$::tcl_platform(platform) eq "macintosh"} {
 	package unknown [list tcl::MacPkgUnknown [package unknown]]
     }
 }
 
 # Conditionalize for presence of exec.
 
-if {[llength [info commands exec]] == 0} {
+if {[namespace which -command exec] eq ""} {
 
     # Some machines, such as the Macintosh, do not have exec. Also, on all
     # platforms, safe interpreters do not have exec.
@@ -139,7 +139,7 @@ set errorInfo ""
 # Define a log command (which can be overwitten to log errors
 # differently, specially when stderr is not available)
 
-if {[llength [info commands tclLog]] == 0} {
+if {[namespace which -command tclLog] eq ""} {
     proc tclLog {string} {
 	catch {puts stderr $string}
     }
@@ -199,7 +199,7 @@ proc unknown args {
     }
     set savedErrorCode $errorCode
     set savedErrorInfo $errorInfo
-    set name [lindex $args 0]
+    set name $cmd
     if {![info exists auto_noload]} {
 	#
 	# Make sure we're not trying to load the same proc twice.
@@ -273,15 +273,15 @@ proc unknown args {
 	}
     }
 
-    if {([info level] == 1) && [string equal [info script] ""] \
+    if {([info level] == 1) && [info script] eq "" \
 	    && [info exists tcl_interactive] && $tcl_interactive} {
 	if {![info exists auto_noexec]} {
 	    set new [auto_execok $name]
-	    if {$new != ""} {
+	    if {$new ne ""} {
 		set errorCode $savedErrorCode
 		set errorInfo $savedErrorInfo
 		set redir ""
-		if {[string equal [info commands console] ""]} {
+		if {[namespace which -command console] eq ""} {
 		    set redir ">&@stdout <@stdin"
 		}
 		return [uplevel 1 exec $redir $new [lrange $args 1 end]]
@@ -289,11 +289,11 @@ proc unknown args {
 	}
 	set errorCode $savedErrorCode
 	set errorInfo $savedErrorInfo
-	if {[string equal $name "!!"]} {
+	if {$name eq "!!"} {
 	    set newcmd [history event]
-	} elseif {[regexp {^!(.+)$} $name dummy event]} {
+	} elseif {[regexp {^!(.+)$} $name -> event]} {
 	    set newcmd [history event $event]
-	} elseif {[regexp {^\^([^^]*)\^([^^]*)\^?$} $name dummy old new]} {
+	} elseif {[regexp {^\^([^^]*)\^([^^]*)\^?$} $name -> old new]} {
 	    set newcmd [history event -1]
 	    catch {regsub -all -- $old $newcmd $new newcmd}
 	}
@@ -304,7 +304,7 @@ proc unknown args {
 	}
 
 	set ret [catch {set candidates [info commands $name*]} msg]
-	if {[string equal $name "::"]} {
+	if {$name eq "::"} {
 	    set name ""
 	}
 	if {$ret != 0} {
@@ -312,11 +312,18 @@ proc unknown args {
 		"error in unknown while checking if \"$name\" is\
 		a unique command abbreviation:\n$msg"
 	}
+	# Handle empty $name separately due to strangeness in [string first]
+	if {$name eq ""} {
+	    if {[llength $candidates] != 1} {
+		return -code error "empty command name \"\""
+	    }
+	    return [uplevel 1 [lreplace $args 0 0 [lindex $candidates 0]]]
+	}
 	# Filter out bogus matches when $name contained
 	# a glob-special char [Bug 946952]
 	set cmds [list]
 	foreach x $candidates {
-	    if {[string range $x 0 [expr [string length $name]-1]] eq $name} {
+	    if {[string first $name $x] == 0} {
 		lappend cmds $x
 	    }
 	}
@@ -324,12 +331,7 @@ proc unknown args {
 	    return [uplevel 1 [lreplace $args 0 0 [lindex $cmds 0]]]
 	}
 	if {[llength $cmds]} {
-	    if {[string equal $name ""]} {
-		return -code error "empty command name \"\""
-	    } else {
-		return -code error \
-			"ambiguous command name \"$name\": [lsort $cmds]"
-	    }
+	    return -code error "ambiguous command name \"$name\": [lsort $cmds]"
 	}
     }
     return -code error "invalid command name \"$name\""
@@ -350,7 +352,7 @@ proc unknown args {
 proc auto_load {cmd {namespace {}}} {
     global auto_index auto_oldpath auto_path
 
-    if {[string length $namespace] == 0} {
+    if {$namespace eq ""} {
 	set namespace [uplevel 1 [list ::namespace current]]
     }
     set nameList [auto_qualify $cmd $namespace]
@@ -402,8 +404,7 @@ proc auto_load {cmd {namespace {}}} {
 proc auto_load_index {} {
     global auto_index auto_oldpath auto_path errorInfo errorCode
 
-    if {[info exists auto_oldpath] && \
-	    [string equal $auto_oldpath $auto_path]} {
+    if {[info exists auto_oldpath] && $auto_oldpath eq $auto_path} {
 	return 0
     }
     set auto_oldpath $auto_path
@@ -422,12 +423,11 @@ proc auto_load_index {} {
 	} else {
 	    set error [catch {
 		set id [gets $f]
-		if {[string equal $id \
-			"# Tcl autoload index file, version 2.0"]} {
+		if {$id eq "# Tcl autoload index file, version 2.0"} {
 		    eval [read $f]
-		} elseif {[string equal $id "# Tcl autoload index file: each line identifies a Tcl"]} {
+		} elseif {$id eq "# Tcl autoload index file: each line identifies a Tcl"} {
 		    while {[gets $f line] >= 0} {
-			if {[string equal [string index $line 0] "#"] \
+			if {[string index $line 0] eq "#" 
 				|| ([llength $line] != 2)} {
 			    continue
 			}
@@ -439,7 +439,7 @@ proc auto_load_index {} {
 		    error "[file join $dir tclIndex] isn't a proper Tcl index file"
 		}
 	    } msg]
-	    if {$f != ""} {
+	    if {$f ne ""} {
 		close $f
 	    }
 	    if {$error} {
@@ -478,13 +478,13 @@ proc auto_qualify {cmd namespace} {
     # with the following form :
     # ( inputCmd, inputNameSpace) -> output
 
-    if {[regexp {^::(.*)$} $cmd x tail]} {
+    if {[string match ::* $cmd]} {
 	if {$n > 1} {
 	    # ( ::foo::bar , * ) -> ::foo::bar
 	    return [list $cmd]
 	} else {
 	    # ( ::global , * ) -> global
-	    return [list $tail]
+	    return [list [string range $cmd 2 end]]
 	}
     }
     
@@ -492,14 +492,14 @@ proc auto_qualify {cmd namespace} {
     # (if the current namespace is not the global one)
 
     if {$n == 0} {
-	if {[string equal $namespace ::]} {
+	if {$namespace eq "::"} {
 	    # ( nocolons , :: ) -> nocolons
 	    return [list $cmd]
 	} else {
 	    # ( nocolons , ::sub ) -> ::sub::nocolons nocolons
 	    return [list ${namespace}::$cmd $cmd]
 	}
-    } elseif {[string equal $namespace ::]} {
+    } elseif {$namespace eq "::"} {
 	#  ( foo::bar , :: ) -> ::foo::bar
 	return [list ::$cmd]
     } else {
@@ -554,7 +554,7 @@ proc auto_import {pattern} {
 # Arguments: 
 # name -			Name of a command.
 
-if {[string equal windows $tcl_platform(platform)]} {
+if {$tcl_platform(platform) eq "windows"} {
 # Windows version.
 #
 # Note that info executable doesn't work under Windows, so we have to
@@ -572,7 +572,7 @@ proc auto_execok name {
 
     set shellBuiltins [list cls copy date del erase dir echo mkdir \
 	    md rename ren rmdir rd time type ver vol]
-    if {[string equal $tcl_platform(os) "Windows NT"]} {
+    if {$tcl_platform(os) eq "Windows NT"} {
 	# NT includes the 'start' built-in
 	lappend shellBuiltins "start"
     }
@@ -609,7 +609,7 @@ proc auto_execok name {
 	set windir $env(WINDIR) 
     }
     if {[info exists windir]} {
-	if {[string equal $tcl_platform(os) "Windows NT"]} {
+	if {$tcl_platform(os) eq "Windows NT"} {
 	    append path "$windir/system32;"
 	}
 	append path "$windir/system;$windir;"
@@ -623,7 +623,7 @@ proc auto_execok name {
 
     foreach dir [split $path {;}] {
 	# Skip already checked directories
-	if {[info exists checked($dir)] || [string equal {} $dir]} { continue }
+	if {[info exists checked($dir)] || $dir eq {}} { continue }
 	set checked($dir) {}
 	foreach ext $execExtensions {
 	    set file [file join $dir ${name}${ext}]
@@ -652,7 +652,7 @@ proc auto_execok name {
 	return $auto_execs($name)
     }
     foreach dir [split $env(PATH) :] {
-	if {[string equal $dir ""]} {
+	if {$dir eq ""} {
 	    set dir .
 	}
 	set file [file join $dir $name]
@@ -683,7 +683,7 @@ proc auto_execok name {
 proc tcl::CopyDirectory {action src dest} {
     set nsrc [file normalize $src]
     set ndest [file normalize $dest]
-    if {[string equal $action "renaming"]} {
+    if {$action eq "renaming"} {
 	# Can't rename volumes.  We could give a more precise
 	# error message here, but that would break the test suite.
 	if {[lsearch -exact [file volumes] $nsrc] != -1} {
@@ -693,12 +693,12 @@ proc tcl::CopyDirectory {action src dest} {
 	}
     }
     if {[file exists $dest]} {
-	if {$nsrc == $ndest} {
+	if {$nsrc eq $ndest} {
 	    return -code error "error $action \"$src\" to\
 	      \"$dest\": trying to rename a volume or move a directory\
 	      into itself"
 	}
-	if {[string equal $action "copying"]} {
+	if {$action eq "copying"} {
 	    return -code error "error $action \"$src\" to\
 	      \"$dest\": file already exists"
 	} else {
@@ -707,10 +707,11 @@ proc tcl::CopyDirectory {action src dest} {
 	    # can be returned in various combinations.  Anyway,
 	    # if any other file is returned, we must signal an error.
 	    set existing [glob -nocomplain -directory $dest * .*]
-	    eval [list lappend existing] \
-	      [glob -nocomplain -directory $dest -type hidden * .*]
+	    eval [linsert \
+		    [glob -nocomplain -directory $dest -type hidden * .*] 0 \
+		    lappend existing]
 	    foreach s $existing {
-		if {([file tail $s] != ".") && ([file tail $s] != "..")} {
+		if {([file tail $s] ne ".") && ([file tail $s] ne "..")} {
 		    return -code error "error $action \"$src\" to\
 		      \"$dest\": file already exists"
 		}
@@ -720,7 +721,7 @@ proc tcl::CopyDirectory {action src dest} {
 	if {[string first $nsrc $ndest] != -1} {
 	    set srclen [expr {[llength [file split $nsrc]] -1}]
 	    set ndest [lindex [file split $ndest] $srclen]
-	    if {$ndest == [file tail $nsrc]} {
+	    if {$ndest eq [file tail $nsrc]} {
 		return -code error "error $action \"$src\" to\
 		  \"$dest\": trying to rename a volume or move a directory\
 		  into itself"
@@ -738,7 +739,7 @@ proc tcl::CopyDirectory {action src dest} {
       [glob -nocomplain -directory $src -types hidden *]]
     
     foreach s [lsort -unique $filelist] {
-	if {([file tail $s] != ".") && ([file tail $s] != "..")} {
+	if {([file tail $s] ne ".") && ([file tail $s] ne "..")} {
 	    file copy $s [file join $dest [file tail $s]]
 	}
     }
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
 	    }
diff --git a/library/safe.tcl b/library/safe.tcl
index f34fea2..9c8aff5 100644
--- a/library/safe.tcl
+++ b/library/safe.tcl
@@ -12,7 +12,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: safe.tcl,v 1.9.2.2 2004/06/29 09:39:01 dkf Exp $
+# RCS: @(#) $Id: safe.tcl,v 1.9.2.3 2005/07/22 21:59:41 dgp Exp $
 
 #
 # The implementation is based on namespaces. These naming conventions
@@ -77,7 +77,7 @@ namespace eval ::safe {
 	    upvar $v $v
 	}
 	set flag [::tcl::OptProcArgGiven -noStatics];
-	if {$flag && ($noStatics == $statics) 
+	if {$flag && (!$noStatics == !$statics) 
 	          && ([::tcl::OptProcArgGiven -statics])} {
 	    return -code error\
 		    "conflicting values given for -statics and -noStatics"
@@ -98,7 +98,7 @@ namespace eval ::safe {
 	set flag [::tcl::OptProcArgGiven -nestedLoadOk];
 	# note that the test here is the opposite of the "InterpStatics"
 	# one (it is not -noNested... because of the wanted default value)
-	if {$flag && ($nestedLoadOk != $nested) 
+	if {$flag && (!$nestedLoadOk != !$nested) 
 	          && ([::tcl::OptProcArgGiven -nested])} {
 	    return -code error\
 		    "conflicting values given for -nested and -nestedLoadOk"
@@ -324,7 +324,7 @@ namespace eval ::safe {
 	    nestedok deletehook} {
 
 	# determine and store the access path if empty
-	if {[string equal "" $access_path]} {
+	if {$access_path eq ""} {
 	    set access_path [uplevel \#0 set auto_path]
 	    # Make sure that tcl_library is in auto_path
 	    # and at the first position (needed by setAccessPath)
@@ -640,15 +640,15 @@ proc ::safe::setLogCmd {args} {
     }
     # set/get values
     proc Set {args} {
-	eval [list Toplevel set] $args
+	eval [linsert $args 0 Toplevel set]
     }
     # lappend on toplevel vars
     proc Lappend {args} {
-	eval [list Toplevel lappend] $args
+	eval [linsert $args 0 Toplevel lappend]
     }
     # unset a var/token (currently just an global level eval)
     proc Unset {args} {
-	eval [list Toplevel unset] $args
+	eval [linsert $args 0 Toplevel unset]
     }
     # test existance 
     proc Exists {varname} {
@@ -778,7 +778,7 @@ proc ::safe::setLogCmd {args} {
 	# Determine where to load. load use a relative interp path
 	# and {} means self, so we can directly and safely use passed arg.
 	set target [lindex $args 1]
-	if {[string length $target]} {
+	if {$target ne ""} {
 	    # we will try to load into a sub sub interp
 	    # check that we want to authorize that.
 	    if {![NestedOk $slave]} {
@@ -790,9 +790,9 @@ proc ::safe::setLogCmd {args} {
 	}
 
 	# Determine what kind of load is requested
-	if {[string length $file] == 0} {
+	if {$file eq ""} {
 	    # static package loading
-	    if {[string length $package] == 0} {
+	    if {$package eq ""} {
 		set msg "load error: empty filename and no package name"
 		Log $slave $msg
 		return -code error $msg
@@ -860,7 +860,7 @@ proc ::safe::setLogCmd {args} {
     proc Subset {slave command okpat args} {
 	set subcommand [lindex $args 0]
 	if {[regexp $okpat $subcommand]} {
-	    return [eval [list $command $subcommand] [lrange $args 1 end]]
+	    return [eval [linsert $args 0 $command]]
 	}
 	set msg "not allowed to invoke subcommand $subcommand of $command"
 	Log $slave $msg
@@ -895,11 +895,11 @@ proc ::safe::setLogCmd {args} {
 	set subcommand [lindex $args 0]
 
 	if {[regexp $okpat $subcommand]} {
-	    return [eval ::interp invokehidden $slave encoding $subcommand \
-		    [lrange $args 1 end]]
+	    return [eval [linsert $args 0 \
+		    ::interp invokehidden $slave encoding]]
 	}
 
-	if {[string match $subcommand system]} {
+	if {[string first $subcommand system] == 0} {
 	    if {$argc == 1} {
 		# passed all the tests , lets source it:
 		if {[catch {::interp invokehidden \
diff --git a/library/word.tcl b/library/word.tcl
index edcb93a..c18c961 100644
--- a/library/word.tcl
+++ b/library/word.tcl
@@ -10,12 +10,12 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 # 
-# RCS: @(#) $Id: word.tcl,v 1.7 2002/11/01 00:28:51 andreas_kupries Exp $
+# RCS: @(#) $Id: word.tcl,v 1.7.2.1 2005/07/22 21:59:41 dgp Exp $
 
 # The following variables are used to determine which characters are
 # interpreted as white space.  
 
-if {[string equal $::tcl_platform(platform) "windows"]} {
+if {$::tcl_platform(platform) eq "windows"} {
     # Windows style - any but a unicode space char
     set tcl_wordchars "\\S"
     set tcl_nonwordchars "\\s"
@@ -58,7 +58,7 @@ proc tcl_wordBreakAfter {str start} {
 
 proc tcl_wordBreakBefore {str start} {
     global tcl_nonwordchars tcl_wordchars
-    if {[string equal $start end]} {
+    if {$start eq "end"} {
 	set start [string length $str]
     }
     if {[regexp -indices "^.*($tcl_wordchars$tcl_nonwordchars|$tcl_nonwordchars$tcl_wordchars)" [string range $str 0 $start] result]} {
@@ -120,7 +120,7 @@ proc tcl_startOfNextWord {str start} {
 
 proc tcl_startOfPreviousWord {str start} {
     global tcl_nonwordchars tcl_wordchars
-    if {[string equal $start end]} {
+    if {$start eq "end"} {
 	set start [string length $str]
     }
     if {[regexp -indices \