# Do nothing if the try command exists already (8.6+). if {[llength [info commands try]]} return # The code below was snarfed from the Tcl core, as a forward # compatible implementation of try/catch/finally for Tcl 8.5. # TIP #329: [try] # This is a *temporary* implementation, to be replaced with one in C and # bytecode at a later date before 8.6.0 namespace eval ::tcl::control { # These are not local, since this allows us to [uplevel] a [catch] rather # than [catch] the [uplevel]ing of something, resulting in a cleaner # -errorinfo: variable em {} variable opts {} variable magicCodes { ok 0 error 1 return 2 break 3 continue 4 } namespace export try # ::tcl::control::try -- # # Advanced error handling construct. # # Arguments: # See try(n) for details proc try {args} { variable magicCodes # ----- Parse arguments ----- set trybody [lindex $args 0] set finallybody {} set handlers [list] set i 1 while {$i < [llength $args]} { switch -- [lindex $args $i] { "on" { incr i set code [lindex $args $i] if {[dict exists $magicCodes $code]} { set code [dict get $magicCodes $code] } elseif {![string is integer -strict $code]} { set msgPart [join [dict keys $magicCodes] {", "}] error "bad code '[lindex $args $i]': must be\ integer or \"$msgPart\"" } lappend handlers [lrange $args $i $i] \ [format %d $code] {} {*}[lrange $args $i+1 $i+2] incr i 3 } "trap" { incr i if {![string is list [lindex $args $i]]} { error "bad prefix '[lindex $args $i]':\ must be a list" } lappend handlers [lrange $args $i $i] 1 \ {*}[lrange $args $i $i+2] incr i 3 } "finally" { incr i set finallybody [lindex $args $i] incr i break } default { error "bad handler '[lindex $args $i]': must be\ \"on code varlist body\", or\ \"trap prefix varlist body\"" } } } if {($i != [llength $args]) || ([lindex $handlers end] eq "-")} { error "wrong # args: should be\ \"try body ?handler ...? ?finally body?\"" } # ----- Execute 'try' body ----- variable em variable opts set EMVAR [namespace which -variable em] set OPTVAR [namespace which -variable opts] set code [uplevel 1 [list ::catch $trybody $EMVAR $OPTVAR]] if {$code == 1} { set line [dict get $opts -errorline] dict append opts -errorinfo \ "\n (\"[lindex [info level 0] 0]\" body line $line)" } # Keep track of the original error message & options set _em $em set _opts $opts # ----- Find and execute handler ----- set errorcode {} if {[dict exists $opts -errorcode]} { set errorcode [dict get $opts -errorcode] } set found false foreach {descrip oncode pattern varlist body} $handlers { if {!$found} { if { ($code != $oncode) || ([lrange $pattern 0 end] ne [lrange $errorcode 0 [llength $pattern]-1] ) } then { continue } } set found true if {$body eq "-"} { continue } # Handler found ... # Assign trybody results into variables lassign $varlist resultsVarName optionsVarName if {[llength $varlist] >= 1} { upvar 1 $resultsVarName resultsvar set resultsvar $em } if {[llength $varlist] >= 2} { upvar 1 $optionsVarName optsvar set optsvar $opts } # Execute the handler set code [uplevel 1 [list ::catch $body $EMVAR $OPTVAR]] if {$code == 1} { set line [dict get $opts -errorline] dict append opts -errorinfo \ "\n (\"[lindex [info level 0] 0] ... $descrip\"\ body line $line)" # On error chain to original outcome dict set opts -during $_opts } # Handler result replaces the original result (whether success or # failure); capture context of original exception for reference. set _em $em set _opts $opts # Handler has been executed - stop looking for more break } # No catch handler found -- error falls through to caller # OR catch handler executed -- result falls through to caller # ----- If we have a finally block then execute it ----- if {$finallybody ne {}} { set code [uplevel 1 [list ::catch $finallybody $EMVAR $OPTVAR]] # Finally result takes precedence except on success if {$code == 1} { set line [dict get $opts -errorline] dict append opts -errorinfo \ "\n (\"[lindex [info level 0] 0] ... finally\"\ body line $line)" # On error chain to original outcome dict set opts -during $_opts } if {$code != 0} { set _em $em set _opts $opts } # Otherwise our result is not affected } # Propagate the error or the result of the executed catch body to the # caller. dict incr _opts -level return -options $_opts $_em } } namespace import ::tcl::control::try