scripts/try.tcl

   1 # vim: ft=tcl foldmethod=marker foldmarker=<<<,>>> ts=4 shiftwidth=4
   2
   3 proc tlc::try {code args} { #<<<1
   4         upvar _tlc_try_standard_actions std_actions
   5         if {[info exists std_actions]} {
   6                 array set actions [array get std_actions]
   7         }
   8         array set actions $args
   9         if {[set ecode [catch {uplevel $code} errmsg]]} {
  10                 if {$ecode != 1} {
  11                         return -code $ecode -errorcode $::errorCode $errmsg
  12                 }
  13                 if {[info exists actions(onerr)]} {
  14                         set handlers    [string map {STDMSG {log error "\nUnexpected error: $errmsg\n$::errorInfo"}} $actions(onerr)]
  15                         array set tmp   $handlers
  16                         if {![info exists tmp(default)]} {
  17                                 lappend handlers default {
  18                                         return \
  19                                                         -code 1 \
  20                                                         -errorcode $::errorCode \
  21                                                         -errorinfo $::errorInfo \
  22                                                         $errmsg
  23                                 }
  24                         }
  25                         if {[set hcode [catch {
  26                                 uplevel [list set errmsg        $errmsg]
  27                                 uplevel [list switch -- [lindex $::errorCode 0] $handlers]
  28                         } herrmsg]]} {
  29                                 return -code $hcode -errorcode $::errorCode $herrmsg
  30                         }
  31                 }
  32
  33                 if {[info exists actions(aftererr)]} {
  34                         if {[set ecode [catch {uplevel $actions(aftererr)} errmsg]]} {
  35                                 return -code $ecode -errorcode $::errorCode \
  36                                                 -errorinfo $::errorInfo $errmsg
  37                         }
  38                 }
  39         } else {
  40                 if {[info exists actions(onok)]} {
  41                         if {[set ecode [catch {uplevel $actions(onok)} errmsg]]} {
  42                                 return -code $ecode -errorcode $::errorCode \
  43                                                 -errorinfo $::errorInfo $errmsg
  44                         }
  45                 }
  46         }
  47
  48         if {[info exists actions(after)]} {
  49                 if {[set ecode [catch {uplevel $actions(after)} errmsg]]} {
  50                         return -code $ecode -errorcode $::errorCode \
  51                                         -errorinfo $::errorInfo $errmsg
  52                 }
  53         }
  54 }
  55
  56
  57 proc tlc::try_set_standard_actions {args} { #<<<1
  58         upvar _tlc_try_standard_actions std_actions
  59         array set std_actions $args
  60 }
  61
  62