]> git.eshelyaron.com Git - emacs.git/commitdiff
Add `advice-flet' macro
authorAndrea Corallo <akrl@sdf.org>
Fri, 2 Oct 2020 16:13:28 +0000 (18:13 +0200)
committerAndrea Corallo <akrl@sdf.org>
Fri, 2 Oct 2020 19:20:50 +0000 (21:20 +0200)
The testsuite does large use of primitive redefinition, to avoid that
we define `advice-flet' to use instead as an easy `cl-letf'
replacement.

* lisp/emacs-lisp/nadvice.el (advice-flet): New macro.

lisp/emacs-lisp/nadvice.el

index 5b3aa7085082fc2b3146d6b489a4fe080ac69f29..21da038dc1c604a8b0114e632187d7d0ff43fc92 100644 (file)
@@ -356,6 +356,32 @@ of the piece of advice."
     (macroexp-let2 nil new `(advice--remove-function ,getter ,function)
       `(unless (eq ,new ,getter) ,(funcall setter new)))))
 
+;;;###autoload
+(defmacro advice-flet (bindings &rest body)
+  ;; FIXME add doc.
+  (declare (indent 1))
+  (let ((let-binds ())
+        (ad-add ())
+        (ad-del ()))
+    (dolist (bind bindings)
+      (let* ((fun-name (car bind))
+             (fun (cadr bind))
+             (tmp-sym (gensym (symbol-name fun-name))))
+        (push `(,tmp-sym ,fun) let-binds)
+        (push `(advice-add #',fun-name
+                           ,(if (= (length bind) 3)
+                                (nth 2 bind)
+                              :override)
+                           ,tmp-sym)
+              ad-add)
+        (push `(advice-remove #',fun-name ,tmp-sym) ad-del)))
+    `(let ,(reverse let-binds)
+       (unwind-protect
+          (progn
+            ,@(reverse ad-add)
+            ,@body)
+        ,@(reverse ad-del)))))
+
 (defun advice-function-mapc (f function-def)
   "Apply F to every advice function in FUNCTION-DEF.
 F is called with two arguments: the function that was added, and the