**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 builds [http://www.patthoyts.tk/tclkit/linux-ix86/8.6-beta/]) 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 level] - 2}]
        if { $level > 0 } {
                return [lindex [info level $level ] 0] 
        } else {
                if { [info script] ne {} } {
                        return [info script]
                } else {
                        return [info nameofexecutable]
                }
        }        
}
#
# The OO portion
#
namespace import ::oo::*
catch {Trace destroy}
class create Trace {
        self export varname
        filter Trace

        # var_ is a class variable
        variable var_

        constructor args {

                # link instance var_ to the class variable var_ for global trace. Comment out for class-instance-wide trace
                my eval upvar [[self class] varname var_ ] var_

                # Initialize default values, but only when the first instance gets created. 
                # Subsequent instances will use the existing values
                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 {
                # avoid tracing of system methods
                if {[lindex [self target] 0] eq "::oo::object"} { return [next {*}$args] }
                if {! $var_(trace)} { return [next {*}$args] }
                set caller {}

                # [self caller] returns error when used outside a class, but we need to trace method calls
                #   that originate outside the class, from a normal proc or a console
                if {[catch {
                        set caller [lrange [self caller] 1 end]
                }]} {
                        # outside caller
                        set caller [calledby]
                }
                set meth [lindex [self target] 1]

                # form a trace data item
                set i [list $caller [self] $meth $args]

                # method filter
                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]
                }

                # print trace item along with execution
                if {$var_(print)} { my print $i }

                # save trace item in history and limit history's length
                set var_(history) [lrange [lappend var_(history) $i] end-$var_(length) end]
                next {*}$args
        }
        method trace args {
                while {[llength $args]} {
                        set opt  [lindex $args 0]

                        # parse options

                        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 {![llength $args]} return
                lassign {*}$args caller inst meth arg
                if {$arg ne {}} { set arg "\n\targs = $arg" }

                # print a trace item
                puts [join "$caller -> $inst $meth"]$arg
        }
}
======
----
***Usage:***

Include '''mixin Trace''' in the definition of a class, to trace calls to class methods. Trace is global, i.e. it traces method calls originating from any class using it, so that interactions between objects can be monitored in the same output. By changing class variable ''var_'' to an instance variable, e.g. by commenting out `my eval upvar [[self class] varname var_ ] var_`, the behaviour can change to class-instance-wide trace, i.e. each instance will have its own trace history. 

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 incr
2
% t get
2
# see the trace
% t trace
bin/tclkit8.6 -> ::t incr
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
3
% t get
3
% t trace
bin/tclkit8.6 -> ::t incr
bin/tclkit8.6 -> ::t get
bin/tclkit8.6 -> ::t get  <-- 'incr' was not traced, but the 'get' following it was
======

<<categories>>Object Orientation