diff options
| author | Stefan Monnier | 2014-05-23 12:17:14 -0400 |
|---|---|---|
| committer | Stefan Monnier | 2014-05-23 12:17:14 -0400 |
| commit | 15ad4013c44d19125fde6bbb704797d4a7a185b3 (patch) | |
| tree | e2965e142434a99d9080d111b75727b65319386c | |
| parent | 982ccf03983af38862a7f75841b9773b89c27773 (diff) | |
| download | emacs-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/ChangeLog | 7 | ||||
| -rw-r--r-- | lisp/emacs-lisp/nadvice.el | 16 | ||||
| -rw-r--r-- | test/automated/advice-tests.el | 1 |
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 @@ | |||
| 1 | 2014-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 | |||
| 1 | 2014-05-23 Stephen Berman <stephen.berman@gmx.net> | 8 | 2014-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. |
| 324 | Instead of ADVICE being the actual function, it can also be the `name' | 328 | Instead of ADVICE being the actual function, it can also be the `name' |
| 325 | of the piece of advice." | 329 | of 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)) |