diff options
| -rw-r--r-- | library/init.tcl | 32 |
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 |