#<<<<<<<<<<<< Debug >>>>>>>>>>>>>>#
# Copyright (c) 2002 Edwin A. Suominen, http://eepatents.com # This script is licensed under either (your choice) the GNU # Public License as promulgated at the time of this # posting by the Free Software Foundation, or the Attribution # Assurance License under which the author's PRIVARIA software is # distributed ( http://www.privaria.org ), both licenses being # incorporated herein by reference. #
# This proc requires Tk and the tcllib cmdline package.
#
proc d { args } {
set optList {clear done start.arg row.arg}
while { [::cmdline::getopt args $optList x y ] == 1 } {
set $x $y }
if { [info exists done] } {
catch {destroy .debug}
return
} elseif { [info exists clear] } {
catch {destroy .debug}
idle 1
}
if { ![winfo exists .debug] } {
toplevel .debug
text .debug.m -width 80 -height 30 \
-font {Courier 9} -tabs {1c left 1.5c left}
scrollbar .debug.s -orient vertical -command {.debug.m yview}
pack .debug.m .debug.s -side left -fill y
foreach {i} {A B C D} {j} {Black Grey Blue Red} {
.debug.m tag configure $i -foreground $j \
-lmargin2 1.5c -wrap word
}
.debug.m tag configure A -spacing1 10
}
set varString {}
foreach {i} $args {
set err [catch { uplevel [list set $i] } x ]
if {$err} { set x NDEF }
set varString "$varString $i=$x"
}
set textList [list "\t:\t" B [info level -1] C " : " B $varString D]
set sec [expr {[clock seconds] % 1000}]
if { [info exists row] } {
.debug.m delete $row.0 [expr {$row+1}].0
eval [concat .debug.m insert $row.0 $sec A $textList \\n]
} else {
set blanks [string repeat {\n} [expr { [info exists start] ? 6 : 1 }] ]
eval [concat .debug.m insert end "$blanks$sec" A $textList]
}
### END DEBUG
return
}
[Edwin, even a single example use would help a lot.]