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

auto upstream

Browse source
This commit is contained in:
Joakim Verona 2013-01-16 00:03:29 +01:00
commit 29901a2447
29 changed files with 403 additions and 252 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)