Index: library/init.tcl
===================================================================
RCS file: /cvsroot/tcl/tcl/library/init.tcl,v
retrieving revision 1.55
diff -u -r1.55 init.tcl
--- library/init.tcl	23 Nov 2002 01:41:35 -0000	1.55
+++ library/init.tcl	4 Mar 2003 17:08:12 -0000
@@ -724,3 +724,113 @@
     }
     return
 }
+
+proc tcl::PackageIndexCache { original name version {exact {}} } {
+    variable PackageIndexCache
+    unset -nocomplain PackageIndexCache
+    array set PackageIndexCache {}
+
+    foreach dir [list [info library] ~] {
+	set file [file join $dir .tclPackageIndexCache]
+	if {[file readable $file]} {
+	    catch {source $file}
+
+	    # As soon as  we've satisfied the package requirement
+	    # using the cache, we're done.  Test for that.
+	    if {$version eq ""} {
+		if {[llength [package versions $name]]} {
+		    # Our work is done
+		    unset PackageIndexCache
+		    return
+		} else {
+		    continue
+		}
+	    } 
+	    set testversion $version
+	    if {$exact ne "-exact"} {
+		foreach v [package versions $name] {
+		    if {[package vsatisfies $v $version]} {
+			set testversion $v
+			break
+		    }
+		}
+	    }
+	    if {[package ifneeded $name $testversion] ne ""} {
+		# Our work is done
+		unset PackageIndexCache
+		return
+	    }
+	}
+    }
+
+    # Wrap Tcl's built-in [package] command so we can intercept and
+    # record all [package ifneeded] calls.
+    rename ::package ::tcl::Package
+
+    variable PackageIndex
+    unset -nocomplain PackageIndex
+    array set PackageIndex {}
+    proc ::package {sub args} {
+	if {[string match i* $sub] && ([string first $sub ifneeded] == 0)} {
+	    variable ::tcl::PackageIndex
+	    foreach {name version script} $args {break}
+	    while {[regsub {[.]0+$} $version {} version]} {}
+	    set PackageIndex([list $name $version]) $script
+	}
+	uplevel 1 [lreplace [info level 0] 0 0 ::tcl::Package]
+    }
+
+    set original_auto_path $::auto_path
+
+    # Let the original [package unknown] seek and eval index scripts
+    set code [catch {
+	uplevel 1 $original [list $name $version $exact]
+    } result]
+
+    # Restore the original [::package]
+    rename ::package {}
+    rename ::tcl::Package ::package
+
+    # Save a record of the [package ifneeded] calls in a cache file.
+    # Let every different [info hostname], [info nameofexecutable],
+    # and $::auto_path determine a different cache.
+
+    set script ""
+    foreach {pair value} [array get PackageIndex] {
+	foreach {p v} $pair {break}
+	append script "[list package ifneeded $p $v $value]\n"
+    }
+    if {$::auto_path ne $original_auto_path} {
+	append script "[list set ::auto_path $::auto_path]\n"
+    }
+    unset PackageIndex
+
+    # Combine gathered data with othe data from previous cache
+    set PackageIndexCache([list [info hostname] [info nameofexecutable] \
+	    $original_auto_path]) $script
+    set contents \
+	    [list array set PackageIndexCache [array get PackageIndexCache]]
+    append contents {
+	eval $PackageIndexCache([list [info hostname] [info nameofexecutable] \
+		$::auto_path])
+    }
+    unset PackageIndexCache
+
+    # Try to save cache in $tcl_library for everyone's benefit.
+    # If permissions are lacking, at least save it for yourself.
+
+    foreach dir [list [info library] ~] {
+	set file [file join $dir .tclPackageIndexCache]
+	if {[file writable $dir]} {
+	    set f [open $file.[pid] w]
+	    puts $f $contents
+	    close $f
+	    file rename -force $file.[pid] $file
+	}
+    }
+
+    return -code $code $result
+}
+
+package unknown [list tcl::PackageIndexCache [package unknown]]
+
