From a731fc1bb01f3c0c8eb2ca24a1c5cd7cd7373059 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 8 Jan 2013 10:24:56 -0500 Subject: [PATCH] * lisp/emacs-lisp/nadvice.el (advice--tweak): New function. (advice--remove-function, advice--subst-main): Use it. * lisp/emacs-lisp/advice.el: Update commentary. --- lisp/ChangeLog | 15 +++++++++++---- lisp/emacs-lisp/advice.el | 8 +++----- lisp/emacs-lisp/nadvice.el | 39 +++++++++++++++++++------------------- 3 files changed, 33 insertions(+), 29 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 7e0f4214a7..3c1a51855a 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,7 +1,14 @@ +2013-01-08 Stefan Monnier + + * 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 - * 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 @@ -26,8 +33,8 @@ 2013-01-07 Bastien Guerry - * 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 diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el index d9d8e4f3b0..07340f06a1 100644 --- a/lisp/emacs-lisp/advice.el +++ b/lisp/emacs-lisp/advice.el @@ -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. diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el index b4d6fac92a..1715763d48 100644 --- a/lisp/emacs-lisp/nadvice.el +++ b/lisp/emacs-lisp/nadvice.el @@ -167,20 +167,26 @@ WHERE is a symbol to select an entry in `advice--where-alist'." (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 @@ of the piece of advice." ;;;; 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 -- 2.39.2