diff options
| -rw-r--r-- | ChangeLog | 7 | ||||
| -rw-r--r-- | library/init.tcl | 14 |
2 files changed, 14 insertions, 7 deletions
@@ -1,3 +1,10 @@ +2000-11-23 Donal K. Fellows <fellowsd@cs.man.ac.uk> + + * library/init.tcl (unknown): Added specific level parameters to + all uplevel invokations to boost performance; didn't dare touch + the "namespace inscope" stuff though, since it looks sensitive + to me! Should fix Bug #123217, though testing is tricky... + 2000-11-21 Andreas Kupries <a.kupries@westend.com> * All of the changes below are described in TIP #7 ~ Specification diff --git a/library/init.tcl b/library/init.tcl index ad0d697..426d651 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.41 2000/05/18 21:37:19 hobbs Exp $ +# RCS: @(#) $Id: init.tcl,v 1.42 2000/11/23 14:21:59 dkf Exp $ # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. @@ -165,7 +165,7 @@ proc unknown args { set cmd [lindex $args 0] if {[regexp "^namespace\[ \t\n\]+inscope" $cmd] && [llength $cmd] == 4} { set arglist [lrange $args 1 end] - set ret [catch {uplevel $cmd $arglist} result] + set ret [catch {uplevel 1 $cmd $arglist} result] if {$ret == 0} { return $result } else { @@ -228,7 +228,7 @@ proc unknown args { if {[string equal [info commands console] ""]} { set redir ">&@stdout <@stdin" } - return [uplevel exec $redir $new [lrange $args 1 end]] + return [uplevel 1 exec $redir $new [lrange $args 1 end]] } } set errorCode $savedErrorCode @@ -244,7 +244,7 @@ proc unknown args { if {[info exists newcmd]} { tclLog $newcmd history change $newcmd 0 - return [uplevel $newcmd] + return [uplevel 1 $newcmd] } set ret [catch {set cmds [info commands $name*]} msg] @@ -256,7 +256,7 @@ proc unknown args { "error in unknown while checking if \"$name\" is a unique command abbreviation: $msg" } if {[llength $cmds] == 1} { - return [uplevel [lreplace $args 0 0 $cmds]] + return [uplevel 1 [lreplace $args 0 0 $cmds]] } if {[llength $cmds]} { if {[string equal $name ""]} { @@ -286,7 +286,7 @@ proc auto_load {cmd {namespace {}}} { global auto_index auto_oldpath auto_path if {[string length $namespace] == 0} { - set namespace [uplevel {namespace current}] + set namespace [uplevel 1 [list namespace current]] } set nameList [auto_qualify $cmd $namespace] # workaround non canonical auto_index entries that might be around @@ -461,7 +461,7 @@ proc auto_import {pattern} { return } - set ns [uplevel namespace current] + set ns [uplevel 1 [list namespace current]] set patternList [auto_qualify $pattern $ns] auto_load_index |