diff options
author | dgp <dgp@users.sourceforge.net> | 2004-08-02 22:01:36 (GMT) |
---|---|---|
committer | dgp <dgp@users.sourceforge.net> | 2004-08-02 22:01:36 (GMT) |
commit | ae1195c7201836eb432fd92b0fbd9ff9e194ac6a (patch) | |
tree | 3baf94a9cb27e34e4e61d6ad89da401d13549d3c /library/package.tcl | |
parent | 7659a2e96a1878dd2f0bb5111c39a0d4e0b2923d (diff) | |
download | tcl-ae1195c7201836eb432fd92b0fbd9ff9e194ac6a.zip tcl-ae1195c7201836eb432fd92b0fbd9ff9e194ac6a.tar.gz tcl-ae1195c7201836eb432fd92b0fbd9ff9e194ac6a.tar.bz2 |
* library/package.tcl (pkg_mkIndex): Updated [pkg_mkIndex] to
make use of [glob -directory $dir -tails] and return options.
Diffstat (limited to 'library/package.tcl')
-rw-r--r-- | library/package.tcl | 31 |
1 files changed, 11 insertions, 20 deletions
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 -- |