mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-10 00:00:39 -08:00
Code Issues Projects Releases Wiki Activity

* lisp/emacs-lisp/advice.el (ad-preactivate-advice): Adjust the cleanup to

Browse source 
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.
This commit is contained in:
Stefan Monnier 2013-01-15 01:05:22 -05:00
parent ef8214345b
commit cb9c0a53bc
5 changed files with 121 additions and 99 deletions
Download patch file Download diff file Expand all files Collapse all files

13
lisp/emacs-lisp/advice.el
View file

@ -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:

11
lisp/emacs-lisp/nadvice.el
View file

@ -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)