summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorwelch <welch>1998-11-12 05:54:02 (GMT)
committerwelch <welch>1998-11-12 05:54:02 (GMT)
commitc2bba04f0c60b8ff2d317f442016649f61261666 (patch)
tree0707ffa3b3a22f511689b0eb56ff2bc1db6f1ffa
parentd9bda916f07d651e0c12e7d991231127882c1f41 (diff)
downloadtcl-c2bba04f0c60b8ff2d317f442016649f61261666.zip
tcl-c2bba04f0c60b8ff2d317f442016649f61261666.tar.gz
tcl-c2bba04f0c60b8ff2d317f442016649f61261666.tar.bz2
Fixed pkg_mkIndex tcl to deal with failed loads.
-rw-r--r--library/init.tcl32
1 files changed, 27 insertions, 5 deletions
diff --git a/library/init.tcl b/library/init.tcl
index 8b0f5e5..65d903e 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.21 1998/11/11 02:39:29 welch Exp $
+# RCS: @(#) $Id: init.tcl,v 1.22 1998/11/12 05:54:02 welch Exp $
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
@@ -1096,6 +1096,9 @@ proc pkg_compareExtension { fileName {ext {}} } {
# -verbose (optional) Verbose output; the name of each file that
# was successfully rocessed is printed out. Additionally,
# if processing of a file failed a message is printed.
+# -load pat (optional) Preload any packages whose names match
+# the pattern. Used to handle DLLs that depend on
+# other packages during their Init procedure.
# dir - Name of the directory in which to create the index.
# args - Any number of additional arguments, each giving
# a glob pattern that matches the names of one or
@@ -1104,7 +1107,7 @@ proc pkg_compareExtension { fileName {ext {}} } {
proc pkg_mkIndex {args} {
global errorCode errorInfo
- set usage {"pkg_mkIndex ?-direct? ?-verbose? dir ?pattern ...?"};
+ set usage {"pkg_mkIndex ?-direct? ?-verbose? ?-load pattern? ?--? dir ?pattern ...?"};
set argCount [llength $args]
if {$argCount < 1} {
@@ -1114,6 +1117,7 @@ proc pkg_mkIndex {args} {
set more ""
set direct 0
set doVerbose 0
+ set loadPat ""
for {set idx 0} {$idx < $argCount} {incr idx} {
set flag [lindex $args $idx]
switch -glob -- $flag {
@@ -1129,6 +1133,11 @@ proc pkg_mkIndex {args} {
set direct 1
append more " -direct"
}
+ -load {
+ incr idx
+ set loadPat [lindex $args $idx]
+ append more " -load $loadPat"
+ }
-* {
return -code error "unknown flag $flag: should be\n$usage"
}
@@ -1179,14 +1188,27 @@ proc pkg_mkIndex {args} {
cd $oldDir
set c [interp create]
- # Load into the child all packages currently loaded in the parent
- # interpreter, in case the extension depends on some of them.
+ # Load into the child any packages currently loaded in the parent
+ # interpreter that match the -load pattern.
foreach pkg [info loaded] {
+ if {! [string match $loadPat [lindex $pkg 1]]} {
+ continue
+ }
if {[lindex $pkg 1] == "Tk"} {
$c eval {set argv {-geometry +0+0}}
}
- load [lindex $pkg 0] [lindex $pkg 1] $c
+ if {[catch {
+ load [lindex $pkg 0] [lindex $pkg 1] $c
+ } err]} {
+ if {$doVerbose} {
+ tclLog "warning: load [lindex $pkg 0] [lindex $pkg 1]\nfailed with: $err"
+ }
+ } else {
+ if {$doVerbose} {
+ tclLog "loaded [lindex $pkg 0] [lindex $pkg 1]"
+ }
+ }
}
cd $dir