summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog7
-rw-r--r--library/auto.tcl5
-rw-r--r--library/init.tcl13
-rw-r--r--library/package.tcl153
-rw-r--r--library/tclIndex3
5 files changed, 126 insertions, 55 deletions
diff --git a/ChangeLog b/ChangeLog
index 696bea8..213b218 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,10 @@
+2002-10-28 Don Porter <dgp@users.sourceforge.net>
+
+ * library/auto.tcl: Converted the Mac-specific [package unknown]
+ * library/init.tcl: behavior to use a chaining mechanism to extend
+ * library/package.tcl: the default [tclPkgUnknown]. [Bug 627660]
+ * library/tclIndex: [Patch 624509] (steffen)
+
2002-10-26 David Gravereaux <davygrvy@pobox.com>
* win/makefile.vc: xcopy on NT 4.0 doesn't support the /Y switch
diff --git a/library/auto.tcl b/library/auto.tcl
index dcea2b5..4c736fe 100644
--- a/library/auto.tcl
+++ b/library/auto.tcl
@@ -3,7 +3,7 @@
# utility procs formerly in init.tcl dealing with auto execution
# of commands and can be auto loaded themselves.
#
-# RCS: @(#) $Id: auto.tcl,v 1.11 2002/10/22 16:41:27 das Exp $
+# RCS: @(#) $Id: auto.tcl,v 1.12 2002/10/28 16:34:25 dgp Exp $
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1998 Sun Microsystems, Inc.
@@ -28,7 +28,8 @@ proc auto_reset {} {
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 {}
}
}
diff --git a/library/init.tcl b/library/init.tcl
index d875f2e..10d0f3c 100644
--- a/library/init.tcl
+++ b/library/init.tcl
@@ -3,7 +3,7 @@
# Default system startup file for Tcl-based applications. Defines
# "unknown" procedure and auto-load facilities.
#
-# RCS: @(#) $Id: init.tcl,v 1.53 2002/10/03 13:34:32 dkf Exp $
+# RCS: @(#) $Id: init.tcl,v 1.54 2002/10/28 16:34:25 dgp Exp $
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
@@ -113,6 +113,17 @@ if {(![interp issafe]) && [string equal $tcl_platform(platform) "windows"]} {
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} {
diff --git a/library/package.tcl b/library/package.tcl
index 83a7692..108ca12 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.20 2002/10/22 16:41:28 das Exp $
+# RCS: @(#) $Id: package.tcl,v 1.21 2002/10/28 16:34:25 dgp Exp $
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1998 Sun Microsystems, Inc.
@@ -452,23 +452,6 @@ proc tclPkgSetup {dir pkg version files} {
}
}
-# 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 @@ proc tclMacPkgSearch {dir} {
# 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 @@ proc tclPkgUnknown {name version {exact {}}} {
}
}
}
- # 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,20 +504,53 @@ proc tclPkgUnknown {name version {exact {}}} {
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
}
}
@@ -568,6 +565,60 @@ proc tclPkgUnknown {name version {exact {}}} {
}
}
+# 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]
+ if {[string compare $old_path $auto_path]} {
+ foreach dir $auto_path {
+ lappend use_path $dir
+ }
+ set old_path $auto_path
+ }
+ }
+}
+
# ::pkg::create --
#
# Given a package specification generate a "package ifneeded" statement
diff --git a/library/tclIndex b/library/tclIndex
index c2da6be..16680ea 100644
--- a/library/tclIndex
+++ b/library/tclIndex
@@ -31,8 +31,9 @@ set auto_index(tclLdAout) [list source [file join $dir ldAout.tcl]]
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]]