Permalink
Browse files

Merge pull request #10 from hugoduncan/add-scopes

Add scopes for hooks
  • Loading branch information...
2 parents 727961c + f0f992d commit e0d11489a2421592a545847d352f168a939eafeb @technomancy committed Oct 5, 2012
Showing with 42 additions and 0 deletions.
  1. +35 −0 src/robert/hooke.clj
  2. +7 −0 test/robert/test_hooke.clj
View
@@ -55,6 +55,40 @@
::hooks hooks
::original original)))))))
+(defonce hook-scopes [])
+
+(defn start-scope []
+ (locking hook-scopes
+ (alter-var-root #'hook-scopes conj {})))
+
+(defn- scope-update-fn
+ [scopes target-var]
+ (conj
+ (pop scopes)
+ (update-in (peek scopes) [target-var] #(if % % @(hooks target-var)))))
+
+(defn- possibly-record-in-scope
+ [target-var]
+ (locking hook-scopes
+ (when (seq hook-scopes)
+ (alter-var-root #'hook-scopes scope-update-fn target-var))))
+
+(defn end-scope []
+ (locking hook-scopes
+ (let [head (peek hook-scopes)]
+ (alter-var-root #'hook-scopes pop)
+ (doseq [[var old-hooks] head]
+ (reset! (hooks var) old-hooks)))))
+
+(defmacro hook-scope
+ "Defines a scope which records any change to hooks during the dynamic scope of
+its body, and restores hooks to their original state on exit of the scope."
+ [& body]
+ `(try
+ (start-scope)
+ ~@body
+ (finally (end-scope))))
+
(defn add-hook
"Add a hook function f to target-var. Hook functions are passed the
target function and all their arguments and must apply the target to
@@ -63,6 +97,7 @@
(add-hook target-var f f))
([target-var key f]
(prepare-for-hooks target-var)
+ (possibly-record-in-scope target-var)
(swap! (hooks target-var) assoc key f)))
(defn- clear-hook-mechanism [target-var]
@@ -83,3 +83,10 @@
(is (= (keyed 1) 4))
(clear-hooks #'keyed)
(is (= (keyed 1) 1)))
+
+(deftest hook-scope-test
+ (is (hooked))
+ (hook-scope
+ (add-hook #'hooked asplode)
+ (is (thrown? Exception (hooked))))
+ (is (hooked)))

0 comments on commit e0d1148

Please sign in to comment.