* lisp/emacs-lisp/nadvice.el: Support adding a given function multiple times.

(advice--member-p): If name is given, only compare the name.
(advice--remove-function): Don't stop at the first match.
(advice--normalize-place): New function.
(add-function, remove-function): Use it.
(advice--add-function): Pass the name, if any, to
advice--remove-function.

2 files changed, 31 insertions, 20 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 3f47c077f5c..0fa0c93915a 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,13 @@
+2014-05-10  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+        * emacs-lisp/nadvice.el: Support adding a given function multiple times.
+        (advice--member-p): If name is given, only compare the name.
+        (advice--remove-function): Don't stop at the first match.
+        (advice--normalize-place): New function.
+        (add-function, remove-function): Use it.
+        (advice--add-function): Pass the name, if any, to
+        advice--remove-function.
+
 2014-05-09  Philipp Rumpf  <prumpf@gmail.com>  (tiny change)
 
         * electric.el (electric-indent-post-self-insert-function): Don't use
diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el
index 0e2536f8179..332d1ed61b6 100644
--- a/lisp/emacs-lisp/nadvice.el
+++ b/lisp/emacs-lisp/nadvice.el
@@ -183,9 +183,9 @@ WHERE is a symbol to select an entry in `advice--where-alist'."
 (defun advice--member-p (function name definition)
   (let ((found nil))
     (while (and (not found) (advice--p definition))
-      (if (or (equal function (advice--car definition))
-              (when name
-                (equal name (cdr (assq 'name (advice--props definition))))))
+      (if (if name
+              (equal name (cdr (assq 'name (advice--props definition))))
+            (equal function (advice--car definition)))
           (setq found definition)
         (setq definition (advice--cdr definition))))
     found))
@@ -209,8 +209,8 @@ WHERE is a symbol to select an entry in `advice--where-alist'."
                  (lambda (first rest props)
                    (cond ((not first) rest)
                          ((or (equal function first)
-                           (equal function (cdr (assq 'name props))))
-                          (list rest))))))
+                              (equal function (cdr (assq 'name props))))
+                          (list (advice--remove-function rest function)))))))
 
 (defvar advice--buffer-local-function-sample nil
   "keeps an example of the special \"run the default value\" functions.
@@ -232,6 +232,12 @@ different, but `function-equal' will hopefully ignore those differences.")
           ;; This function acts like the t special value in buffer-local hooks.
           (lambda (&rest args) (apply (default-value var) args)))))
 
+(defun advice--normalize-place (place)
+  (cond ((eq 'local (car-safe place)) `(advice--buffer-local ,@(cdr place)))
+        ((eq 'var (car-safe place))   (nth 1 place))
+        ((symbolp place)              `(default-value ',place))
+        (t place)))
+
 ;;;###autoload
 (defmacro add-function (where place function &optional props)
   ;; TODO:
@@ -267,8 +273,9 @@ a special meaning:
   the advice  should be innermost (i.e. at the end of the list),
   whereas a depth of -100 means that the advice should be outermost.
 
-If PLACE is a simple variable, only its global value will be affected.
-Use (local 'VAR) if you want to apply FUNCTION to VAR buffer-locally.
+If PLACE is a symbol, its `default-value' will be affected.
+Use (local 'SYMBOL) if you want to apply FUNCTION to SYMBOL buffer-locally.
+Use (var VAR) if you want to apply FUNCTION to the (lexical) VAR.
 
 If one of FUNCTION or OLDFUN is interactive, then the resulting function
 is also interactive.  There are 3 cases:
@@ -278,20 +285,18 @@ is also interactive.  There are 3 cases:
   `advice-eval-interactive-spec') and return the list of arguments to use.
 - Else, use the interactive spec of FUNCTION and ignore the one of OLDFUN."
   (declare (debug t)) ;;(indent 2)
-  (cond ((eq 'local (car-safe place))
-         (setq place `(advice--buffer-local ,@(cdr place))))
-        ((symbolp place)
-         (setq place `(default-value ',place))))
-  `(advice--add-function ,where (gv-ref ,place) ,function ,props))
+  `(advice--add-function ,where (gv-ref ,(advice--normalize-place place))
+                         ,function ,props))
 
 ;;;###autoload
 (defun advice--add-function (where ref function props)
-  (let ((a (advice--member-p function (cdr (assq 'name props))
-                             (gv-deref ref))))
+  (let* ((name (cdr (assq 'name props)))
+         (a (advice--member-p function name (gv-deref ref))))
     (when a
       ;; The advice is already present.  Remove the old one, first.
       (setf (gv-deref ref)
-            (advice--remove-function (gv-deref ref) (advice--car a))))
+            (advice--remove-function (gv-deref ref)
+                                     (or name (advice--car a)))))
     (setf (gv-deref ref)
           (advice--make where function (gv-deref ref) props))))
 
@@ -302,11 +307,7 @@ If FUNCTION was not added to PLACE, do nothing.
 Instead of FUNCTION being the actual function, it can also be the `name'
 of the piece of advice."
   (declare (debug t))
-  (cond ((eq 'local (car-safe place))
-         (setq place `(advice--buffer-local ,@(cdr place))))
-        ((symbolp place)
-         (setq place `(default-value ',place))))
-  (gv-letplace (getter setter) place
+  (gv-letplace (getter setter) (advice--normalize-place place)
     (macroexp-let2 nil new `(advice--remove-function ,getter ,function)
       `(unless (eq ,new ,getter) ,(funcall setter new)))))