summaryrefslogtreecommitdiffstats
path: root/library
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2013-09-16 18:59:14 (GMT)
committerdgp <dgp@users.sourceforge.net>2013-09-16 18:59:14 (GMT)
commitf1a21179670e2696e890bd3a7e1375aaf73885ec (patch)
treebeaad334c814a35e3e90e6297ed8886ee837c853 /library
parent4d70c5f1e1c701e08aba87cfe904436f6670afc3 (diff)
parent5cc8523f8e74dd251b4430bbed4967bd02f1ed4d (diff)
downloadtcl-f1a21179670e2696e890bd3a7e1375aaf73885ec.zip
tcl-f1a21179670e2696e890bd3a7e1375aaf73885ec.tar.gz
tcl-f1a21179670e2696e890bd3a7e1375aaf73885ec.tar.bz2
merge trunk; update changes
Diffstat (limited to 'library')
-rw-r--r--library/auto.tcl69
-rw-r--r--library/tm.tcl9
2 files changed, 52 insertions, 26 deletions
diff --git a/library/auto.tcl b/library/auto.tcl
index 78c219e..02edcc4 100644
--- a/library/auto.tcl
+++ b/library/auto.tcl
@@ -513,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
}
@@ -524,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
@@ -559,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
}
}
}
@@ -610,6 +621,13 @@ auto_mkindex_parser::command namespace {op args} {
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 {} {}]
}
@@ -619,15 +637,14 @@ auto_mkindex_parser::command namespace {op args} {
# AUTO MKINDEX: oo::class create name ?definition?
# Adds an entry to the auto index list for the given class name.
-foreach cmd {oo::class class} {
- auto_mkindex_parser::command $cmd {ecmd name {body ""}} {
- if {$cmd eq "create"} {
- variable index
- variable scriptFile
- append index [format "set %s \[list source \[%s]]\n" \
- [list auto_index([fullname $name])] \
- [list file join $dir {*}[file split $scriptFile]]]
- }
+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
}
}
diff --git a/library/tm.tcl b/library/tm.tcl
index d2af4f5..55efda6 100644
--- a/library/tm.tcl
+++ b/library/tm.tcl
@@ -238,6 +238,15 @@ proc ::tcl::tm::UnknownHandler {original name args} {
continue
}
+ if {[package ifneeded $pkgname $pkgversion] ne {}} {
+ # There's already a provide script registered for
+ # this version of this package. Since all units of
+ # code claiming to be the same version of the same
+ # package ought to be identical, just stick with
+ # the one we already have.
+ continue
+ }
+
# We have found a candidate, generate a "provide script"
# for it, and remember it. Note that we are using ::list
# to do this; locally [list] means something else without