summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNic Ferier <nic@ferrier.me.uk>2013-06-09 00:16:12 +0100
committerNic Ferier <nic@ferrier.me.uk>2013-06-09 00:16:12 +0100
commit4cace61d985de57996f2350f52ff711d7d79df37 (patch)
tree0f1fd87c38bcd75dadd2a148eb03b9d277b7b369
parent5b3b9a772bf809b5cb1297894a72bdafe56a0a13 (diff)
add new binding support to noflet
-rw-r--r--noflet.el20
1 files changed, 16 insertions, 4 deletions
diff --git a/noflet.el b/noflet.el
index 3e5866c..88d5674 100644
--- a/noflet.el
+++ b/noflet.el
@@ -30,6 +30,10 @@
(require 'cl-macs)
+(defun noflet|base ()
+ "A base function."
+ :noflet)
+
(defun noflet|expand (bindings &rest forms)
"Expand BINDINGS and evaluate FORMS.
@@ -73,7 +77,11 @@ name."
(let ((saved-func-namev
(intern (format "saved-func-%s"
(symbol-name name)))))
- `(fset (quote ,name) ,saved-func-namev))))))
+ `(if
+ (eq (symbol-function (quote noflet|base))
+ ,saved-func-namev)
+ (fmakunbound (quote ,name))
+ (fset (quote ,name) ,saved-func-namev)))))))
(lets
(cl-loop
for i in bindings
@@ -84,7 +92,10 @@ name."
(intern (format "saved-func-%s"
(symbol-name name)))))
`(,saved-func-namev
- (symbol-function (quote ,name)))))))))
+ (condition-case err
+ (symbol-function (quote ,name))
+ (void-function
+ (symbol-function (quote noflet|base)))))))))))
`(let ,lets
(unwind-protect
(progn
@@ -114,13 +125,14 @@ the name `this-fn':
This is great for overriding in testing and such like.
-It is NOT currently possible to create new bindings with noflet."
+If new bindings are introduced the binding is discarded upon
+exit. Even with new bindings there is still a `this-fn'. It
+points to `noflet|base' for all new bindings."
(declare (debug ((&rest (cl-defun)) cl-declarations body))
(indent ((&whole 4 &rest (&whole 1 &lambda &body)) &body)))
(apply 'noflet|expand bindings body))
-
(defmacro* let-while ((var expression) &rest body)
"A simple binding loop.