* lisp/emacs-lisp/nadvice.el (advice-function-mapc): Rename from advice-mapc.

(advice-mapc): New function, using it.
(advice-function-member-p): New function.
(advice--normalize): Store the cdr in advice--saved-rewrite since
that's the part that will be changed.
(advice--symbol-function): New function.
(advice-remove): Handle removal before the function is defined.
Adjust to new advice--saved-rewrite.
(advice-member-p): Use advice-function-member-p and
advice--symbol-function.

2 files changed, 72 insertions, 26 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 848c4e85407..dc1fa09b316 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,16 @@
+2013-08-04  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+        * emacs-lisp/nadvice.el (advice-function-mapc): Rename from advice-mapc.
+        (advice-mapc): New function, using it.
+        (advice-function-member-p): New function.
+        (advice--normalize): Store the cdr in advice--saved-rewrite since
+        that's the part that will be changed.
+        (advice--symbol-function): New function.
+        (advice-remove): Handle removal before the function is defined.
+        Adjust to new advice--saved-rewrite.
+        (advice-member-p): Use advice-function-member-p and
+        advice--symbol-function.
+
 2013-08-04  Juanma Barranquero  <lekktu@gmail.com>
 
         * frameset.el (frameset-p, frameset-save): Fix autoload cookies.
diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el
index edcfc409085..660eb0365ae 100644
--- a/lisp/emacs-lisp/nadvice.el
+++ b/lisp/emacs-lisp/nadvice.el
@@ -193,7 +193,11 @@ WHERE is a symbol to select an entry in `advice--where-alist'."
                            (equal function (cdr (assq 'name props))))
                           (list rest))))))
 
-(defvar advice--buffer-local-function-sample nil)
+(defvar advice--buffer-local-function-sample nil
+  "keeps an example of the special \"run the default value\" functions.
+These functions play the same role as t in buffer-local hooks, and to recognize
+them, we keep a sample here against which to compare.  Each instance is
+different, but `function-equal' will hopefully ignore those differences.")
 
 (defun advice--set-buffer-local (var val)
   (if (function-equal val advice--buffer-local-function-sample)
@@ -206,6 +210,7 @@ WHERE is a symbol to select an entry in `advice--where-alist'."
   (declare (gv-setter advice--set-buffer-local))
   (if (local-variable-p var) (symbol-value var)
     (setq advice--buffer-local-function-sample
+          ;; This function acts like the t special value in buffer-local hooks.
           (lambda (&rest args) (apply (default-value var) args)))))
 
 ;;;###autoload
@@ -284,6 +289,20 @@ of the piece of advice."
     (macroexp-let2 nil new `(advice--remove-function ,getter ,function)
       `(unless (eq ,new ,getter) ,(funcall setter new)))))
 
+(defun advice-function-mapc (f function-def)
+  "Apply F to every advice function in FUNCTION-DEF.
+F is called with two arguments: the function that was added, and the
+properties alist that was specified when it was added."
+  (while (advice--p function-def)
+    (funcall f (advice--car function-def) (advice--props function-def))
+    (setq function-def (advice--cdr function-def))))
+
+(defun advice-function-member-p (advice function-def)
+  "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))
+
 ;;;; Specific application of add-function to `symbol-function' for advice.
 
 (defun advice--subst-main (old new)
@@ -294,11 +313,11 @@ of the piece of advice."
   (cond
    ((special-form-p def)
     ;; Not worth the trouble trying to handle this, I think.
-    (error "advice-add failure: %S is a special form" symbol))
+    (error "Advice impossible: %S is a special form" symbol))
    ((and (symbolp def)
          (eq 'macro (car-safe (ignore-errors (indirect-function def)))))
     (let ((newval (cons 'macro (cdr (indirect-function def)))))
-      (put symbol 'advice--saved-rewrite (cons def newval))
+      (put symbol 'advice--saved-rewrite (cons def (cdr newval)))
       newval))
    ;; `f' might be a pure (hence read-only) cons!
    ((and (eq 'macro (car-safe def))
@@ -309,7 +328,26 @@ of the piece of advice."
 (defsubst advice--strip-macro (x)
   (if (eq 'macro (car-safe x)) (cdr x) x))
 
+(defun advice--symbol-function (symbol)
+  ;; The value conceptually stored in `symbol-function' is split into two
+  ;; parts:
+  ;; - the normal function definition.
+  ;; - the list of advice applied to it.
+  ;; `advice--symbol-function' is intended to return the second part (i.e. the
+  ;; list of advice, which includes a hole at the end which typically holds the
+  ;; first part, but this function doesn't care much which value is found
+  ;; there).
+  ;; In the "normal" state both parts are combined into a single value stored
+  ;; in the "function slot" of the symbol.  But the way they are combined is
+  ;; different depending on whether the definition is a function or a macro.
+  ;; Also if the function definition is nil (i.e. unbound) or is an autoload,
+  ;; the second part is stashed away temporarily in the `advice--pending'
+  ;; symbol property.
+  (or (get symbol 'advice--pending)
+      (advice--strip-macro (symbol-function symbol))))
+
 (defun advice--defalias-fset (fsetfun symbol newdef)
+  (unless fsetfun (setq fsetfun #'fset))
   (when (get symbol 'advice--saved-rewrite)
     (put symbol 'advice--saved-rewrite nil))
   (setq newdef (advice--normalize symbol newdef))
@@ -330,11 +368,11 @@ of the piece of advice."
         (let* ((snewdef (advice--strip-macro newdef))
                (snewadv (advice--subst-main oldadv snewdef)))
           (put symbol 'advice--pending nil)
-          (funcall (or fsetfun #'fset) symbol
+          (funcall fsetfun symbol
                    (if (eq snewdef newdef) snewadv (cons 'macro snewadv))))
       (unless (eq oldadv (get symbol 'advice--pending))
         (put symbol 'advice--pending (advice--subst-main oldadv nil)))
-      (funcall (or fsetfun #'fset) symbol newdef))))
+      (funcall fsetfun symbol newdef))))
     
 
 ;;;###autoload
@@ -349,8 +387,7 @@ is defined as a macro, alias, command, ..."
   ;; - obsolete advice.el.
   (let* ((f (symbol-function symbol))
          (nf (advice--normalize symbol f)))
-    (unless (eq f nf) ;; Most importantly, if nf == nil!
-      (fset symbol nf))
+    (unless (eq f nf) (fset symbol nf))
     (add-function where (cond
                          ((eq (car-safe nf) 'macro) (cdr nf))
                          ;; Reasons to delay installation of the advice:
@@ -377,39 +414,35 @@ or an autoload and it preserves `fboundp'.
 Instead of the actual function to remove, FUNCTION can also be the `name'
 of the piece of advice."
   (let ((f (symbol-function symbol)))
-    ;; Can't use the `if' place here, because the body is too large,
-    ;; resulting in use of code that only works with lexical-scoping.
-    (remove-function (if (eq (car-safe f) 'macro)
-                         (cdr f)
-                       (symbol-function symbol))
+    (remove-function (cond ;This is `advice--symbol-function' but as a "place".
+                      ((get symbol 'advice--pending)
+                       (get symbol 'advice--pending))
+                      ((eq (car-safe f) 'macro) (cdr f))
+                      (t (symbol-function symbol)))
                      function)
     (unless (advice--p
              (if (eq (car-safe f) 'macro) (cdr f) (symbol-function symbol)))
       ;; Not advised any more.
       (remove-function (get symbol 'defalias-fset-function)
                        #'advice--defalias-fset)
-      (if (eq (symbol-function symbol)
-              (cdr (get symbol 'advice--saved-rewrite)))
-          (fset symbol (car (get symbol 'advice--saved-rewrite))))))
+      (let ((asr (get symbol 'advice--saved-rewrite)))
+        (and asr (eq (cdr-safe (symbol-function symbol))
+                     (cdr asr))
+             (fset symbol (car (get symbol 'advice--saved-rewrite)))))))
   nil)
 
-(defun advice-mapc (fun def)
-  "Apply FUN to every advice function in DEF.
+(defun advice-mapc (fun symbol)
+  "Apply FUN to every advice function in SYMBOL.
 FUN is called with a two arguments: the function that was added, and the
 properties alist that was specified when it was added."
-  (while (advice--p def)
-    (funcall fun (advice--car def) (advice--props def))
-    (setq def (advice--cdr def))))
+  (advice-function-mapc fun (advice--symbol-function symbol)))
 
 ;;;###autoload
-(defun advice-member-p (advice function-name)
-  "Return non-nil if ADVICE has been added to FUNCTION-NAME.
+(defun advice-member-p (advice symbol)
+  "Return non-nil if ADVICE has been added to SYMBOL.
 Instead of ADVICE being the actual function, it can also be the `name'
 of the piece of advice."
-  (advice--member-p advice advice
-                    (or (get function-name 'advice--pending)
-                        (advice--strip-macro
-                         (symbol-function function-name)))))
+  (advice-function-member-p advice (advice--symbol-function symbol)))
 
 ;; When code is advised, called-interactively-p needs to be taught to skip
 ;; the advising frames.