diff options
Diffstat (limited to 'library/auto.tcl')
| -rw-r--r-- | library/auto.tcl | 99 |
1 files changed, 69 insertions, 30 deletions
diff --git a/library/auto.tcl b/library/auto.tcl index 4bd860d..02edcc4 100644 --- a/library/auto.tcl +++ b/library/auto.tcl @@ -20,8 +20,9 @@ # None. proc auto_reset {} { - if {[array exists ::auto_index]} { - foreach cmdName [array names ::auto_index] { + global auto_execs auto_index auto_path + if {[array exists auto_index]} { + foreach cmdName [array names auto_index] { set fqcn [namespace which $cmdName] if {$fqcn eq ""} { continue @@ -29,11 +30,11 @@ proc auto_reset {} { rename $fqcn {} } } - unset -nocomplain ::auto_execs ::auto_index ::tcl::auto_oldpath - if {[catch {llength $::auto_path}]} { - set ::auto_path [list [info library]] - } elseif {[info library] ni $::auto_path} { - lappend ::auto_path [info library] + unset -nocomplain auto_execs auto_index ::tcl::auto_oldpath + if {[catch {llength $auto_path}]} { + set auto_path [list [info library]] + } elseif {[info library] ni $auto_path} { + lappend auto_path [info library] } } @@ -53,7 +54,7 @@ proc auto_reset {} { proc tcl_findLibrary {basename version patch initScript enVarName varName} { upvar #0 $varName the_library - global env + global auto_path env tcl_platform set dirs {} set errors {} @@ -83,12 +84,10 @@ proc tcl_findLibrary {basename version patch initScript enVarName varName} { # 3. Relative to auto_path directories. This checks relative to the # Tcl library as well as allowing loading of libraries added to the # auto_path that is not relative to the core library or binary paths. - foreach d $::auto_path { + foreach d $auto_path { lappend dirs [file join $d $basename$version] - if { - $::tcl_platform(platform) eq "unix" - && $::tcl_platform(os) eq "Darwin" - } then { + if {$tcl_platform(platform) eq "unix" + && $tcl_platform(os) eq "Darwin"} { # 4. On MacOSX, check the Resources/Scripts subdir too lappend dirs [file join $d $basename$version Resources Scripts] } @@ -514,6 +513,32 @@ proc auto_mkindex_parser::fullname {name} { return [string map [list \0 \$] $name] } +# auto_mkindex_parser::indexEntry -- +# +# Used by commands like "proc" within the auto_mkindex parser to add a +# correctly-quoted entry to the index. This is shared code so it is done +# *right*, in one place. +# +# Arguments: +# name - Name that is being added to index. + +proc auto_mkindex_parser::indexEntry {name} { + variable index + variable scriptFile + + # We convert all metacharacters to their backslashed form, and pre-split + # the file name that we know about (which will be a proper list, and so + # correctly quoted). + + set name [string range [list \}[fullname $name]] 2 end] + set filenameParts [file split $scriptFile] + + append index [format \ + {set auto_index(%s) [list source [file join $dir %s]]%s} \ + $name $filenameParts \n] + return +} + if {[llength $::auto_mkindex_parser::initCommands]} { return } @@ -525,15 +550,7 @@ if {[llength $::auto_mkindex_parser::initCommands]} { # Adds an entry to the auto index list for the given procedure name. auto_mkindex_parser::command proc {name args} { - variable index - variable scriptFile - # Do some fancy reformatting on the "source" call to handle platform - # differences with respect to pathnames. Use format just so that the - # command is a little easier to read (otherwise it'd be full of - # backslashed dollar signs, etc. - append index [list set auto_index([fullname $name])] \ - [format { [list source [file join $dir %s]]} \ - [file split $scriptFile]] "\n" + indexEntry $name } # Conditionally add support for Tcl byte code files. There are some tricky @@ -560,14 +577,7 @@ auto_mkindex_parser::hook { # procedure name. auto_mkindex_parser::commandInit tbcload::bcproc {name args} { - variable index - variable scriptFile - # Do some nice reformatting of the "source" call, to get around - # path differences on different platforms. We use the format - # command just so that the code is a little easier to read. - append index [list set auto_index([fullname $name])] \ - [format { [list source [file join $dir %s]]} \ - [file split $scriptFile]] "\n" + indexEntry $name } } } @@ -606,6 +616,35 @@ auto_mkindex_parser::command namespace {op args} { } catch {$parser eval "_%@namespace import $args"} } + ensemble { + variable parser + variable contextStack + if {[lindex $args 0] eq "create"} { + set name ::[join [lreverse $contextStack] ::] + catch { + set name [dict get [lrange $args 1 end] -command] + if {![string match ::* $name]} { + set name ::[join [lreverse $contextStack] ::]$name + } + regsub -all ::+ $name :: name + } + # create artifical proc to force an entry in the tclIndex + $parser eval [list ::proc $name {} {}] + } + } + } +} + +# AUTO MKINDEX: oo::class create name ?definition? +# Adds an entry to the auto index list for the given class name. +auto_mkindex_parser::command oo::class {op name {body ""}} { + if {$op eq "create"} { + indexEntry $name + } +} +auto_mkindex_parser::command class {op name {body ""}} { + if {$op eq "create"} { + indexEntry $name } } |