From 6471990d5f03984456c2ec12a87d1d351d780a04 Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 14 Mar 2001 18:25:27 +0000 Subject: * library/package.tcl (pkg_mkIndex): Added patch from Vince Darley to make [pkg_mkIndex -verbose] even more verbose. [Bug 219349, Patch 403529] --- ChangeLog | 5 +++++ library/package.tcl | 23 ++++++++++++++++++++++- 2 files changed, 27 insertions(+), 1 deletion(-) diff --git a/ChangeLog b/ChangeLog index 111cedc..04ffa20 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +2001-03-14 Don Porter + * library/package.tcl (pkg_mkIndex): Added patch from Vince + Darley to make [pkg_mkIndex -verbose] even more verbose. + [Bug 219349, Patch 403529] + 2001-03-13 Donal K. Fellows * doc/info.n: Improved documentation for [info hostname]. diff --git a/library/package.tcl b/library/package.tcl index d04dac8..9049444 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.16 2000/11/24 13:56:40 dkf Exp $ +# RCS: @(#) $Id: package.tcl,v 1.17 2001/03/14 18:25:40 dgp Exp $ # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1998 Sun Microsystems, Inc. @@ -165,10 +165,23 @@ proc pkg_mkIndex {args} { # Load into the child any packages currently loaded in the parent # interpreter that match the -load pattern. + if {[string length $loadPat]} { + if {$doVerbose} { + tclLog "currently loaded packages: '[info loaded]'" + tclLog "trying to load all packages matching $loadPat" + } + if {![llength [info loaded]]} { + tclLog "warning: no packages are currently loaded, nothing" + tclLog "can possibly match '$loadPat'" + } + } foreach pkg [info loaded] { if {! [string match $loadPat [lindex $pkg 1]]} { continue } + if {$doVerbose} { + tclLog "package [lindex $pkg 1] matches '$loadPat'" + } if {[catch { load [lindex $pkg 0] [lindex $pkg 1] $c } err]} { @@ -345,9 +358,17 @@ proc pkg_mkIndex {args} { tclLog "warning: error while $what $file: $msg" } } else { + set what [$c eval set ::tcl::debug] + if {$doVerbose} { + tclLog "successful $what of $file" + } set type [$c eval set ::tcl::type] set cmds [lsort [$c eval array names ::tcl::newCmds]] set pkgs [$c eval set ::tcl::newPkgs] + if {$doVerbose} { + tclLog "commands provided were $cmds" + tclLog "packages provided were $pkgs" + } if {[llength $pkgs] > 1} { tclLog "warning: \"$file\" provides more than one package ($pkgs)" } -- cgit v0.12