aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2014-05-23 12:17:14 -0400
committerStefan Monnier2014-05-23 12:17:14 -0400
commit15ad4013c44d19125fde6bbb704797d4a7a185b3 (patch)
treee2965e142434a99d9080d111b75727b65319386c
parent982ccf03983af38862a7f75841b9773b89c27773 (diff)
downloademacs-15ad4013c44d19125fde6bbb704797d4a7a185b3.tar.gz
emacs-15ad4013c44d19125fde6bbb704797d4a7a185b3.zip
* lisp/emacs-lisp/nadvice.el (advice--member-p): Change second arg.
(advice-function-member-p): Tell it to check both names and functions. (advice--add-function): Adjust call accordingly. Fixes: debbugs:17531
-rw-r--r--lisp/ChangeLog7
-rw-r--r--lisp/emacs-lisp/nadvice.el16
-rw-r--r--test/automated/advice-tests.el1
3 files changed, 18 insertions, 6 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 0220741d76a..57cf0490fea 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,10 @@
12014-05-23 Stefan Monnier <monnier@iro.umontreal.ca>
2
3 * emacs-lisp/nadvice.el (advice--member-p): Change second arg.
4 (advice-function-member-p): Tell it to check both names and functions
5 (bug#17531).
6 (advice--add-function): Adjust call accordingly.
7
12014-05-23 Stephen Berman <stephen.berman@gmx.net> 82014-05-23 Stephen Berman <stephen.berman@gmx.net>
2 9
3 * calendar/todo-mode.el: Miscellaneous bug fixes. 10 * calendar/todo-mode.el: Miscellaneous bug fixes.
diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el
index 01027c43148..1c8641249cf 100644
--- a/lisp/emacs-lisp/nadvice.el
+++ b/lisp/emacs-lisp/nadvice.el
@@ -180,12 +180,16 @@ WHERE is a symbol to select an entry in `advice--where-alist'."
180 (advice--make-1 (nth 1 desc) (nth 2 desc) 180 (advice--make-1 (nth 1 desc) (nth 2 desc)
181 function main props))))) 181 function main props)))))
182 182
183(defun advice--member-p (function name definition) 183(defun advice--member-p (function use-name definition)
184 (let ((found nil)) 184 (let ((found nil))
185 (while (and (not found) (advice--p definition)) 185 (while (and (not found) (advice--p definition))
186 (if (if name 186 (if (if (eq use-name :use-both)
187 (equal name (cdr (assq 'name (advice--props definition)))) 187 (or (equal function
188 (equal function (advice--car definition))) 188 (cdr (assq 'name (advice--props definition))))
189 (equal function (advice--car definition)))
190 (equal function (if use-name
191 (cdr (assq 'name (advice--props definition)))
192 (advice--car definition))))
189 (setq found definition) 193 (setq found definition)
190 (setq definition (advice--cdr definition)))) 194 (setq definition (advice--cdr definition))))
191 found)) 195 found))
@@ -291,7 +295,7 @@ is also interactive. There are 3 cases:
291;;;###autoload 295;;;###autoload
292(defun advice--add-function (where ref function props) 296(defun advice--add-function (where ref function props)
293 (let* ((name (cdr (assq 'name props))) 297 (let* ((name (cdr (assq 'name props)))
294 (a (advice--member-p function name (gv-deref ref)))) 298 (a (advice--member-p (or name function) (if name t) (gv-deref ref))))
295 (when a 299 (when a
296 ;; The advice is already present. Remove the old one, first. 300 ;; The advice is already present. Remove the old one, first.
297 (setf (gv-deref ref) 301 (setf (gv-deref ref)
@@ -323,7 +327,7 @@ properties alist that was specified when it was added."
323 "Return non-nil if ADVICE is already in FUNCTION-DEF. 327 "Return non-nil if ADVICE is already in FUNCTION-DEF.
324Instead of ADVICE being the actual function, it can also be the `name' 328Instead of ADVICE being the actual function, it can also be the `name'
325of the piece of advice." 329of the piece of advice."
326 (advice--member-p advice advice function-def)) 330 (advice--member-p advice :use-both function-def))
327 331
328;;;; Specific application of add-function to `symbol-function' for advice. 332;;;; Specific application of add-function to `symbol-function' for advice.
329 333
diff --git a/test/automated/advice-tests.el b/test/automated/advice-tests.el
index e0c3b40487e..a87d979f919 100644
--- a/test/automated/advice-tests.el
+++ b/test/automated/advice-tests.el
@@ -184,6 +184,7 @@ function being an around advice."
184 (sm-advice (lambda (x) (if (consp x) (list (* 5 (car x))) (* 4 x))))) 184 (sm-advice (lambda (x) (if (consp x) (list (* 5 (car x))) (* 4 x)))))
185 (should (equal (funcall sm-test10 5) 15)) 185 (should (equal (funcall sm-test10 5) 15))
186 (add-function :filter-args (var sm-test10) sm-advice) 186 (add-function :filter-args (var sm-test10) sm-advice)
187 (should (advice-function-member-p sm-advice sm-test10))
187 (should (equal (funcall sm-test10 5) 35)) 188 (should (equal (funcall sm-test10 5) 35))
188 (add-function :filter-return (var sm-test10) sm-advice) 189 (add-function :filter-return (var sm-test10) sm-advice)
189 (should (equal (funcall sm-test10 5) 60)) 190 (should (equal (funcall sm-test10 5) 60))