From a06d29e8f324739ff97c0ea66994ea5c0d2595a8 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Fri, 21 Feb 2003 05:30:14 +0000
Subject:         * library/package.tcl (tclPkgUnknown):  Minor performance
 tweaks         to reduce the number of [file] invocations.  Meant to improve 
        startup times, at least a little bit.  [Patch 687906]

---
 ChangeLog           |  6 ++++++
 library/package.tcl | 61 +++++++++++++++++++++++++++++++++++++++++------------
 2 files changed, 54 insertions(+), 13 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 90f2f1d..9543f32 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2003-02-21  Don Porter  <dgp@users.sourceforge.net>
+
+	* library/package.tcl (tclPkgUnknown):  Minor performance tweaks
+	to reduce the number of [file] invocations.  Meant to improve
+	startup times, at least a little bit.  [Patch 687906]
+
 2003-02-20  Daniel Steffen  <das@users.sourceforge.net>
 
 	* unix/tcl.m4:
diff --git a/library/package.tcl b/library/package.tcl
index 108ca12..d69f21e 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.21 2002/10/28 16:34:25 dgp Exp $
+# RCS: @(#) $Id: package.tcl,v 1.22 2003/02/21 05:30:18 dgp Exp $
 #
 # Copyright (c) 1991-1993 The Regents of the University of California.
 # Copyright (c) 1994-1998 Sun Microsystems, Inc.
@@ -477,6 +477,14 @@ proc tclPkgUnknown {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
+
 	# we can't use glob in safe interps, so enclose the following
 	# in a catch statement, where we get the pkgIndex files out
 	# of the subdirectories
@@ -484,7 +492,7 @@ proc tclPkgUnknown {name version {exact {}}} {
 	    foreach file [glob -directory $dir -join -nocomplain \
 		    * 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 {
@@ -494,23 +502,50 @@ proc tclPkgUnknown {name version {exact {}}} {
 	    }
 	}
 	set dir [lindex $use_path end]
-	set file [file join $dir pkgIndex.tcl]
-	# safe interps usually don't have "file readable", nor stderr channel
-	if {([interp issafe] || [file readable $file]) && \
-		![info exists procdDirs($dir)]} {
-	    if {[catch {source $file} msg] && ![interp issafe]}  {
-		tclLog "error reading package index file $file: $msg"
-	    } else {
-		set procdDirs($dir) 1
+	if {![info exists procdDirs($dir)]} {
+	    set file [file join $dir pkgIndex.tcl]
+	    # safe interps usually don't have "file readable", 
+	    # nor stderr channel
+	    if {([interp issafe] || [file readable $file])} {
+		if {[catch {source $file} msg] && ![interp issafe]}  {
+		    tclLog "error reading package index file $file: $msg"
+		} else {
+		    set procdDirs($dir) 1
+		}
 	    }
 	}
+
 	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
     }
 }
 
-- 
cgit v0.12