diff options
author | Stefan Monnier <monnier@iro.umontreal.ca> | 2013-01-15 01:05:22 -0500 |
---|---|---|
committer | Stefan Monnier <monnier@iro.umontreal.ca> | 2013-01-15 01:05:22 -0500 |
commit | cb9c0a53bc4a6d67f10d4674472b2884a71852c8 (patch) | |
tree | bf43c694ff8de8bc246c19bdc929a336e3dd969b /lisp/emacs-lisp | |
parent | ef8214345ba7b46de9837fbe9461e19f18e6d660 (diff) | |
download | emacs-cb9c0a53bc4a6d67f10d4674472b2884a71852c8.tar.gz emacs-cb9c0a53bc4a6d67f10d4674472b2884a71852c8.tar.bz2 emacs-cb9c0a53bc4a6d67f10d4674472b2884a71852c8.zip |
* lisp/emacs-lisp/advice.el (ad-preactivate-advice): Adjust the cleanup to
the use of nadvice.el.
* lisp/emacs-lisp/nadvice.el (advice--tweak): Make it possible for `tweak'
to return an explicit nil.
(advice--remove-function): Change accordingly.
* test/automated/advice-tests.el: Split up. Add advice-test-preactivate.
Diffstat (limited to 'lisp/emacs-lisp')
-rw-r--r-- | lisp/emacs-lisp/advice.el | 13 | ||||
-rw-r--r-- | lisp/emacs-lisp/nadvice.el | 11 |
2 files changed, 11 insertions, 13 deletions
diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el index 07340f06a13..3d03e894534 100644 --- a/lisp/emacs-lisp/advice.el +++ b/lisp/emacs-lisp/advice.el @@ -2866,10 +2866,8 @@ advised definition from scratch." (defun ad-preactivate-advice (function advice class position) "Preactivate FUNCTION and returns the constructed cache." - (let* ((function-defined-p (fboundp function)) - (old-definition - (if function-defined-p - (symbol-function function))) + (let* ((advicefunname (ad-get-advice-info-field function 'advicefunname)) + (old-advice (symbol-function advicefunname)) (old-advice-info (ad-copy-advice-info function)) (ad-advised-functions ad-advised-functions)) (unwind-protect @@ -2883,10 +2881,9 @@ advised definition from scratch." (list (ad-get-cache-definition function) (ad-get-cache-id function)))) (ad-set-advice-info function old-advice-info) - ;; Don't `fset' function to nil if it was previously unbound: - (if function-defined-p - (fset function old-definition) - (fmakunbound function))))) + (advice-remove function advicefunname) + (fset advicefunname old-advice) + (if old-advice (advice-add function :around advicefunname))))) ;; @@ Activation and definition handling: diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el index 1715763d482..b0711fed26c 100644 --- a/lisp/emacs-lisp/nadvice.el +++ b/lisp/emacs-lisp/nadvice.el @@ -173,20 +173,21 @@ WHERE is a symbol to select an entry in `advice--where-alist'." (let ((first (advice--car flist)) (rest (advice--cdr flist)) (props (advice--props flist))) - (or (funcall tweaker first rest props) + (let ((val (funcall tweaker first rest props))) + (if val (car val) (let ((nrest (advice--tweak rest tweaker))) (if (eq rest nrest) flist (advice--make-1 (aref flist 1) (aref flist 3) - first nrest props))))))) + first nrest props)))))))) ;;;###autoload (defun advice--remove-function (flist function) (advice--tweak flist (lambda (first rest props) - (if (or (not first) - (equal function first) + (cond ((not first) rest) + ((or (equal function first) (equal function (cdr (assq 'name props)))) - rest)))) + (list rest)))))) (defvar advice--buffer-local-function-sample nil) |