summaryrefslogtreecommitdiffstats
path: root/library/package.tcl
diff options
context:
space:
mode:
authorvincentdarley <vincentdarley>2003-09-24 18:07:45 (GMT)
committervincentdarley <vincentdarley>2003-09-24 18:07:45 (GMT)
commit738190c1c7001b3b28598481cefef717bbde3a72 (patch)
tree9ad05b312009a86d331e25359e271a92e9099e98 /library/package.tcl
parent9fb7a2d3f1a8b969835f86ae3320c14f11c7718b (diff)
downloadtcl-738190c1c7001b3b28598481cefef717bbde3a72.zip
tcl-738190c1c7001b3b28598481cefef717bbde3a72.tar.gz
tcl-738190c1c7001b3b28598481cefef717bbde3a72.tar.bz2
package unknown performance on MacOS and MacOS X
Diffstat (limited to 'library/package.tcl')
-rw-r--r--library/package.tcl89
1 files changed, 78 insertions, 11 deletions
diff --git a/library/package.tcl b/library/package.tcl
index 545f6a9..77812f3 100644
--- a/library/package.tcl
+++ b/library/package.tcl
@@ -3,7 +3,7 @@
# utility procs formerly in init.tcl which can be loaded on demand
# for package management.
#
-# RCS: @(#) $Id: package.tcl,v 1.25 2003/07/24 08:45:18 rmax Exp $
+# RCS: @(#) $Id: package.tcl,v 1.26 2003/09/24 18:07:45 vincentdarley Exp $
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1998 Sun Microsystems, Inc.
@@ -582,11 +582,19 @@ proc tcl::MacOSXPkgUnknown {original name version {exact {}}} {
set old_path [set use_path $auto_path]
while {[llength $use_path]} {
set dir [lindex $use_path end]
+
+ # Make sure we only scan each directory one time.
+ if {[info exists tclSeenPath($dir)]} {
+ set use_path [lrange $use_path 0 end-1]
+ continue
+ }
+ set tclSeenPath($dir) 1
+
# get the pkgIndex files out of the subdirectories
foreach file [glob -directory $dir -join -nocomplain \
* Resources Scripts pkgIndex.tcl] {
set dir [file dirname $file]
- if {[file readable $file] && ![info exists procdDirs($dir)]} {
+ if {![info exists procdDirs($dir)] && [file readable $file]} {
if {[catch {source $file} msg]} {
tclLog "error reading package index file $file: $msg"
} else {
@@ -595,12 +603,36 @@ proc tcl::MacOSXPkgUnknown {original name version {exact {}}} {
}
}
set use_path [lrange $use_path 0 end-1]
- if {[string compare $old_path $auto_path]} {
- foreach dir $auto_path {
+
+ # Check whether any of the index scripts we [source]d above
+ # set a new value for $::auto_path. If so, then find any
+ # new directories on the $::auto_path, and lappend them to
+ # the $use_path we are working from. This gives index scripts
+ # the (arguably unwise) power to expand the index script search
+ # path while the search is in progress.
+ set index 0
+ if {[llength $old_path] == [llength $auto_path]} {
+ foreach dir $auto_path old $old_path {
+ if {$dir ne $old} {
+ # This entry in $::auto_path has changed.
+ break
+ }
+ incr index
+ }
+ }
+
+ # $index now points to the first element of $auto_path that
+ # has changed, or the beginning if $auto_path has changed length
+ # Scan the new elements of $auto_path for directories to add to
+ # $use_path. Don't add directories we've already seen, or ones
+ # already on the $use_path.
+ foreach dir [lrange $auto_path $index end] {
+ if {![info exists tclSeenPath($dir)]
+ && ([lsearch -exact $use_path $dir] == -1) } {
lappend use_path $dir
}
- set old_path $auto_path
}
+ set old_path $auto_path
}
}
@@ -631,16 +663,27 @@ proc tcl::MacPkgUnknown {original name version {exact {}}} {
# the first set of pkgIndex.tcl files
set old_path [set use_path $auto_path]
while {[llength $use_path]} {
- # We look for pkgIndex TEXT resources in the resource fork of shared libraries
+ # We look for pkgIndex TEXT resources in the resource fork of
+ # shared libraries
set dir [lindex $use_path end]
+
+ # Make sure we only scan each directory one time.
+ if {[info exists tclSeenPath($dir)]} {
+ set use_path [lrange $use_path 0 end-1]
+ continue
+ }
+ set tclSeenPath($dir) 1
+
foreach x [concat [list $dir] [glob -directory $dir -nocomplain *] ] {
- if {[file isdirectory $x] && ![info exists procdDirs($x)]} {
+ if {![info exists procdDirs($x)] && [file isdirectory $x]} {
set dir $x
foreach x [glob -directory $dir -nocomplain *.shlb] {
if {[file isfile $x]} {
set res [resource open $x]
foreach y [resource list TEXT $res] {
- if {[string equal $y "pkgIndex"]} {source -rsrc pkgIndex}
+ if {[string equal $y "pkgIndex"]} {
+ source -rsrc pkgIndex
+ }
}
catch {resource close $res}
}
@@ -649,12 +692,36 @@ proc tcl::MacPkgUnknown {original name version {exact {}}} {
}
}
set use_path [lrange $use_path 0 end-1]
- if {[string compare $old_path $auto_path]} {
- foreach dir $auto_path {
+
+ # Check whether any of the index scripts we [source]d above
+ # set a new value for $::auto_path. If so, then find any
+ # new directories on the $::auto_path, and lappend them to
+ # the $use_path we are working from. This gives index scripts
+ # the (arguably unwise) power to expand the index script search
+ # path while the search is in progress.
+ set index 0
+ if {[llength $old_path] == [llength $auto_path]} {
+ foreach dir $auto_path old $old_path {
+ if {$dir ne $old} {
+ # This entry in $::auto_path has changed.
+ break
+ }
+ incr index
+ }
+ }
+
+ # $index now points to the first element of $auto_path that
+ # has changed, or the beginning if $auto_path has changed length
+ # Scan the new elements of $auto_path for directories to add to
+ # $use_path. Don't add directories we've already seen, or ones
+ # already on the $use_path.
+ foreach dir [lrange $auto_path $index end] {
+ if {![info exists tclSeenPath($dir)]
+ && ([lsearch -exact $use_path $dir] == -1) } {
lappend use_path $dir
}
- set old_path $auto_path
}
+ set old_path $auto_path
}
}