svn commit: r1715338 - in /tcl/rivet/branches/2.2: ChangeLog rivet/rivet-tcl/catch.tcl rivet/rivet-tcl/tclIndex

[mx...@apache.org]

Author: mxmanghi
Date: Fri Nov 20 11:30:33 2015
New Revision: 1715338

URL: http://svn.apache.org/viewvc?rev=1715338&view=rev
Log:
2015-11-20 Massimo Manghi <mx...@apache.org>
    * rivet/rivet-tcl/catch.tcl: new command [::rivet::catch ...] wraps
    the core command but returns an error anyway if raised by
    either [::rivet::abort_page] or [::rivet::exit]


Added:
    tcl/rivet/branches/2.2/rivet/rivet-tcl/catch.tcl
Modified:
    tcl/rivet/branches/2.2/ChangeLog
    tcl/rivet/branches/2.2/rivet/rivet-tcl/tclIndex

Modified: tcl/rivet/branches/2.2/ChangeLog
URL: http://svn.apache.org/viewvc/tcl/rivet/branches/2.2/ChangeLog?rev=1715338&r1=1715337&r2=1715338&view=diff
==============================================================================
--- tcl/rivet/branches/2.2/ChangeLog (original)
+++ tcl/rivet/branches/2.2/ChangeLog Fri Nov 20 11:30:33 2015
@@ -1,3 +1,8 @@
+2015-11-20 Massimo Manghi <mx...@apache.org>
+    * rivet/rivet-tcl/catch.tcl: new command [::rivet::catch ...] wraps
+    the core command but returns an error anyway if raised by
+    either [::rivet::abort_page] or [::rivet::exit]
+
 2015-11-18 Massimo Manghi <mx...@apache.org>
     * rivet/packages/hexglyphs/hexglyphs.tcl: now printing the whole
     alphabet and some puntuation character

Added: tcl/rivet/branches/2.2/rivet/rivet-tcl/catch.tcl
URL: http://svn.apache.org/viewvc/tcl/rivet/branches/2.2/rivet/rivet-tcl/catch.tcl?rev=1715338&view=auto
==============================================================================
--- tcl/rivet/branches/2.2/rivet/rivet-tcl/catch.tcl (added)
+++ tcl/rivet/branches/2.2/rivet/rivet-tcl/catch.tcl Fri Nov 20 11:30:33 2015
@@ -0,0 +1,40 @@
+# catch.tcl
+#
+# Wrapper of the core [::catch] command that checks whether 
+# an error condition is actually raised by [::rivet::abort_page]
+# or [::rivet::exit]. In case the error is thrown again to allow
+# the interpreter to interrupt and pass execution to AbortScript
+#
+# $Id: $
+#
+namespace eval ::rivet {
+
+    proc catch {script args} {
+
+        set catch_cmd [list ::catch $script]
+        if {[llength $args] >= 1} {
+            upvar [lindex $args 0] errvar
+
+            lappend catch_cmd errvar
+
+        }
+        if {[llength $args] >= 2} {
+            upvar [lindex $args 1] catchopt
+
+            lappend catch_cmd catchopt
+        }
+
+        set catch_ret [eval $catch_cmd]
+
+        if {$catch_ret && [::rivet::abort_page -aborting]} {
+
+            return -code error -errorcode ABORTPAGE
+
+        } else {
+
+            return $catch_ret
+
+        }
+
+    }
+}

Modified: tcl/rivet/branches/2.2/rivet/rivet-tcl/tclIndex
URL: http://svn.apache.org/viewvc/tcl/rivet/branches/2.2/rivet/rivet-tcl/tclIndex?rev=1715338&r1=1715337&r2=1715338&view=diff
==============================================================================
--- tcl/rivet/branches/2.2/rivet/rivet-tcl/tclIndex (original)
+++ tcl/rivet/branches/2.2/rivet/rivet-tcl/tclIndex Fri Nov 20 11:30:33 2015
@@ -28,3 +28,4 @@ set auto_index(::rivet::load_cookies) [l
 set auto_index(::rivet::http_accept) [list source [file join $dir http_accept.tcl]]
 set auto_index(::rivet::xml) [list source [file join $dir xml.tcl]]
 set auto_index(::rivet::redirect) [list source [file join $dir redirect.tcl]]
+set auto_index(::rivet::catch) [list source [file join $dir catch.tcl]]



---------------------------------------------------------------------
To unsubscribe, e-mail: site-cvs-unsubscribe@tcl.apache.org
For additional commands, e-mail: site-cvs-help@tcl.apache.org