You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
643 lines
28 KiB
643 lines
28 KiB
|
|
|
|
#JMN 2005 - Public Domain |
|
# |
|
#REVIEW: This package may not robustly output xml. More testing & development required. |
|
# |
|
|
|
#NOTE: the 'x' attribute on the 'info' tag may have its value truncated. |
|
#It is a human-readable indicator only and should not be used to cross-reference to the corresponding 'require' tag using the 'p' attribute. |
|
#Use the fact that the corresponding 'info' tag directly follows its 'require' tag. |
|
|
|
|
|
#changes |
|
#2021-09-17 |
|
# - added variable ::packagetrace::showpresent with default 1 |
|
# setting this to 0 will hide the <present/> tags which sometimes make the output too verbose. |
|
# - changed t from an integer number of milliseconds to show fractional millis by using ([clock microseconds]-$t0)/1000.0 in the expr. |
|
|
|
namespace eval packagetrace::class { |
|
if {[info commands [namespace current]::tracer] eq ""} { |
|
oo::class create tracer { |
|
method get {} { |
|
} |
|
method test {} { |
|
return tracertest |
|
} |
|
} |
|
} |
|
} |
|
|
|
|
|
namespace eval packagetrace { |
|
variable tracerlist [list] |
|
variable chan stderr |
|
variable showpresent 1 |
|
variable output "" |
|
|
|
|
|
proc help {} { |
|
return { |
|
REVIEW - documentation inaccurate |
|
Enable package tracing using 'package require packagetrace' |
|
Disable package tracing using 'package forget packagetrace; package require packagetrace' |
|
(This 2nd 'package require packagetrace' will raise an error. This is deliberate.) |
|
use packagetrace::channel <chan> to desired output channel or none. (default stderr) |
|
|
|
set packagetrace::showpresent 0 to skip <present/> output |
|
} |
|
} |
|
|
|
# == == == == == == == == == == == == == == == == == == == == == == == == == == == == == == == |
|
# Maintenance - tm_version... functions - primary source is punk::lib module |
|
# - these should be synced with code from latest punk::lib |
|
# == == == == == == == == == == == == == == == == == == == == == == == == == == == == == == == |
|
proc tm_version_isvalid {versionpart} { |
|
#Needs to be suitable for use with Tcl's 'package vcompare' |
|
if {![catch [list package vcompare $versionpart $versionpart]]} { |
|
return 1 |
|
} else { |
|
return 0 |
|
} |
|
} |
|
proc tm_version_major {version} { |
|
if {![tm_version_isvalid $version]} { |
|
error "Invalid version '$version' is not a proper Tcl module version number" |
|
} |
|
set firstpart [lindex [split $version .] 0] |
|
#check for a/b in first segment |
|
if {[string is integer -strict $firstpart]} { |
|
return $firstpart |
|
} |
|
if {[string first a $firstpart] > 0} { |
|
return [lindex [split $firstpart a] 0] |
|
} |
|
if {[string first b $firstpart] > 0} { |
|
return [lindex [split $firstpart b] 0] |
|
} |
|
error "tm_version_major unable to determine major version from version number '$version'" |
|
} |
|
proc tm_version_canonical {ver} { |
|
#accepts a single valid version only - not a bounded or unbounded spec |
|
if {![tm_version_isvalid $ver]} { |
|
error "tm_version_canonical version '$ver' is not valid for a package version" |
|
} |
|
set parts [split $ver .] |
|
set newparts [list] |
|
foreach o $parts { |
|
set trimmed [string trimleft $o 0] |
|
set firstnonzero [string index $trimmed 0] |
|
switch -exact -- $firstnonzero { |
|
"" { |
|
lappend newparts 0 |
|
} |
|
a - b { |
|
#e.g 000bnnnn -> bnnnnn |
|
set tailtrimmed [string trimleft [string range $trimmed 1 end] 0] |
|
if {$tailtrimmed eq ""} { |
|
set tailtrimmed 0 |
|
} |
|
lappend newparts 0$firstnonzero$tailtrimmed |
|
} |
|
default { |
|
#digit |
|
if {[string is integer -strict $trimmed]} { |
|
#e.g 0100 -> 100 |
|
lappend newparts $trimmed |
|
} else { |
|
#e.g 0100b003 -> 100b003 (still need to process tail) |
|
if {[set apos [string first a $trimmed]] > 0} { |
|
set lhs [string range $trimmed 0 $apos-1] ;#assert lhs non-empty and only digits or wouldn't be in this branch |
|
set rhs [string range $trimmed $apos+1 end] ;#assert rhs non-empty and only digits |
|
set rhs [string trimleft $rhs 0] |
|
if {$rhs eq ""} { |
|
set rhs 0 |
|
} |
|
lappend newparts ${lhs}a${rhs} |
|
} elseif {[set bpos [string first b $trimmed]] > 0} { |
|
set lhs [string range $trimmed 0 $bpos-1] ;#assert lhs non-empty and only digits or wouldn't be in this branch |
|
set rhs [string range $trimmed $bpos+1 end] ;#assert rhs non-empty and only digits |
|
set rhs [string trimleft $rhs 0] |
|
if {$rhs eq ""} { |
|
set rhs 0 |
|
} |
|
lappend newparts ${lhs}b${rhs} |
|
} else { |
|
#assert - shouldn't get here trimmed val should have been empty, an int or contained an a or b |
|
error "tm_version_canonical error - trimfail - unexpected" |
|
} |
|
} |
|
} |
|
} |
|
} |
|
return [join $newparts .] |
|
} |
|
proc tm_version_required_canonical {versionspec} { |
|
#also trim leading zero from any dottedpart? |
|
#Tcl *allows* leading zeros in any of the dotted parts - but they are not significant. |
|
#e.g 1.01 is equivalent to 1.1 and 01.001 |
|
#also 1b3 == 1b0003 |
|
|
|
if {[string trim $versionspec] eq ""} {return ""} ;#unspecified = any version |
|
set errmsg "tm_version_required_canonical - invalid version specification" |
|
if {[string first - $versionspec] < 0} { |
|
#no dash |
|
#looks like a minbounded version (ie a single version with no dash) convert to min-max form |
|
set from $versionspec |
|
if {![tm_version_isvalid $from]} { |
|
error "$errmsg '$versionpec'" |
|
} |
|
if {![catch {tm_version_major $from} majorv]} { |
|
set from [tm_version_canonical $from] |
|
return "${from}-[expr {$majorv +1}]" |
|
} else { |
|
error "$errmsg '$versionspec'" |
|
} |
|
} else { |
|
# min- or min-max |
|
#validation and canonicalisation (strip leading zeroes from each segment, including either side of a or b) |
|
set parts [split $versionspec -] ;#we expect only 2 parts |
|
lassign $parts from to |
|
if {![tm_version_isvalid $from]} { |
|
error "$errmsg '$versionspec'" |
|
} |
|
set from [tm_version_canonical $from] |
|
if {[llength $parts] == 2} { |
|
if {$to ne ""} { |
|
if {![tm_version_isvalid $to]} { |
|
error "$errmsg '$versionspec'" |
|
} |
|
set to [tm_version_canonical $to] |
|
return $from-$to |
|
} else { |
|
return $from- |
|
} |
|
} else { |
|
error "$errmsg '$versionspec'" |
|
} |
|
error "tm_version_required_canonical should have already returned a canonicalised versionspec - or produced an error with reason before this point" |
|
} |
|
} |
|
# end tm_version... functions |
|
# == == == == == == == == == == == == == == == == == == == == == == == == == == == == == == == |
|
|
|
#convenience function in case the sequence 'package forget packagetrace;package require packagetrace' is too unintuitive or weird. |
|
#REVIEW |
|
proc unload {} { |
|
package forget packagetrace |
|
if {[catch {package require packagetrace}]} { |
|
return 1 ;#yes - we get an error if we unloaded successfully |
|
} else { |
|
error "packagetrace was not unloaded" |
|
} |
|
} |
|
proc emit {str} { |
|
variable chan |
|
variable output |
|
append output $str |
|
if {$chan ne "none"} { |
|
puts -nonewline $chan $str |
|
} |
|
return |
|
} |
|
proc get {{as raw}} { |
|
variable output |
|
switch -- [string tolower $as] { |
|
asxml { |
|
if {[package provide tdom] eq ""} { |
|
set previous_output $output |
|
package require tdom |
|
set output $previous_output |
|
} |
|
set d [dom parse $output] |
|
return [$d asXML] |
|
} |
|
aslist { |
|
if {[package provide tdom] eq ""} { |
|
set previous_output $output |
|
package require tdom |
|
set output $previous_output |
|
} |
|
set d [dom parse $output] |
|
return [$d asList] |
|
} |
|
default { |
|
return $output |
|
} |
|
} |
|
} |
|
proc channel {{ch ""}} { |
|
variable chan |
|
switch -exact -- $ch { |
|
"" { |
|
return $chan |
|
} |
|
none { |
|
set chan none |
|
return none |
|
} |
|
stderr - stdout { |
|
#note stderr stdout not necessarily in [chan names] (due to transforms etc?) but can still work |
|
set chan $ch |
|
return $ch |
|
} |
|
default { |
|
if {$ch in [chan names]} { |
|
set chan $ch |
|
return $ch |
|
} else { |
|
error "chan '$ch' not in \[chan names\]: [chan names]" |
|
} |
|
} |
|
} |
|
} |
|
proc init {} { |
|
uplevel 1 { |
|
set ::packagetrace::level -1 |
|
if {![llength [info commands tcl_findLibrary]]} { |
|
tcl::namespace::eval :: $::auto_index(tcl_findLibrary) |
|
} |
|
package require commandstack |
|
|
|
|
|
set targetcommand [namespace which tcl_findLibrary] ;# normalize to presumably ::tcl_findLibrary |
|
set stackrecord [commandstack::rename_command -renamer packagetrace $targetcommand [info args $targetcommand] { |
|
set marg [string repeat { } $::packagetrace::level] |
|
packagetrace::emit "${marg}<extra> tcl_findLibrary $basename $version $patch $initScript $enVarName $varName </extra>\n" |
|
uplevel 1 [list $COMMANDSTACKNEXT $basename $version $patch $initScript $enVarName $varName] |
|
}] |
|
if {[dict get $stackrecord implementation] ne ""} { |
|
set old_tcl_findLibrary [dict get $stackrecord implementation] |
|
puts stderr "packagetrace::init renamed $targetcommand to $old_tcl_findLibrary and is providing an override" |
|
} else { |
|
puts stderr "packagetrace::init failed to rename $targetcommand" |
|
} |
|
|
|
|
|
|
|
set package_command [namespace which package] |
|
set stackrecord [commandstack::rename_command -renamer packagetrace $package_command {subcommand args} { |
|
set tracerlist $::packagetrace::tracerlist |
|
set tracer [lindex $tracerlist end] |
|
if {$tracer eq ""} { |
|
|
|
} |
|
set ch $::packagetrace::chan |
|
set next $COMMANDSTACKNEXT |
|
if {$next ne "$COMMANDSTACKNEXT_ORIGINAL"} { |
|
puts stderr "(packagetrace package) DEBUG - command changed since start: $COMMANDSTACKNEXT_ORIGINAL is now $next" |
|
} |
|
|
|
#cache $ch instead of using upvar, |
|
#because namespace may be deleted during call. |
|
|
|
#!todo - optionally silence Tcl & Tk requires to reduce output? |
|
#if {[lindex $args 0] eq "Tcl"} { |
|
# return [$next $subcommand {*}$args] |
|
#} |
|
switch -exact -- [tcl::prefix::match {files forget ifneeded names prefer present provide require unknown vcompare versions vsatisfies} $subcommand] { |
|
require { |
|
#columns |
|
set c1 [string repeat { } 30] ;#tree col |
|
set c1a " " |
|
set c2 [string repeat { } 20] ;#package name col |
|
set c2a " " ;# close require/present tags |
|
set c3 [string repeat { } 18] ;#version col - must handle v= "999999.0a1.0" without truncation |
|
set c4 [string repeat { } 12] ;#timing col 5 chars of punct leaving remainder for value. |
|
set c5 [string repeat { } 10] ;#module col |
|
set c5a [string repeat { } 3] ;#close result tag col |
|
|
|
#we assume 'package require' API sticks to solo option flags like -exact and is relatively stable. |
|
set argidx 0 |
|
set is_exact 0 |
|
foreach a $args { |
|
if {[string range $a 0 0] ne "-"} { |
|
#assume 1st non-dashed argument is package name |
|
set pkg $a |
|
set v_requirements [lrange $args $argidx+1 end] |
|
#normalize |
|
if {$is_exact} { |
|
set req [lindex $v_requirements 0] ;#only one is allowed for -exact |
|
set v_requirements $req-$req ;#translate to v-v normalised equiv of -exact |
|
} else { |
|
set reqs [list] |
|
foreach req $v_requirements { |
|
lappend reqs [::packagetrace::tm_version_required_canonical $v_requirement] ;#empty remains empty, v -> v-<majorv+1>, leading zeros stripped from all segments. |
|
} |
|
set v_requirements $reqs ;#each normalised |
|
} |
|
set pkg_ [lrange $args $argidx end] ;# raw e.g "Tcl 8.6" or "Tcl 8.5 9" |
|
break |
|
} else { |
|
if {$a eq "-exact"} { |
|
set is_exact 1 |
|
} |
|
} |
|
incr argidx |
|
} |
|
|
|
|
|
incr ::packagetrace::level |
|
if {$::packagetrace::level == 0} { |
|
set packagetrace::output "" |
|
} |
|
|
|
|
|
set marg [string repeat { } $::packagetrace::level] |
|
set margnext [string repeat { } [expr {$::packagetrace::level + 1}]] |
|
|
|
if {![catch {set ver [$next present {*}$args]}]} { |
|
if {$::packagetrace::showpresent} { |
|
#already loaded.. |
|
set f1 [packagetrace::overtype::left $c1 "${marg}<present"] |
|
set f2 [packagetrace::overtype::left -overflow 1 $c2 "p= \"$pkg_\""] ;#disallow truncation! |
|
set f2a $c2a |
|
set f3 [packagetrace::overtype::left $c3 "v= \"$ver\""] |
|
set f4 $c4 |
|
set f5 $c5 |
|
set f5a "/> " |
|
#puts -nonewline $ch $f1$c1a$f2$f2a$f3$f4$f5\n |
|
packagetrace::emit $f1$c1a$f2$f2a$f3$f4$f5$f5a\n |
|
} |
|
} else { |
|
set f1 [packagetrace::overtype::left $c1 "${marg}<require"] |
|
set f2 [packagetrace::overtype::left -overflow 1 $c2 "p= \"$pkg_\""] ;#disallow truncation! |
|
set f2a $c2a |
|
set f3 $c3 |
|
set f4 $c4 |
|
set f5 $c5 |
|
set f5a " > " |
|
#puts -nonewline $ch $f1$c1a$f2$f2a$f3$f4$f5\n |
|
packagetrace::emit $f1$c1a$f2$f2a$f3$f4$f5$f5a\n |
|
|
|
set errMsg "" |
|
#set t0 [clock clicks -milliseconds] |
|
set t0 [clock microseconds] |
|
|
|
if {[catch {set ver [$next require {*}$args]} errMsg]} { |
|
set ver "" |
|
# |
|
#NOTE error must be raised at some point - see below |
|
} |
|
#set t [expr {[clock clicks -millisec]-$t0}] |
|
set t [expr {([clock microseconds]-$t0)/1000.0}] |
|
|
|
|
|
|
|
|
|
#jmn |
|
set f1 [packagetrace::overtype::left $c1 "${margnext}<info "] |
|
#set f1a "<info " |
|
set f1a "" |
|
|
|
set f2 [packagetrace::overtype::left -ellipsis 1 [string range $c2 0 end-1] "x= \"$args"] |
|
if {[string length [string trimright $f2]] <= [expr [string length $c2]-1]} { |
|
#right-trimmed value shorter than field.. therefore we need to close attribute |
|
set f2 [packagetrace::overtype::left $c2 [string trimright $f2]\"] |
|
} |
|
|
|
#we use the attributename x because this is not necessarily the same as p! may be truncated. |
|
|
|
set f3 [packagetrace::overtype::left $c3 "v= \"$ver\""] |
|
|
|
#truncate time to c4 width - possibly losing some precision. If truncated - add closing double quote. |
|
set f4 [packagetrace::overtype::left -overflow 1 $c4 "t= \"[lrange $t 0 1]\""] |
|
if {[string length [string trimright $f4]] > [expr {[string length $c4]}]} { |
|
set f4 "[packagetrace::overtype::left [string range $c4 0 end-1] [string trimright $f4]]\"" |
|
} |
|
|
|
if {[string length $ver]} { |
|
set num "" |
|
foreach c [split $ver ""] { |
|
if {[string is digit $c] || $c eq "."} { |
|
append num $c |
|
} else { |
|
break |
|
} |
|
} |
|
set ver $num |
|
|
|
#review - scr not guaranteed to be valid tcl list - should parse properly? |
|
set scr [$next ifneeded $pkg $ver] |
|
if {[string range $scr end-2 end] ne ".tm"} { |
|
set f5 $c5 |
|
} else { |
|
#!todo - optionally output module path instead of boolean? |
|
#set f5 [packagetrace::overtype::left -ellipsis 1 -ellipsistext ... [string range $c5 0 end-1] "tm= \"[lindex $scr end]"] |
|
set f5 [packagetrace::overtype::left -ellipsis 1 -ellipsistext ... [string range $c5 0 end-1] "tm= \"1"] |
|
if {[string length [string trimright $f5]] <= [expr [string length $c5]-1]} { |
|
set f5 [packagetrace::overtype::left $c5 [string trimright $f5]\"] |
|
} |
|
} |
|
} else { |
|
set f5 $c5 |
|
} |
|
|
|
set f5a [packagetrace::overtype::left $c5a "/>"] ;#end of <info |
|
#puts -nonewline $ch "$f1$c1a$f2$c2a$f3$f4 $f5$f5a\n" |
|
packagetrace::emit "$f1$c1a$f2$c2a$f3$f4 $f5$f5a\n" |
|
|
|
|
|
set f1 [packagetrace::overtype::left $c1 "${marg}</require>"] |
|
set f1a "" |
|
set f2 "" |
|
set c2a "" |
|
set f3 "" |
|
set f4 "" |
|
set f5 "" |
|
set f5a "" |
|
#puts -nonewline $ch $f1$f1a$f2$c2a$f3$f4$f5$f5a\n |
|
packagetrace::emit $f1$f1a$f2$c2a$f3$f4$f5$f5a\n |
|
|
|
|
|
if {![string length $ver]} { |
|
if {[lindex $args 0] eq "packagetrace"} { |
|
#REVIEW - what is going on here? |
|
namespace delete ::packagetrace::overtype |
|
} |
|
|
|
#we must raise an error if original 'package require' would have |
|
incr ::packagetrace::level -1 |
|
error $errMsg |
|
} |
|
|
|
} |
|
incr ::packagetrace::level -1 |
|
return $ver |
|
} |
|
vcompare - vsatisifies - provide - ifneeded { |
|
set result [$next $subcommand {*}$args] |
|
#puts -nonewline $ch " -- package $subcommand $args\n" |
|
return $result |
|
} |
|
default { |
|
set result [$next $subcommand {*}$args] |
|
#puts $ch "*** here $subcommand $args" |
|
return $result |
|
} |
|
} |
|
|
|
}] |
|
if {[set stored_target [dict get $stackrecord implementation]] ne ""} { |
|
puts stderr "packagetrace::init renamed $package_command to $stored_target and is providing an override" |
|
set f1 [string repeat { } 30] |
|
#set f1a " " |
|
set f1a "" |
|
set f2 [packagetrace::overtype::left [string repeat { } 20] "PACKAGE"] |
|
set f2a " " |
|
set f3 [packagetrace::overtype::left [string repeat { } 15] "VERSION"] |
|
set f4 [packagetrace::overtype::left [string repeat { } 12] "LOAD-ms"] |
|
set f5 [packagetrace::overtype::left [string repeat { } 10] "MODULE"] |
|
|
|
#puts -nonewline $::packagetrace::chan "-$f1$f1a$f2$f2a$f3$f4$f5\n" |
|
#packagetrace::emit "-$f1$f1a$f2$f2a$f3$f4$f5\n" |
|
puts -nonewline stderr "-$f1$f1a$f2$f2a$f3$f4$f5\n" |
|
unset f1 f1a f2 f2a f3 f4 f5 |
|
} else { |
|
puts stderr "packagetrace::init failed to rename $package_command" |
|
} |
|
} |
|
} |
|
} |
|
|
|
|
|
|
|
#The preferred source of the ::overtype::<direction> functions is the 'overtype' package |
|
# - pasted here because packagetrace should have no extra dependencies. |
|
# - overtype package has better support for ansi and supports wide chars |
|
namespace eval packagetrace::overtype {set version INLINE} |
|
|
|
namespace eval packagetrace::overtype { |
|
proc left {args} { |
|
# @c overtype starting at left (overstrike) |
|
# @c can/should we use something like this?: 'format "%-*s" $len $overtext |
|
|
|
if {[llength $args] < 2} { |
|
error {usage: ?-overflow [1|0]? ?-ellipsis [1|0]? ?-ellipsistext ...? undertext overtext} |
|
} |
|
foreach {undertext overtext} [lrange $args end-1 end] break |
|
|
|
set opt(-ellipsis) 0 |
|
set opt(-ellipsistext) {...} |
|
set opt(-overflow) 0 |
|
array set opt [lrange $args 0 end-2] |
|
|
|
|
|
set len [string length $undertext] |
|
set overlen [string length $overtext] |
|
set diff [expr {$overlen - $len}] |
|
if {$diff > 0} { |
|
if {$opt(-overflow)} { |
|
return $overtext |
|
} else { |
|
if {$opt(-ellipsis)} { |
|
return [right [string range $overtext 0 [expr {$len -1}]] $opt(-ellipsistext)] |
|
} else { |
|
return [string range $overtext 0 [expr {$len -1}]] |
|
} |
|
} |
|
} else { |
|
|
|
return "$overtext[string range $undertext $overlen end]" |
|
} |
|
} |
|
|
|
proc centre {args} { |
|
if {[llength $args] < 2} { |
|
error {usage: ?-bias [left|right]? ?-overflow [1|0]? undertext overtext} |
|
} |
|
foreach {undertext overtext} [lrange $args end-1 end] break |
|
|
|
set opt(-bias) left |
|
set opt(-overflow) 0 |
|
array set opt [lrange $args 0 end-2] |
|
|
|
|
|
set olen [string length $overtext] |
|
set ulen [string length $undertext] |
|
set diff [expr {$ulen - $olen}] |
|
if {$diff > 0} { |
|
set half [expr {round(int($diff / 2))}] |
|
if {[string match right $opt(-bias)]} { |
|
if {[expr {2 * $half}] < $diff} { |
|
incr half |
|
} |
|
} |
|
|
|
set rhs [expr {$diff - $half - 1}] |
|
set lhs [expr {$half - 1}] |
|
|
|
set a [string range $undertext 0 $lhs] |
|
set b $overtext |
|
set c [string range $undertext end-$rhs end] |
|
return $a$b$c |
|
} else { |
|
if {$diff < 0} { |
|
if {$opt(-overflow)} { |
|
return $overtext |
|
} else { |
|
return [string range $overtext 0 [expr {$ulen - 1}]] |
|
} |
|
} else { |
|
return $overtext |
|
} |
|
} |
|
} |
|
|
|
proc right {args} { |
|
if {[llength $args] < 2} { |
|
error {usage: ?-overflow [1|0]? undertext overtext} |
|
} |
|
lassign [lrange $args end-1 end] undertext overtext |
|
|
|
set opt(-overflow) 0 |
|
array set opt [lrange $args 0 end-2] |
|
|
|
set olen [string length $overtext] |
|
set ulen [string length $undertext] |
|
|
|
if {$opt(-overflow)} { |
|
return [string range $undertext 0 end-$olen]$overtext |
|
} else { |
|
if {$olen > $ulen} { |
|
set diff [expr {$olen - $ulen}] |
|
return [string range $undertext 0 end-$olen][string range $overtext 0 end-$diff] |
|
} else { |
|
return [string range $undertext 0 end-$olen]$overtext |
|
} |
|
} |
|
} |
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
proc packagetrace::deinit {} { |
|
packagetrace::disable |
|
#namespace delete packagetrace |
|
#package forget packagetrace |
|
} |
|
proc packagetrace::disable {} { |
|
::commandstack::remove_rename {::tcl_findLibrary packagetrace} |
|
::commandstack::remove_rename {::package packagetrace} |
|
} |
|
proc packagetrace::enable {} { |
|
#init doesn't clear state - so this is effectively an alias |
|
tailcall packagetrace::init |
|
} |
|
|
|
#clear state - reset to defaults |
|
proc packagetrace::clear {} { |
|
variable chan |
|
set chan stderr |
|
variable showpresent |
|
set showpresent 1 |
|
} |
|
|
|
package provide packagetrace [namespace eval packagetrace { |
|
set version 0.8 |
|
}] |
|
|
|
|
|
|