01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62

proc traceonce {proc {level -1}} {
    trace add execution $proc {enter leave enterstep leavestep} [list debugger $proc 1 $level]
}
proc traceon {proc {level -1}} {
    trace add execution $proc {enter leave enterstep leavestep} [list debugger $proc 0 $level]
}
proc traceoff {proc {level -1}} {
    trace remove execution $proc {enter leave enterstep leavestep} [list debugger $proc 0 $level]
}
proc indent {cmd dir} {
    if {![info exists ::indent($cmd)]} {
        set ::indent($cmd) 0
    }
    set old $::indent($cmd)
    set new [incr ::indent($cmd) $dir]
    set i [expr {$dir == 1 ? 2*$new : 2*$old}]
    string repeat " " $i
}
proc res2str {res} {
    switch -exact -- $res {
        0 { return "ok" }
        1 { return "error" }
        2 { return "return" }
        3 { return "break" }
        4 { return "continue" }
        default { return "errcode $res" }
    }
}
proc debugger {proc once maxlevel cmd args} {
    set op [lindex $args end]
    foreach word $cmd {
        if {[string length $word] > 50} {
            lappend words "[string range $word 0 49]<...>"
        } else {
            lappend words $word
        }
    }
    set cmd $words
    if {[string length $cmd] > 250} {
        set cmd [string range $cmd 0 249]<...>
    }
    switch -exact -- $op {
        enter -
        enterstep {
            set indent [indent $proc +1]
            if {$maxlevel == -1 || [string length $indent]/2 <= $maxlevel} {
                putloglev 6 * "DEBUG ($proc): $indent ${op} \[$cmd\]"
            }
        }
        leave -
        leavestep {
            set indent [indent $proc -1]
            lassign $args res resstr
            if {$maxlevel == -1 || [string length $indent]/2 <= $maxlevel} {
                putloglev 6 * "DEBUG ($proc): $indent ${op} \[$cmd\] = ([res2str $res]) {$resstr}"
            }
        }
    }
    if {$op eq "leave" && $once} {
        trace remove execution [lindex $cmd 0] {enter leave enterstep leavestep} [list debugger $proc $once $maxlevel]
    }
}