[Emacs-diffs] trunk r113192: * lisp/emacs-lisp/nadvice.el (advice--defalias-fset): Move advice back to

[Stefan Monnier]

------------------------------------------------------------
revno: 113192
revision-id: address@hidden
parent: address@hidden
fixes bug: http://debbugs.gnu.org/cgi/bugreport.cgi?bug=13820
committer: Stefan Monnier <address@hidden>
branch nick: trunk
timestamp: Wed 2013-06-26 18:31:19 -0400
message:
  * lisp/emacs-lisp/nadvice.el (advice--defalias-fset): Move advice back to
  advice--pending if newdef is nil or an autoload.
  (advice-mapc): New function.
modified:
  lisp/ChangeLog                 changelog-20091113204419-o5vbwnq5f7feedwu-1432
  lisp/emacs-lisp/nadvice.el     nadvice.el-20121015213644-851fdxs2vximj8nr-1

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2013-06-26 17:14:46 +0000
+++ b/lisp/ChangeLog    2013-06-26 22:31:19 +0000
@@ -1,3 +1,9 @@
+2013-06-26  Stefan Monnier  <address@hidden>
+
+       * emacs-lisp/nadvice.el (advice--defalias-fset): Move advice back to
+       advice--pending if newdef is nil or an autoload (bug#13820).
+       (advice-mapc): New function.
+
 2013-06-26  Lars Magne Ingebrigtsen  <address@hidden>
 
        * net/eww.el (eww-mode): Undo isn't necessary in eww buffers,

=== modified file 'lisp/emacs-lisp/nadvice.el'
--- a/lisp/emacs-lisp/nadvice.el        2013-05-06 15:27:11 +0000
+++ b/lisp/emacs-lisp/nadvice.el        2013-06-26 22:31:19 +0000
@@ -313,8 +313,7 @@
   (when (get symbol 'advice--saved-rewrite)
     (put symbol 'advice--saved-rewrite nil))
   (setq newdef (advice--normalize symbol newdef))
-  (let* ((olddef (advice--strip-macro
-                 (if (fboundp symbol) (symbol-function symbol))))
+  (let* ((olddef (advice--strip-macro (symbol-function symbol)))
          (oldadv
           (cond
           ((null (get symbol 'advice--pending))
@@ -324,15 +323,18 @@
                           symbol)
                  nil)))
           ((or (not olddef) (autoloadp olddef))
-           (prog1 (get symbol 'advice--pending)
-             (put symbol 'advice--pending nil)))
+            (get symbol 'advice--pending))
            (t (message "Dropping left-over advice--pending for %s" symbol)
-              (put symbol 'advice--pending nil)
               olddef))))
-    (let* ((snewdef (advice--strip-macro newdef))
-          (snewadv (advice--subst-main oldadv snewdef)))
-      (funcall (or fsetfun #'fset) symbol
-              (if (eq snewdef newdef) snewadv (cons 'macro snewadv))))))
+    (if (and newdef (not (autoloadp newdef)))
+        (let* ((snewdef (advice--strip-macro newdef))
+               (snewadv (advice--subst-main oldadv snewdef)))
+          (put symbol 'advice--pending nil)
+          (funcall (or fsetfun #'fset) 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))))
     
 
 ;;;###autoload
@@ -345,7 +347,7 @@
   ;; - change all defadvice in lisp/**/*.el.
   ;; - rewrite advice.el on top of this.
   ;; - obsolete advice.el.
-  (let* ((f (and (fboundp symbol) (symbol-function symbol)))
+  (let* ((f (symbol-function symbol))
         (nf (advice--normalize symbol f)))
     (unless (eq f nf) ;; Most importantly, if nf == nil!
       (fset symbol nf))
@@ -370,37 +372,34 @@
 ;;;###autoload
 (defun advice-remove (symbol function)
   "Like `remove-function' but for the function named SYMBOL.
-Contrary to `remove-function', this will work also when SYMBOL is a macro
-and it will not signal an error if SYMBOL is not `fboundp'.
+Contrary to `remove-function', this also works when SYMBOL is a macro
+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."
-  (when (fboundp symbol)
-    (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))
-                       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))))))
-    nil))
+  (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))
+                     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))))))
+  nil)
 
-;; (defun advice-mapc (fun symbol)
-;;   "Apply FUN to every function added as advice to SYMBOL.
-;; FUN is called with a two arguments: the function that was added, and the
-;; properties alist that was specified when it was added."
-;;   (let ((def (or (get symbol 'advice--pending)
-;;                  (if (fboundp symbol) (symbol-function symbol)))))
-;;     (while (advice--p def)
-;;       (funcall fun (advice--car def) (advice--props def))
-;;       (setq def (advice--cdr def)))))
+(defun advice-mapc (fun def)
+  "Apply FUN to every advice function in DEF.
+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))))
 
 ;;;###autoload
 (defun advice-member-p (advice function-name)
@@ -410,8 +409,7 @@
   (advice--member-p advice advice
                     (or (get function-name 'advice--pending)
                        (advice--strip-macro
-                        (if (fboundp function-name)
-                            (symbol-function function-name))))))
+                         (symbol-function function-name)))))
 
 ;; When code is advised, called-interactively-p needs to be taught to skip
 ;; the advising frames.