Add `advice-flet' macro
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.
This commit is contained in:
parent
36e0c3fb07
commit
d07d7ab1a0
1 changed files with 26 additions and 0 deletions
|
@ -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
|
||||
|
|
Loading…
Add table
Reference in a new issue