[Emacs-diffs] /srv/bzr/emacs/trunk r111444: * lisp/emacs-lisp/nadvice.el (advice--tweak): New function.

[Stefan Monnier]

------------------------------------------------------------
revno: 111444
committer: Stefan Monnier <address@hidden>
branch nick: trunk
timestamp: Tue 2013-01-08 10:24:56 -0500
message:
  * lisp/emacs-lisp/nadvice.el (advice--tweak): New function.
  (advice--remove-function, advice--subst-main): Use it.
  * lisp/emacs-lisp/advice.el: Update commentary.
modified:
  lisp/ChangeLog
  lisp/emacs-lisp/advice.el
  lisp/emacs-lisp/nadvice.el

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2013-01-08 11:02:58 +0000
+++ b/lisp/ChangeLog    2013-01-08 15:24:56 +0000
@@ -1,7 +1,14 @@
+2013-01-08  Stefan Monnier  <address@hidden>
+
+       * emacs-lisp/nadvice.el (advice--tweak): New function.
+       (advice--remove-function, advice--subst-main): Use it.
+
+       * emacs-lisp/advice.el: Update commentary.
+
 2013-01-08  Michael Albinus  <address@hidden>
 
-       * net/tramp-adb.el (tramp-adb-file-name-handler-alist): Remove
-       spurious entry.
+       * net/tramp-adb.el (tramp-adb-file-name-handler-alist):
+       Remove spurious entry.
 
 2013-01-08  Glenn Morris  <address@hidden>
 
@@ -26,8 +33,8 @@
 
 2013-01-07  Bastien Guerry  <address@hidden>
 
-       * menu-bar.el (menu-bar-search-documentation-menu): Use
-       `apropos-user-option' and fix the help message.
+       * menu-bar.el (menu-bar-search-documentation-menu):
+       Use `apropos-user-option' and fix the help message.
 
 2013-01-07  Bastien Guerry  <address@hidden>
 

=== modified file 'lisp/emacs-lisp/advice.el'
--- a/lisp/emacs-lisp/advice.el 2013-01-07 18:03:01 +0000
+++ b/lisp/emacs-lisp/advice.el 2013-01-08 15:24:56 +0000
@@ -589,13 +589,11 @@
 ;; Advice implements forward advice mainly via the following: 1) Separation
 ;; of advice definition and activation that makes it possible to accumulate
 ;; advice information without having the original function already defined,
-;; 2) special versions of the built-in functions `fset/defalias' which check
-;; for advice information whenever they define a function.  If advice
-;; information was found then the advice will immediately get activated when
-;; the function gets defined.
+;; 2) Use of the `defalias-fset-function' symbol property which lets
+;; us advise the function when it gets defined.
 
 ;; Automatic advice activation means, that whenever a function gets defined
-;; with either `defun', `defmacro', `fset' or by loading a byte-compiled
+;; with either `defun', `defmacro', `defalias' or by loading a byte-compiled
 ;; file, and the function has some advice-info stored with it then that
 ;; advice will get activated right away.
 

=== modified file 'lisp/emacs-lisp/nadvice.el'
--- a/lisp/emacs-lisp/nadvice.el        2013-01-02 16:30:50 +0000
+++ b/lisp/emacs-lisp/nadvice.el        2013-01-08 15:24:56 +0000
@@ -167,20 +167,26 @@
         (setq definition (advice--cdr definition))))
     found))
 
-;;;###autoload
-(defun advice--remove-function (flist function)
+(defun advice--tweak (flist tweaker)
   (if (not (advice--p flist))
-      flist
+      (funcall tweaker nil flist nil)
     (let ((first (advice--car flist))
+          (rest (advice--cdr flist))
           (props (advice--props flist)))
-      (if (or (equal function first)
-              (equal function (cdr (assq 'name props))))
-          (advice--cdr flist)
-        (let* ((rest (advice--cdr flist))
-               (nrest (advice--remove-function rest function)))
-          (if (eq rest nrest) flist
-            (advice--make-1 (aref flist 1) (aref flist 3)
-                            first nrest props)))))))
+      (or (funcall tweaker first rest props)
+          (let ((nrest (advice--tweak rest tweaker)))
+            (if (eq rest nrest) flist
+              (advice--make-1 (aref flist 1) (aref flist 3)
+                              first nrest props)))))))
+
+;;;###autoload
+(defun advice--remove-function (flist function)
+  (advice--tweak flist
+                 (lambda (first rest props)
+                   (if (or (not first)
+                           (equal function first)
+                           (equal function (cdr (assq 'name props))))
+                       rest))))
 
 (defvar advice--buffer-local-function-sample nil)
 
@@ -269,15 +275,8 @@
 ;;;; Specific application of add-function to `symbol-function' for advice.
 
 (defun advice--subst-main (old new)
-  (if (not (advice--p old))
-      new
-    (let* ((first (advice--car old))
-           (rest (advice--cdr old))
-           (props (advice--props old))
-           (nrest (advice--subst-main rest new)))
-      (if (equal rest nrest) old
-        (advice--make-1 (aref old 1) (aref old 3)
-                        first nrest props)))))
+  (advice--tweak old
+                 (lambda (first _rest _props) (if (not first) new))))
 
 (defun advice--normalize (symbol def)
   (cond