namespace eval ::try {
namespace export try
variable bodyMatch { \("uplevel" body line}; # Note: must be FOUR spaces
variable usage {unknown keyword "%s" to try: should be "try body ?catch matcher body ...? ?finally body?"}
# Some code that is factorised out. It runs the given script in the context of our
# caller's caller and, if that call generates an error, removes the extra junk inserted
# into the error trace due to this. All results are passed back by setting variables
# in our caller's context...
# The part argument gives the part of the error trace to insert into the error trace
# in the case of an error occurring so as to indicate what the context of the error
# w.r.t. the try command really is.
proc helper {script part {eiv ei} {ecv ec} {codev code} {msgv msg}} {
global errorInfo errorCode
variable bodyMatch
upvar 1 $eiv ei $ecv ec $codev code $msgv msg
set code [catch [list uplevel 2 $script] msg]; # Note: unusual uplevel parameter
set ec $errorCode
set lines [split $errorInfo "\n"]
if {$code == 1} {
while {![regexp $bodyMatch [lindex $lines end]]} {
set lines [lrange $lines 0 [expr {[llength $lines]-2}]]
}
regsub {"uplevel" body} [lindex $lines end] $part fixed
set lines [lrange $lines 0 [expr {[llength $lines]-2}]]
lappend lines $fixed
}
set ei [join $lines "\n"]
}
# The main command's implementation (see example for syntax.)
proc try {body args} {
# First, parse apart the args. This is relatively straight-forward
set hasFinally 0
set catches {}
for {set i 0} {$i<[llength $args]} {incr i} {
set word [lindex $args $i]
if {![string compare $word catch]} {
if {$i+1 >= [llength $args]} {
return -code error "missing matcher to catch"
} elseif {$i+2 >= [llength $args]} {
return -code error "missing body to catch"
}
lappend catches [lindex $args [incr i]]
lappend catches [lindex $args [incr i]]
} elseif {![string compare $word finally]} {
if {$i+1 >= [llength $args]} {
return -code error "missing body to finally"
}
set finally [lindex $args [incr i]]
set hasFinally 1
} else {
variable usage
return -code error [format $usage $word]
}
}
# Now evaluate the body. This updates variables "code", "ei", "ec" and "msg"
# with the result code, the error trace, the error detail and the returned value
# respectively...
helper $body "try body"
# Handle errors, if there were any. Note that if an error does occur and gets
# handled, the details of what the error was are lost as part of the processing.
# Doing something more sophisticated is left as an exercise to the reader...
if {$code == 1} {
foreach {matcher handler} $catches {
if {[string match $matcher $ec]} {
helper $handler "catch \"$matcher\" body"
break
}
}
}
# Do the finally clause. This only wipes out the result information if the clause
# causes an error. Otherwise, the clause has no effect. In particular, you cannot
# (successfully) use return, break or continue in a finally clause.
if {$hasFinally} {
helper $finally "finally clause" a b c d
if {$c} {
set ei $a
set ec $b
set code $c
set msg $d
}
}
# Now we can return. Phew!
return -code $code -errorinfo $ei -errorcode $ec $msg
}
}
namespace import ::try::try
