diff options
Diffstat (limited to 'library/init.tcl')
| -rw-r--r-- | library/init.tcl | 98 |
1 files changed, 43 insertions, 55 deletions
diff --git a/library/init.tcl b/library/init.tcl index aaf148b..6173b86 100644 --- a/library/init.tcl +++ b/library/init.tcl @@ -16,7 +16,7 @@ if {[info commands package] == ""} { error "version mismatch: library\nscripts expect Tcl version 7.5b1 or later but the loaded version is\nonly [info patchlevel]" } -package require -exact Tcl 8.5.19 +package require -exact Tcl 8.6.6 # Compute the auto path to use in this interpreter. # The values on the path come from several locations: @@ -142,11 +142,7 @@ if {(![interp issafe]) && ($tcl_platform(platform) eq "windows")} { } } if {![info exists env(COMSPEC)]} { - if {$tcl_platform(os) eq "Windows NT"} { - set env(COMSPEC) cmd.exe - } else { - set env(COMSPEC) command.com - } + set env(COMSPEC) cmd.exe } } InitWinEnv @@ -173,13 +169,7 @@ if {[interp issafe]} { namespace eval ::tcl::clock [list variable TclLibDir $::tcl_library] - proc clock args { - namespace eval ::tcl::clock [list namespace ensemble create -command \ - [uplevel 1 [list namespace origin [lindex [info level 0] 0]]] \ - -subcommands { - add clicks format microseconds milliseconds scan seconds - }] - + proc ::tcl::initClock {} { # Auto-loading stubs for 'clock.tcl' foreach cmd {add format scan} { @@ -190,8 +180,9 @@ if {[interp issafe]} { } } - return [uplevel 1 [info level 0]] + rename ::tcl::initClock {} } + ::tcl::initClock } # Conditionalize for presence of exec. @@ -218,11 +209,9 @@ if {[namespace which -command tclLog] eq ""} { # exist in the interpreter. It takes the following steps to make the # command available: # -# 1. See if the command has the form "namespace inscope ns cmd" and -# if so, concatenate its arguments onto the end and evaluate it. -# 2. See if the autoload facility can locate the command in a +# 1. See if the autoload facility can locate the command in a # Tcl script file. If so, load it and execute it. -# 3. If the command was invoked interactively at top-level: +# 2. If the command was invoked interactively at top-level: # (a) see if the command exists as an executable UNIX program. # If so, "exec" the command. # (b) see if the command requests csh-like history substitution @@ -239,22 +228,14 @@ proc unknown args { variable ::tcl::UnknownPending 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. - - set cmd [lindex $args 0] - if {[regexp "^:*namespace\[ \t\n\]+inscope" $cmd] && [llength $cmd] == 4} { - #return -code error "You need an {*}" - set arglist [lrange $args 1 end] - set ret [catch {uplevel 1 ::$cmd $arglist} result opts] - dict unset opts -errorinfo - dict incr opts -level - return -options $opts $result + if {[info exists errorInfo]} { + set savedErrorInfo $errorInfo + } + if {[info exists errorCode]} { + set savedErrorCode $errorCode } - catch {set savedErrorInfo $errorInfo} - catch {set savedErrorCode $errorCode} - set name $cmd + set name [lindex $args 0] if {![info exists auto_noload]} { # # Make sure we're not trying to load the same proc twice. @@ -303,14 +284,9 @@ proc unknown args { } append cinfo ... } - append cinfo "\"\n (\"uplevel\" body line 1)" - append cinfo "\n invoked from within" - append cinfo "\n\"uplevel 1 \$args\"" - # - # Try each possible form of the stack trace - # and trim the extra contribution from the matching case - # - set expect "$msg\n while executing\n\"$cinfo" + set tail "\n (\"uplevel\" body line 1)\n invoked\ + from within\n\"uplevel 1 \$args\"" + set expect "$msg\n while executing\n\"$cinfo\"$tail" if {$errInfo eq $expect} { # # The stack has only the eval from the expanded command @@ -324,21 +300,32 @@ proc unknown args { # Stack trace is nested, trim off just the contribution # from the extra "eval" of $args due to the "catch" above. # - set expect "\n invoked from within\n\"$cinfo" - set exlen [string length $expect] - set eilen [string length $errInfo] - set i [expr {$eilen - $exlen - 1}] - set einfo [string range $errInfo 0 $i] - # - # For now verify that $errInfo consists of what we are about - # to return plus what we expected to trim off. - # - if {$errInfo ne "$einfo$expect"} { - error "Tcl bug: unexpected stack trace in \"unknown\"" {} \ - [list CORE UNKNOWN BADTRACE $einfo $expect $errInfo] + set last [string last $tail $errInfo] + if {$last + [string length $tail] != [string length $errInfo]} { + # Very likely cannot happen + return -options $opts $msg + } + set errInfo [string range $errInfo 0 $last-1] + set tail "\"$cinfo\"" + set last [string last $tail $errInfo] + if {$last + [string length $tail] != [string length $errInfo]} { + return -code error -errorcode $errCode \ + -errorinfo $errInfo $msg } - return -code error -errorcode $errCode \ - -errorinfo $einfo $msg + set errInfo [string range $errInfo 0 $last-1] + set tail "\n invoked from within\n" + set last [string last $tail $errInfo] + if {$last + [string length $tail] == [string length $errInfo]} { + return -code error -errorcode $errCode \ + -errorinfo [string range $errInfo 0 $last-1] $msg + } + set tail "\n while executing\n" + set last [string last $tail $errInfo] + if {$last + [string length $tail] == [string length $errInfo]} { + return -code error -errorcode $errCode \ + -errorinfo [string range $errInfo 0 $last-1] $msg + } + return -options $opts $msg } else { dict incr opts -level return -options $opts $msg @@ -412,7 +399,8 @@ proc unknown args { return -code error "ambiguous command name \"$name\": [lsort $cmds]" } } - return -code error "invalid command name \"$name\"" + return -code error -errorcode [list TCL LOOKUP COMMAND $name] \ + "invalid command name \"$name\"" } # auto_load -- |