branch: elpa/undo-fu
commit acd4f6c92521716c1010ff3aba471218ba14a5e9
Author: Campbell Barton <ideasma...@gmail.com>
Commit: Campbell Barton <ideasma...@gmail.com>
Use a more sophisticated with-advice macro
This supports advising multiple functions at once.
---
undo-fu.el | 63 ++++++++++++++++++++++++++++++++++++++++----------------------
1 file changed, 41 insertions(+), 22 deletions(-)
diff --git a/undo-fu.el b/undo-fu.el
index 2fe098bfab..997a7129ec 100644
--- a/undo-fu.el
+++ b/undo-fu.el
@@ -117,44 +117,63 @@ This allows the initial boundary to be crossed when
redoing."
(setq undo-fu--respect nil)
(setq undo-fu--in-region nil))
-(defmacro undo-fu--with-advice (fn-orig where fn-advice &rest body)
- "Execute BODY with advice added.
+(defmacro undo-fu--with-advice (advice &rest body)
+ "Execute BODY with ADVICE temporarily enabled.
-WHERE using FN-ADVICE temporarily added to FN-ORIG."
+Advice are triplets of (SYMBOL HOW FUNCTION),
+see `advice-add' documentation."
(declare (indent 3))
- (let ((function-var (gensym)))
- `(let ((,function-var ,fn-advice))
+ (let ((body-let nil)
+ (body-advice-add nil)
+ (body-advice-remove nil)
+ (item nil))
+ (while (setq item (pop advice))
+ (let ((fn-sym (gensym))
+ (fn-advise (pop item))
+ (fn-advice-ty (pop item))
+ (fn-body (pop item)))
+ ;; Build the calls for each type.
+ (push (list fn-sym fn-body) body-let)
+ (push (list 'advice-add fn-advise fn-advice-ty fn-sym) body-advice-add)
+ (push (list 'advice-remove fn-advise fn-sym) body-advice-remove)))
+ (setq body-let (nreverse body-let))
+ (setq body-advice-add (nreverse body-advice-add))
+ ;; Compose the call.
+ `(let ,body-let
(unwind-protect
(progn
- (advice-add ,fn-orig ,where ,function-var)
+ ,@body-advice-add
,@body)
- (advice-remove ,fn-orig ,function-var)))))
+ ,@body-advice-remove))))
(defmacro undo-fu--with-message-suffix (suffix &rest body)
"Add text after the message output.
Argument SUFFIX is the text to add at the start of the message.
Optional argument BODY runs with the message suffix."
(declare (indent 1))
- `(undo-fu--with-advice #'message :around
- (lambda (fn-orig arg &rest args)
- (apply fn-orig (append (list (concat arg "%s"))
args (list ,suffix))))
- ,@body))
+ `(undo-fu--with-advice ((#'message
+ :around
+ (lambda (fn-orig arg &rest args)
+ (apply fn-orig
+ (append (list (concat arg "%s")) args
(list ,suffix))))))
+ ,@body))
(defmacro undo-fu--with-messages-as-non-repeating-list (message-list &rest
body)
"Run BODY adding any message call to the MESSAGE-LIST list."
(declare (indent 1))
`(let ((temp-message-list (list)))
- (undo-fu--with-advice #'message :around
- (lambda (_ &rest args)
- (when message-log-max
- (let ((message-text (apply #'format-message
args)))
- (unless (equal message-text (car
temp-message-list))
- (push message-text temp-message-list)))))
- (unwind-protect
- (progn
- ,@body)
- ;; Protected.
- (setq ,message-list (append ,message-list (reverse
temp-message-list)))))))
+ (undo-fu--with-advice ((#'message
+ :around
+ (lambda (_ &rest args)
+ (when message-log-max
+ (let ((message-text (apply #'format-message
args)))
+ (unless (equal message-text (car
temp-message-list))
+ (push message-text
temp-message-list)))))))
+ (unwind-protect
+ (progn
+ ,@body)
+ ;; Protected.
+ (setq ,message-list (append ,message-list (reverse
temp-message-list)))))))
(defun undo-fu--undo-enabled-or-error ()
"Raise a user error when undo is disabled."
