PYK 2015-11-08: procstep is a drop-in replacement for proc that evaluates one command of a procedure body at at time, and a hook to inspect and manipulate the command before it is evaluated, and another to react to return conditions of the evaluation. It requires scriptSplit and nocomments. These commands are also available as ycl proc tcl step.
rename proc ::tcl::proc
::tcl::proc proc {name args body} {
::uplevel [::list ::tcl::proc $name $args [::list apply [::list args [
::string map [::list {${body}} [::list $body]] {
::foreach command [::scriptSplit ${body}] {
set status [
::catch [::list ::uplevel 1 [
::cmdhandler $command]] cres copts]
::if {$status} {
::tailcall ::errorhandler $status $cres $copts
}
}
lindex $cres
}
]] [uplevel {namespace current}]]]
}
::tcl::proc cmdhandler command {
::puts stderr [::list {now executing} $command in [
uplevel {namespace current}]]
return $command
}
::tcl::proc errorhandler {code cres copts} {
::puts stderr [list {got an error} $cres]
#puts [uplevel info locals]
tailcall return -code $code -options $copts $cres
}Here is a variant that improves runtime performance quite a bit by rewriting each command of the body when the procedure is created. This leaves no private space for catch to create its output variables in, so it stuffs them into $::tcl::cres and ::tcl::copts instead instead:
::tcl::proc proc {name args body} {
set newbody {}
::foreach command [nocomments [scriptSplit $body]] {
::append newbody [string map [list {${command}} [list $command]] {
set ::tcl::ccode [
::catch {{*}[
::cmdhandler ${command}]} ::tcl::cres ::tcl::copts]
::if {$::tcl::ccode} {
::errorhandler $::tcl::ccode $::tcl::cres $::tcl::copts
} else {
::lindex $::tcl::cres
}
}]
}
::uplevel [::list ::tcl::proc $name $args $newbody]
}
::tcl::proc cmdhandler command {
::puts stderr [::list {now executing} $command]
return $command
}
::tcl::proc errorhandler {code cres copts} {
::puts stderr [list {got an error} $cres]
#puts [uplevel info locals]
tailcall return -code $code -options $copts $cres
}