From ae1195c7201836eb432fd92b0fbd9ff9e194ac6a Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Mon, 2 Aug 2004 22:01:36 +0000
Subject:         * library/package.tcl (pkg_mkIndex):    Updated [pkg_mkIndex]
 to         make use of [glob -directory $dir -tails] and return options.

---
 ChangeLog           |  3 +++
 library/package.tcl | 31 +++++++++++--------------------
 2 files changed, 14 insertions(+), 20 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 625ddca..e5948d5 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,8 @@
 2004-08-02  Don Porter  <dgp@users.sourceforge.net>
 
+	* library/package.tcl (pkg_mkIndex):	Updated [pkg_mkIndex] to
+	make use of [glob -directory $dir -tails] and return options.
+
 	TIP#207 IMPLEMENTATION
 
 	* doc/interp.n:		Added support for a -namespace option to the
diff --git a/library/package.tcl b/library/package.tcl
index 739f6a2..7c4e4e9 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.31 2004/07/30 16:54:04 dgp Exp $
+# RCS: @(#) $Id: package.tcl,v 1.32 2004/08/02 22:01:38 dgp Exp $
 #
 # Copyright (c) 1991-1993 The Regents of the University of California.
 # Copyright (c) 1994-1998 Sun Microsystems, Inc.
@@ -84,7 +84,6 @@ proc tcl::Pkg::CompareExtension { fileName {ext {}} } {
 #			dir.
 
 proc pkg_mkIndex {args} {
-    global errorCode errorInfo
     set usage {"pkg_mkIndex ?-direct? ?-lazy? ?-load pattern? ?-verbose? ?--? dir ?pattern ...?"};
 
     set argCount [llength $args]
@@ -135,13 +134,10 @@ proc pkg_mkIndex {args} {
 	set patternList [list "*.tcl" "*[info sharedlibextension]"]
     }
 
-    set oldDir [pwd]
-    cd $dir
-
-    if {[catch {glob {expand}$patternList} fileList]} {
-	global errorCode errorInfo
-	cd $oldDir
-	return -code error -errorcode $errorCode -errorinfo $errorInfo $fileList
+    if {[catch {
+	    glob -directory $dir -tails -types {r f} {expand}$patternList
+    } fileList o]} {
+	return -options $o $fileList
     }
     foreach file $fileList {
 	# For each file, figure out what commands and packages it provides.
@@ -149,15 +145,10 @@ proc pkg_mkIndex {args} {
 	# interpreter, and get a list of the new commands and packages
 	# that are defined.
 
-	if {[string equal $file "pkgIndex.tcl"]} {
+	if {[string equal $file pkgIndex.tcl]} {
 	    continue
 	}
 
-	# Changed back to the original directory before initializing the
-	# slave in case TCL_LIBRARY is a relative path (e.g. in the test
-	# suite). 
-
-	cd $oldDir
 	set c [interp create]
 
 	# Load into the child any packages currently loaded in the parent
@@ -194,7 +185,6 @@ proc pkg_mkIndex {args} {
 		$c eval [list wm withdraw .]
 	    }
 	}
-	cd $dir
 
 	$c eval {
 	    # Stub out the package command so packages can
@@ -224,6 +214,7 @@ proc pkg_mkIndex {args} {
 	    # to generate a pkgIndex.tcl file for the ::tcl namespace.
 
 	    namespace eval ::tcl {
+		variable dir		;# Current directory being processed
 		variable file		;# Current file being processed
 		variable direct		;# -direct flag value
 		variable x		;# Loop variable
@@ -237,6 +228,7 @@ proc pkg_mkIndex {args} {
 	    }
 	}
 
+	$c eval [list set ::tcl::dir $dir]
 	$c eval [list set ::tcl::file $file]
 	$c eval [list set ::tcl::direct $direct]
 
@@ -291,11 +283,11 @@ proc pkg_mkIndex {args} {
 		    # the wrong file to be used.
 
 		    set ::tcl::debug loading
-		    load [file join . $::tcl::file]
+		    load [file join $::tcl::dir $::tcl::file]
 		    set ::tcl::type load
 		} else {
 		    set ::tcl::debug sourcing
-		    source $::tcl::file
+		    source [file join $::tcl::dir $::tcl::file]
 		    set ::tcl::type source
 		}
 
@@ -414,10 +406,9 @@ proc pkg_mkIndex {args} {
 	append index "\n[eval $cmd]"
     }
 
-    set f [open pkgIndex.tcl w]
+    set f [open [file join $dir pkgIndex.tcl] w]
     puts $f $index
     close $f
-    cd $oldDir
 }
 
 # tclPkgSetup --
-- 
cgit v0.12