2 files changed, 70 insertions, 38 deletions
diff --git a/src/clojure/contrib/condition.clj b/src/clojure/contrib/condition.clj
index 5565ee8d..c396a7a9 100644
--- a/src/clojure/contrib/condition.clj
+++ b/src/clojure/contrib/condition.clj
@@ -22,10 +22,10 @@
 ;;  scgilardi (gmail)
 ;;  Created 09 June 2009
 
-(ns 
-    #^{:author "Stephen C. Gilardi",
+(ns #^{:author "Stephen C. Gilardi",
        :doc "Flexible raising and handling of conditions. A condition is a map
 containing:
+
   - keys and values specified as arguments to raise, and
   - a stack trace at key :stack-trace.
 
@@ -35,49 +35,64 @@ Based on an idea from Chouser:
 http://groups.google.com/group/clojure/browse_frm/thread/da1285c538f22bb5"}
   clojure.contrib.condition
   (:require clojure.contrib.condition.Condition)
-  (:import clojure.contrib.condition.Condition))
+  (:import clojure.contrib.condition.Condition)
+  (:use [clojure.contrib.def :only (defvar)]))
+
+(defvar *condition*
+  "While a handler is running, bound to the condition being handled")
+
+(defvar *selector*
+  "While a handler is running, bound to the selector returned by
+  dispatch-fn for *condition*")
+
+(defvar *condition-object*
+  "While a handler is running, bound to the Condition object being
+  handled")
 
 (defmacro raise
-  "Raises a condition with the supplied mappings.
-  keyval => key val"
+  "Raises a condition with the supplied mappings. With no arguments,
+  re-raises the current condition. (keyval => key val)"
   [& keyvals]
-  `(throw (Condition. (hash-map ~@keyvals))))
+  `(let [m# (hash-map ~@keyvals)]
+     (throw (if (seq m#)
+              (Condition. m#)
+              *condition-object*))))
 
 (defmacro handler-case
-  "Executes body in a context in which any raised conditions can be handled.
-
-  dispatch-fn accepts a raised condition: a map, and returns a value used
-  to select a handler.
+  "Executes body in a context in which raised conditions can be handled.
 
-  The name specified by condition is bound to the condition within
-  handlers.
+  dispatch-fn accepts a raised condition (a map) and returns a selector
+  value used to choose a handler.
 
   Handlers are forms within body:
 
     (handle key
       ...)
 
-  If a condition is raised, executes the body of the first handler whose
-  key satisfies (isa? selector key). If no handlers match, the condition is
-  re-raised."
-  [dispatch-fn condition & body]
-  (let [selector (gensym "selector")]
-    (loop [[form & forms] body
-           m {:code [] :handlers []}]
-      (if form
-        (recur
-         forms
-         (if (and (list? form) (= (first form) 'handle))
-           (let [[_ key & body] form
-                 handler `[(isa? ~selector ~key) (do ~@body)]]
-             (update-in m [:handlers] concat handler))
-           (update-in m [:code] conj form)))
-        (if (empty? (:handlers m))
-          `(do ~@(:code m))
-          `(try
-            ~@(:code m)
-            (catch Condition c#
-              (let [~condition (meta c#)
-                    ~selector (~dispatch-fn ~condition)]
-                (cond ~@(:handlers m)
-                      :else (throw c#))))))))))
+  If a condition is raised, handler-case executes the body of the first
+  handler whose key satisfies (isa? selector key). If no handlers match,
+  the condition is re-raised.
+
+  While a handler is running, *condition* is bound to the condition being
+  handled and *selector* is bound to to the value returned by dispatch-fn
+  that matched the handler's key."
+  [dispatch-fn & body]
+  (loop [[form & forms] body
+         m {:code [] :handlers []}]
+    (if form
+      (recur
+       forms
+       (if (and (list? form) (= (first form) 'handle))
+         (let [[_ key & body] form
+               handler `[(isa? *selector* ~key) (do ~@body)]]
+           (update-in m [:handlers] concat handler))
+         (update-in m [:code] conj form)))
+      `(try
+        ~@(:code m)
+        (catch Condition c#
+          (binding [*condition-object* c#
+                    *condition* ^c#
+                    *selector* (~dispatch-fn ^c#)]
+            (cond
+             ~@(:handlers m)
+             :else (raise))))))))
diff --git a/src/clojure/contrib/condition/example.clj b/src/clojure/contrib/condition/example.clj
index 25ff74b6..e437cf6e 100644
--- a/src/clojure/contrib/condition/example.clj
+++ b/src/clojure/contrib/condition/example.clj
@@ -21,8 +21,25 @@
 
 (defn main
   []
-  (handler-case :source condition
+  
+  ;; simple handler
+  
+  (handler-case :source
     (println (func 3 4))
     (println (func -5 10))
     (handle ::Args
-      (printf "Bad argument: %s\n" condition))))
+      (printf "Bad argument: %s\n" *condition*)))
+
+  ;; demonstrate nested handlers
+
+  (handler-case :source
+    (handler-case :source
+      (println (func 8 2))
+      (println (func -6 17))
+      ;; no handler for ::Args
+      (handle ::nested
+        (printf "I'm nested: %s\n" *condition*)))
+    (println (func 3 4))
+    (println (func -5 10))
+    (handle ::Args
+      (printf "Bad argument: %s\n" *condition*))))