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