procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

* lisp/emacs-lisp/nadvice.el (advice--member-p): Change second arg.

Browse source 
(advice-function-member-p): Tell it to check both names and functions.
(advice--add-function): Adjust call accordingly.

Fixes: debbugs:17531
This commit is contained in:
Stefan Monnier 2014-05-23 12:17:14 -04:00
parent 982ccf0398
commit 15ad4013c4
3 changed files with 18 additions and 6 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

7
lisp/ChangeLog
View file

@ -1,3 +1,10 @@
2014-05-23 Stefan Monnier <monnier@iro.umontreal.ca>
* emacs-lisp/nadvice.el (advice--member-p): Change second arg.
(advice-function-member-p): Tell it to check both names and functions
(bug#17531).
(advice--add-function): Adjust call accordingly.
2014-05-23 Stephen Berman <stephen.berman@gmx.net>
* calendar/todo-mode.el: Miscellaneous bug fixes.

16
lisp/emacs-lisp/nadvice.el
View file

@ -180,12 +180,16 @@ WHERE is a symbol to select an entry in `advice--where-alist'."
(advice--make-1 (nth 1 desc) (nth 2 desc)
function main props)))))
(defun advice--member-p (function name definition)
(defun advice--member-p (function use-name definition)
(let ((found nil))
(while (and (not found) (advice--p definition))
(if (if name
(equal name (cdr (assq 'name (advice--props definition))))
(equal function (advice--car definition)))
(if (if (eq use-name :use-both)
(or (equal function
(cdr (assq 'name (advice--props definition))))
(equal function (advice--car definition)))
(equal function (if use-name
(cdr (assq 'name (advice--props definition)))
(advice--car definition))))
(setq found definition)
(setq definition (advice--cdr definition))))
found))
@ -291,7 +295,7 @@ is also interactive. There are 3 cases:
;;;###autoload
(defun advice--add-function (where ref function props)
(let* ((name (cdr (assq 'name props)))
(a (advice--member-p function name (gv-deref ref))))
(a (advice--member-p (or name function) (if name t) (gv-deref ref))))
(when a
;; The advice is already present. Remove the old one, first.
(setf (gv-deref ref)
@ -323,7 +327,7 @@ properties alist that was specified when it was added."
"Return non-nil if ADVICE is already in FUNCTION-DEF.
Instead of ADVICE being the actual function, it can also be the `name'
of the piece of advice."
(advice--member-p advice advice function-def))
(advice--member-p advice :use-both function-def))
;;;; Specific application of add-function to `symbol-function' for advice.

1
test/automated/advice-tests.el
View file

@ -184,6 +184,7 @@ function being an around advice."
(sm-advice (lambda (x) (if (consp x) (list (* 5 (car x))) (* 4 x)))))
(should (equal (funcall sm-test10 5) 15))
(add-function :filter-args (var sm-test10) sm-advice)
(should (advice-function-member-p sm-advice sm-test10))
(should (equal (funcall sm-test10 5) 35))
(add-function :filter-return (var sm-test10) sm-advice)
(should (equal (funcall sm-test10 5) 60))