JBR - 2014-02-19

Here is a little trace proc helper that I often use when I'm scratched my head and cannot understand why the code does what it does.

------------------------------

Usage:

Use the plus and minus options to add and exclude procs you would like to trace to the debugging printout.   Use the equals option to add procs that are defined in the future to debugging print out.


 traceproc  + <add pattern> - <exclude pattern>
 traceproc = <proc pattern>

--------------------------------


 proc traceproc-print { args } { puts $args }

 set traceprocExclude {}

 proc traceproc-add   { patt proc op args } {
    lassign $proc type proc args body

    if { [string match $patt $proc] } {
        foreach excl $::traceprocExclude {
            if { [string match $excl $proc] } {
                return
            }
        }

        trace add execution $proc { enter leave } traceproc-print
    }
 }

 proc traceproc { args } {
    set procs {}

    foreach { op pattern } $args {
        switch $op {
         + { lappend procs {*}[info commands $pattern] }
         - {
            intersect3 $procs [info commands $pattern] in1 in2 inB
            set procs $in1

            lappend ::traceprocExclude $pattern
         }

         = { trace add execution proc leave "traceproc-add $pattern" }
        }
    }

    intersect3 $procs "trace traceproc-print puts ::puts" in1 in2 inB
    set procs $in1

    foreach proc $procs {
        trace add execution $proc { enter leave } traceproc-print
    }
 }


 # Modified to combine the call by name and returned list of 3 lists API.
 #
 proc intersect3 { list1 list2 { inList1 {} } { inList2 {} } { inBoth {} } } {
    if { $inList1 ne {} } {
        upvar $inList1 in1
        upvar $inList2 in2
        upvar $inBoth  inB
    }

    set in1 [list]
    set in2 [list]
    set inB [list]

    set list1 [lsort $list1]
    set list2 [lsort $list2]

    # Shortcut for identical lists is faster
    if { $list1 == $list2 } {
        set inB $list1
    } else {
        set i 0
            foreach element $list1 {
                if {[set p [lsearch [lrange $list2 $i end] $element]] == -1} {
                    lappend in1 $element
                } else {
                    if { $p > 0 } {
                        set e [expr {$i + $p -1}]
                            foreach entry [lrange $list2 $i $e] {
                                lappend in2 $entry
                            }
                        incr i $p
                    }
                    incr i
                        lappend inB $element
                }
            }
        foreach entry [lrange $list2 $i end] {
            lappend in2 $entry
        }
    }

    return [list $in1 $in2 $inB]
 } ;# David Easton