Posted to tcl by mjanssen at Thu Oct 26 10:13:32 GMT 2006view pretty
namespace eval debug { namespace export breakpoint proc breakpoint {args} { puts "bp"} proc _trigger {command op} { puts "breakpoint: [lindex $command end]" set clevel [uplevel 1 {info level}] set proc [lindex [uplevel 1 "info level 0"] 0] while 1 { puts -nonewline "(level #${clevel}) > " flush stdout gets stdin cmd if {$cmd ne "c"} { catch {puts [uplevel 1 $cmd]} err if {$err ne "" } { puts $err } } else {break} } } proc on {} { trace add execution breakpoint enter ::debug::_trigger } proc off {} { trace remove execution breakpoint enter ::debug::_trigger } } package provide debug 0.1 #Test package require debug proc test {a} { ::debug::breakpoint $a puts $a } ::debug::on test 5 ::debug::off test 6