Updated 2012-12-16 05:50:35 by pooryorick
 #<<<<<<<<<<<< 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
 }

Example  edit

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

Discussion  edit

osalcescu 2007-09-08: I find it useful, 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.