**Using the 'filter' subcommand to trace class method calls** [dzach]: For this code I've used [Tclkit] 8.6b1 (from [Pat Thoyts]'s bleeding-edge http://www.patthoyts.tk/tclkit/linux-ix86/8.6-beta/%|%builds%|%) that comes with [TclOO] in the core. Additions and corrections are welcome. ---- === # When used inside a proc, 'calledby' returns the name of the caller of that proc. # This auxiliary proc is used to trace callers originating outside of class methods: # proc ::calledby {} { set level [expr [info leve] - 2] if { $level > 0 } { return [lindex [info level $level ] 0] } else { if { [string length [info script] ] > 0 } { return [info script] } else { return [info nameofexecutable] } } } # # The OO portion # namespace import ::oo::* catch {Trace destroy} class create Trace { self export varname filter Trace variable var_ constructor args { my eval upvar [[self class] varname var_ ] var_ if {! [info exists var_ ] } { set var_(defaults) { trace on history {} length 20 methods {} mode exclude print off} array set var_ $var_(defaults) } next {*}$args } method Trace args { if {[lindex [self target] 0] eq "::oo::object"} { return [next {*}$args] } my variable var_ if {! $var_(trace)} { return [next {*}$args] } set caller {} if {[catch { set caller [lrange [self caller] 1 end] }]} { set caller [calledby] } set meth [lindex [self target] 1] set i [list $caller [self] $meth $args] if {[string match "in*" $var_(mode)] && $meth ni $var_(methods) || \ ![string match "in*" $var_(mode)] && ($meth in $var_(methods) || $meth eq "trace" || $meth eq "print") } { return [next {*}$args] } if {$var_(print)} { my print $i } set var_(history) [lrange [lappend var_(history) $i] end-$var_(length) end] next {*}$args } method trace args { my variable var_ while {$args ne {}} { set opt [lindex $args 0] if {[string index $opt 0] ne "-"} break set i 1 switch -glob -- $opt { -on - -of* { set var_(trace) [string range $opt 1 end] } -le* { set var_(length) [lindex $args $i] incr var_(length) -1 set var_(history) [lrange $var_(history) end-$var_(length) end] incr i } -me* { set var_(methods) [lindex $args $i] ; incr i } -mo* { set var_(mode) [lindex $args $i] ; incr i } -cl* { set var_(history) {} } -re* { array set var_ $var_(defaults) } -pr* {set var_(print) [lindex $args $i] ;incr i } default { error "unknown or ambiguous option $opt : may be any of -on, -off, -methods, -mode, -clear, reset or -print" } } incr i $i set args [lrange $args $i end] } if {! $var_(trace)} { return "History is turned off. Try \"[self] trace on\" to turn it on" } foreach i $var_(history) { my print $i } } method print args { if {$args eq {}} return lassign {*}$args caller inst meth arg if {$arg ne {}} { set arg "\n\targs = $arg" } puts [join "$caller -> $inst $meth"]$arg } } === ***Usage:*** Include 'mixin Trace' in the definition of a class. Output is sent to stdout using 'puts'. Use any of the following commands: * ''obj'' '''trace''' ''? -on ? ? -off ?'' : turns tracing on/off. Default is '''off'''. * ''obj'' '''trace''' ''? -clear ?'' : clears the history buffer. * ''obj'' '''trace''' ''? -length integer ?'' : limits the number of history items to ''integer''. Default history length is '''20'''. * ''obj'' '''trace''' ''? -methods list ?'' : list of methods to include/exclude, depending on ''-mode''. The default is an '''empty''' list. * ''obj'' '''trace''' ''? -mode include | exclude ?'' : ''include'' mode traces only methods incuded in ''-methods list'' while ''exclude'' mode traces all methods except those in the ''-methods list''. Default mode is '''exclude'''. Methods ''trace'' and ''print'' of class ''Trace'' are not traced. * ''obj'' '''trace''' ''? -print ? on ? ? -off ?'' : turns trace output during program execution on/off. Default is '''off'''. * ''obj'' '''trace''' ''? -reset'' : resets tracing to the default values. ***Demonstration:*** === # create a test class: % class create c { mixin Trace constructor {} {my variable cnt; set cnt 0} method get {} {my variable cnt;puts $cnt} method incr {} {my variable cnt;incr cnt} } ::c # create an instance of the class % c create t ::t # produce some output % t incr 1 % t get 1 # see the trace % t trace bin/tclkit8.6 -> ::t incr bin/tclkit8.6 -> ::t get # the default mode is 'exclude', so by setting '-methods incr' we exclude 'incr' from being traced % t trace -methods incr % t incr 2 % t get 2 % t trace bin/tclkit8.6 -> ::t incr bin/tclkit8.6 -> ::t get bin/tclkit8.6 -> ::t get <-- 'incr' was not traced # by changing mode to 'include', the previously set '-methods incr' will leave 'incr' as the only method to trace % t trace -mode include % t incr 3 % t get 3 % t trace bin/tclkit8.6 -> ::t incr bin/tclkit8.6 -> ::t get bin/tclkit8.6 -> ::t get bin/tclkit8.6 -> ::t incr <-- 'get' was not traced # limit the length of trace history items % t trace -length 2 bin/tclkit8.6 -> ::t get bin/tclkit8.6 -> ::t incr # reset the values to the defaults % t trace -reset # turn on printing of traces during execution % t trace -print on % t incr bin/tclkit8.6 -> ::t incr 4 % t get bin/tclkit8.6 -> ::t get 4 % t trace bin/tclkit8.6 -> ::t incr bin/tclkit8.6 -> ::t get === <>Object Orientation