[AMW] 2011-11-27 I used the technique described in [Steppin' out] and [A basic debugger] for yet another approach to debugging. [TkCon] already contains an interactive debugger that can be invoked by instrumenting your script with calls to '''idebug break''' [http://tkcon.sourceforge.net/docs/idebug.html]. While this already is a very helpful tool, it requires modification of your existing code whenever you want to set a new breakpoint. With the script shown below, you can use the command '''bpadd''' ''procname'' to add a breakpoint at every call to ''procname'' without changing your code. As soon as you run your code and ''procname'' is called, the interactive debugger is started. Type '''?''' to get idebug's menu, '''c''' to proceed until the next call to ''procname'', or use any other existing command or feature of '''idebug'''. Moreover, you can call '''s''' to 'step into' the intercepted proc, or '''r''' to return from it and see the results it produced. ---- ====== #=============================================================================== # This is an extension to the 'idebug' command in tkcon.tcl #=============================================================================== #------------------------------------------------------------------------------- # bpadd # add a breakpoint for calls to 'procname' #------------------------------------------------------------------------------- proc bpadd { procname } { global BP set BP($procname,step) 0 trace add execution $procname enter "BREAKPOINT $procname" trace add execution $procname enterstep "BREAKPOINT $procname" trace add execution $procname leave "BREAKPOINT $procname" idebug on } #------------------------------------------------------------------------------- # bplist # return a list of active breakpoints #------------------------------------------------------------------------------- proc bplist { } { global BP set procs "" foreach item [array names BP "*,step"] { regsub {,step$} $item "" procname lappend procs $procname } return [lsort $procs] } #------------------------------------------------------------------------------- # bpdel # delete breakpoint from calls to 'procname' # if procname is not given, it defaults to the 'current' breakpoint #------------------------------------------------------------------------------- proc bpdel { { procname "" } } { global BP if { $procname == "" } { set procname $BP(procname) } trace remove execution $procname enter "BREAKPOINT $procname" trace remove execution $procname enterstep "BREAKPOINT $procname" trace remove execution $procname leave "BREAKPOINT $procname" catch { unset BP($procname,step) } } #------------------------------------------------------------------------------- # dbgStep # step into procname, i.e. call idebug at trace 'enterstep' #------------------------------------------------------------------------------- proc dbgStep { { procname "" } } { global BP IDEBUG if { $procname == "" } { set procname $BP(procname) } set BP($procname,step) 2 # The following statement causes idebug to continue, but this requires # a small modification in tkcon.tcl (line 4287 in Tkcon 2.5): # in proc 'idebug' in the switch handling $opt="break", replace # 'while 1' for the input loop with 'while { $IDEBUG(debugging) }' set IDEBUG(debugging) 0 return "" } #------------------------------------------------------------------------------- # dbgReturn # return from procname #------------------------------------------------------------------------------- proc dbgReturn { { procname "" } } { global BP IDEBUG if { $procname == "" } { set procname $BP(procname) } set BP($procname,step) 1 set IDEBUG(debugging) 0 return "" } #------------------------------------------------------------------------------- # shortcuts for use within 'idebug': # s - step into proc # r - return from proc #------------------------------------------------------------------------------- proc s { args } { dbgStep {*}$args } proc r { args } { dbgReturn {*}$args } #------------------------------------------------------------------------------- # dumpstr - dump str in the most readable way, # replacing non-printable characters with their hex-code written as "\xXX" #------------------------------------------------------------------------------- proc dumpstr { str } { set result "" while { $str != "" } { if { [regexp -indices {^[-+*/%<=>.,:;|~^°`´!$&@(){}\[\]#'"A-Z_a-z0-9]+} $str igood] } { # " readable characters, excluding backslash append result [string range $str 0 [lindex $igood 1]] set str [string range $str [lindex $igood 1]+1 end] } if { $str != "" } { set char [string index $str 0] set str [string range $str 1 end] if { $char == "\\" } { append result {\\} } else { binary scan $char c hex append result [format "\\x%02X" [expr $hex & 0xff]] } } } append result $str return $result } #------------------------------------------------------------------------------- # BREAKPOINT handler #------------------------------------------------------------------------------- proc BREAKPOINT { procname cmd args } { global BP set BP(procname) $procname set op [lindex $args end] set dbg 1 if { $op == "enter" } { puts stderr "# $cmd\nBREAKPOINT @ $procname $op" } elseif { $op == "enterstep" && $BP($procname,step) >= 2 } { puts stderr "# $cmd\nBREAKPOINT @ $procname step" } elseif { $op == "leave" && $BP($procname,step) >= 1 } { set code [lindex $args 0] set result [lindex $args 1] puts stderr "# $cmd\nBREAKPOINT @ $procname leave (code $code, result \"[dumpstr $result]\")" } else { set dbg 0 } if { $dbg } { set BP($procname,step) 0 uplevel idebug break } } #=============================================================================== # end of file #=============================================================================== ====== Of course, this could be added to tkcon.tcl in order to fully intergrate with '''idebug'''. <>Debugging