Attachment "package.diff" to
ticket [624509ffff]
added by
das
2002-10-27 18:09:45.
Index: library/auto.tcl
===================================================================
RCS file: /cvsroot/tcl/tcl/library/auto.tcl,v
retrieving revision 1.11
diff -u -r1.11 auto.tcl
--- library/auto.tcl 22 Oct 2002 16:41:27 -0000 1.11
+++ library/auto.tcl 27 Oct 2002 06:00:44 -0000
@@ -28,7 +28,7 @@
if {[info exists auto_index($p)] && ![string match auto_* $p]
&& ([lsearch -exact {unknown pkg_mkIndex tclPkgSetup
tcl_findLibrary pkg_compareExtension
- tclMacPkgSearch tclPkgUnknown} $p] < 0)} {
+ tclPkgUnknown tcl::MacOSXPkgUnknown tcl::MacPkgUnknown} $p] < 0)} {
rename $p {}
}
}
Index: library/init.tcl
===================================================================
RCS file: /cvsroot/tcl/tcl/library/init.tcl,v
retrieving revision 1.53
diff -u -r1.53 init.tcl
--- library/init.tcl 3 Oct 2002 13:34:32 -0000 1.53
+++ library/init.tcl 27 Oct 2002 06:00:44 -0000
@@ -113,6 +113,17 @@
package unknown tclPkgUnknown
+if {![interp issafe]} {
+ # setup platform specific unknown package handlers
+ if {[string equal $::tcl_platform(platform) "unix"] && \
+ [string equal $::tcl_platform(os) "Darwin"]} {
+ package unknown [list tcl::MacOSXPkgUnknown [package unknown]]
+ }
+ if {[string equal $::tcl_platform(platform) "macintosh"]} {
+ package unknown [list tcl::MacPkgUnknown [package unknown]]
+ }
+}
+
# Conditionalize for presence of exec.
if {[llength [info commands exec]] == 0} {
Index: library/package.tcl
===================================================================
RCS file: /cvsroot/tcl/tcl/library/package.tcl,v
retrieving revision 1.20
diff -u -r1.20 package.tcl
--- library/package.tcl 22 Oct 2002 16:41:28 -0000 1.20
+++ library/package.tcl 27 Oct 2002 06:00:44 -0000
@@ -452,23 +452,6 @@
}
}
-# tclMacPkgSearch --
-# The procedure is used on the Macintosh to search a given directory for files
-# with a TEXT resource named "pkgIndex". If it exists it is sourced in to the
-# interpreter to setup the package database.
-
-proc tclMacPkgSearch {dir} {
- 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}
- }
- catch {resource close $res}
- }
- }
-}
-
# tclPkgUnknown --
# This procedure provides the default for the "package unknown" function.
# It is invoked when a package that's needed can't be found. It scans
@@ -484,7 +467,7 @@
# exact - Either "-exact" or omitted. Not used.
proc tclPkgUnknown {name version {exact {}}} {
- global auto_path tcl_platform env
+ global auto_path env
if {![info exists auto_path]} {
return
@@ -510,25 +493,6 @@
}
}
}
- # On MacOSX also search the Resources/Scripts directories in
- # the subdirectories for pkgIndex files
- if {[string equal $::tcl_platform(platform) "unix"] && \
- [string equal $::tcl_platform(os) "Darwin"]} {
- set dir [lindex $use_path end]
- catch {
- 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 {[catch {source $file} msg]} {
- tclLog "error reading package index file $file: $msg"
- } else {
- set procdDirs($dir) 1
- }
- }
- }
- }
- }
set dir [lindex $use_path end]
set file [file join $dir pkgIndex.tcl]
# safe interps usually don't have "file readable", nor stderr channel
@@ -540,22 +504,109 @@
set procdDirs($dir) 1
}
}
- # On the Macintosh we also look in the resource fork
- # of shared libraries
- # We can't use tclMacPkgSearch in safe interps because it uses glob
- if {(![interp issafe]) && \
- [string equal $tcl_platform(platform) "macintosh"]} {
- set dir [lindex $use_path end]
- if {![info exists procdDirs($dir)]} {
- tclMacPkgSearch $dir
- set procdDirs($dir) 1
+ set use_path [lrange $use_path 0 end-1]
+ if {[string compare $old_path $auto_path]} {
+ foreach dir $auto_path {
+ lappend use_path $dir
}
- foreach x [glob -directory $dir -nocomplain *] {
- if {[file isdirectory $x] && ![info exists procdDirs($x)]} {
- set dir $x
- tclMacPkgSearch $dir
+ set old_path $auto_path
+ }
+ }
+}
+
+# tcl::MacOSXPkgUnknown --
+# This procedure extends the "package unknown" function for MacOSX.
+# It scans the Resources/Scripts directories of the immediate children
+# of the auto_path directories for pkgIndex files.
+# Only installed in interps that are not safe so we don't check
+# for [interp issafe] as in tclPkgUnknown.
+#
+# Arguments:
+# original - original [package unknown] procedure
+# name - Name of desired package. Not used.
+# version - Version of desired package. Not used.
+# exact - Either "-exact" or omitted. Not used.
+
+proc tcl::MacOSXPkgUnknown {original name version {exact {}}} {
+
+ # First do the cross-platform default search
+ uplevel 1 $original [list $name $version $exact]
+
+ # Now do MacOSX specific searching
+ global auto_path
+
+ if {![info exists auto_path]} {
+ return
+ }
+ # Cache the auto_path, because it may change while we run through
+ # the first set of pkgIndex.tcl files
+ set old_path [set use_path $auto_path]
+ while {[llength $use_path]} {
+ set dir [lindex $use_path end]
+ # 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 {[catch {source $file} msg]} {
+ 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 {
+ lappend use_path $dir
+ }
+ set old_path $auto_path
+ }
+ }
+}
+
+# tcl::MacPkgUnknown --
+# This procedure extends the "package unknown" function for Mac.
+# It searches for pkgIndex TEXT resources in all files
+# Only installed in interps that are not safe so we don't check
+# for [interp issafe] as in tclPkgUnknown.
+#
+# Arguments:
+# original - original [package unknown] procedure
+# name - Name of desired package. Not used.
+# version - Version of desired package. Not used.
+# exact - Either "-exact" or omitted. Not used.
+
+proc tcl::MacPkgUnknown {original name version {exact {}}} {
+
+ # First do the cross-platform default search
+ uplevel 1 $original [list $name $version $exact]
+
+ # Now do Mac specific searching
+ global auto_path
+
+ if {![info exists auto_path]} {
+ return
+ }
+ # Cache the auto_path, because it may change while we run through
+ # 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
+ set dir [lindex $use_path end]
+ foreach x [concat [list $dir] [glob -directory $dir -nocomplain *] ] {
+ if {[file isdirectory $x] && ![info exists procdDirs($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}
+ }
+ catch {resource close $res}
+ }
+ }
+ set procdDirs($dir) 1
}
}
set use_path [lrange $use_path 0 end-1]
Index: library/tclIndex
===================================================================
RCS file: /cvsroot/tcl/tcl/library/tclIndex,v
retrieving revision 1.5
diff -u -r1.5 tclIndex
--- library/tclIndex 7 Feb 2000 22:33:18 -0000 1.5
+++ library/tclIndex 27 Oct 2002 06:00:44 -0000
@@ -31,8 +31,9 @@
set auto_index(pkg_compareExtension) [list source [file join $dir package.tcl]]
set auto_index(pkg_mkIndex) [list source [file join $dir package.tcl]]
set auto_index(tclPkgSetup) [list source [file join $dir package.tcl]]
-set auto_index(tclMacPkgSearch) [list source [file join $dir package.tcl]]
set auto_index(tclPkgUnknown) [list source [file join $dir package.tcl]]
+set auto_index(::tcl::MacOSXPkgUnknown) [list source [file join $dir package.tcl]]
+set auto_index(::tcl::MacPkgUnknown) [list source [file join $dir package.tcl]]
set auto_index(::pkg::create) [list source [file join $dir package.tcl]]
set auto_index(parray) [list source [file join $dir parray.tcl]]
set auto_index(::safe::InterpStatics) [list source [file join $dir safe.tcl]]
