diff options
author | jan.nijtmans <nijtmans@users.sourceforge.net> | 2017-06-02 08:12:38 (GMT) |
---|---|---|
committer | jan.nijtmans <nijtmans@users.sourceforge.net> | 2017-06-02 08:12:38 (GMT) |
commit | 21dfa74b037c4630be374887a1579c078fd99193 (patch) | |
tree | 1601cdbe0f43c015bfcb743565108c36f488e67b /library/init.tcl | |
parent | 3f0e8d6265db0d5853ab55de2ead9a045c678b6e (diff) | |
parent | 9220ca224bafcb35a09f48838501d36ab69762e9 (diff) | |
download | tcl-21dfa74b037c4630be374887a1579c078fd99193.zip tcl-21dfa74b037c4630be374887a1579c078fd99193.tar.gz tcl-21dfa74b037c4630be374887a1579c078fd99193.tar.bz2 |
Merge core-8-6-branch. This removes the work currently being done in "sebres-8-6-clock-speedup-cr1" branch, but that will be merged again as soon as the work is done.
All other changes in "trunk" since then (e.g. the INST_STR_CONCAT1 performance improvement, and the removal of SunOS-4) are retained.
Diffstat (limited to 'library/init.tcl')
-rw-r--r-- | library/init.tcl | 96 |
1 files changed, 36 insertions, 60 deletions
diff --git a/library/init.tcl b/library/init.tcl index dba73b0..5cedd14 100644 --- a/library/init.tcl +++ b/library/init.tcl @@ -45,7 +45,6 @@ if {![info exists auto_path]} { set auto_path "" } } - namespace eval tcl { variable Dir foreach Dir [list $::tcl_library [file dirname $::tcl_library]] { @@ -67,12 +66,12 @@ namespace eval tcl { } if {![interp issafe]} { - variable Path [encoding dirs] - set Dir [file join $::tcl_library encoding] - if {$Dir ni $Path} { + variable Path [encoding dirs] + set Dir [file join $::tcl_library encoding] + if {$Dir ni $Path} { lappend Path $Dir encoding dirs $Path - } + } } # TIP #255 min and max functions @@ -158,17 +157,6 @@ if {(![interp issafe]) && ($tcl_platform(platform) eq "windows")} { if {[interp issafe]} { package unknown {::tcl::tm::UnknownHandler ::tclPkgUnknown} } else { - # Default known auto_index (avoid loading auto index implicit after interp create): - - array set ::auto_index { - ::tcl::tm::UnknownHandler {source [info library]/tm.tcl} - ::tclPkgUnknown {source [info library]/package.tcl} - ::history {source [info library]/history.tcl} - } - - # The newest possibility to load whole namespace: - array set ::auto_index_ns {} - # Set up search for Tcl Modules (TIP #189). # and setup platform specific unknown package handlers if {$tcl_platform(os) eq "Darwin" @@ -181,21 +169,22 @@ if {[interp issafe]} { # Set up the 'clock' ensemble - proc clock args { - set cmdmap [dict create] - foreach cmd {add clicks format microseconds milliseconds scan seconds configure} { - dict set cmdmap $cmd ::tcl::clock::$cmd + namespace eval ::tcl::clock [list variable TclLibDir $::tcl_library] + + proc ::tcl::initClock {} { + # Auto-loading stubs for 'clock.tcl' + + foreach cmd {add format scan} { + proc ::tcl::clock::$cmd args { + variable TclLibDir + source -encoding utf-8 [file join $TclLibDir clock.tcl] + return [uplevel 1 [info level 0]] + } } - namespace inscope ::tcl::clock [list namespace ensemble create -command \ - [uplevel 1 [list ::namespace origin [::lindex [info level 0] 0]]] \ - -map $cmdmap -compile 1] - uplevel 1 [info level 0] + rename ::tcl::initClock {} } - # Auto-loading stubs for 'clock.tcl' - set ::auto_index_ns(::tcl::clock) {::namespace inscope ::tcl::clock { - ::source -encoding utf-8 [::file join [info library] clock.tcl] - }} + ::tcl::initClock } # Conditionalize for presence of exec. @@ -423,22 +412,18 @@ proc unknown args { # for instance. If not given, namespace current is used. proc auto_load {cmd {namespace {}}} { - global auto_index auto_index_ns auto_path + global auto_index auto_path - # qualify names: if {$namespace eq ""} { set namespace [uplevel 1 [list ::namespace current]] } set nameList [auto_qualify $cmd $namespace] # workaround non canonical auto_index entries that might be around # from older auto_mkindex versions - if {$cmd ni $nameList} {lappend nameList $cmd} - - # try to load (and create sub-cmd handler "_sub_load_cmd" for further usage): - foreach name $nameList [set _sub_load_cmd { - # via auto_index: + lappend nameList $cmd + foreach name $nameList { if {[info exists auto_index($name)]} { - namespace inscope :: $auto_index($name) + namespace eval :: $auto_index($name) # There's a couple of ways to look for a command of a given # name. One is to use # info commands $name @@ -450,31 +435,22 @@ proc auto_load {cmd {namespace {}}} { return 1 } } - # via auto_index_ns - resolver for the whole namespace loaders - if {[set ns [::namespace qualifiers $name]] ni {"" "::"} && - [info exists auto_index_ns($ns)] - } { - # remove handler before loading (prevents several self-recursion cases): - set ldr $auto_index_ns($ns); unset auto_index_ns($ns) - namespace inscope :: $ldr - # if got it: - if {[namespace which -command $name] ne ""} { - return 1 - } - } - }] - - # load auto_index if possible: + } if {![info exists auto_path]} { return 0 } + if {![auto_load_index]} { return 0 } - - # try again (something new could be loaded): - foreach name $nameList $_sub_load_cmd - + foreach name $nameList { + if {[info exists auto_index($name)]} { + namespace eval :: $auto_index($name) + if {[namespace which -command $name] ne ""} { + return 1 + } + } + } return 0 } @@ -637,12 +613,12 @@ proc auto_import {pattern} { auto_load_index foreach pattern $patternList { - foreach name [array names auto_index $pattern] { - if {([namespace which -command $name] eq "") + foreach name [array names auto_index $pattern] { + if {([namespace which -command $name] eq "") && ([namespace qualifiers $pattern] eq [namespace qualifiers $name])} { - namespace inscope :: $auto_index($name) - } - } + namespace eval :: $auto_index($name) + } + } } } |