#<<<<<<<<<<<< D[ebug] >>>>>>>>>>>>>># # 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. # package require Tcl package require Tk package require cmdline 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 } 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.s -side right -fill y pack .debug.m -expand 1 -side left -fill both 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 } if { [info exists clear] } { .debug.m clear 1.0 end } 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 [expr {[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 } ---- '''Usage Example:''' set thisVar 1 set thatVar 2 set anotherVar 3 d thisVar thatVar anotherVar The debug window will add an entry with thisVar=1, thatVar=2, anotherVar=3 ---- d -done close window d -clear clear textarea d -start arg start new block (insert newlines) d -row arg ---- '''2007-09-08''' osalcescu: I find it usefull, thanks. Got an error when tried the d- clear option. Replaced: ---- .debug.m clear 1.0 end ---- with ---- .debug.m delete 1.0 end ---- and it worked like a charm. Noticed that for arrays one has to specify the array index to make it show. ---- [[ [Category Debugging] ]]