;;; advice.el --- An overloading mechanism for Emacs Lisp functions -*- lexical-binding: t -*-
-;; Copyright (C) 1993-1994, 2000-2012 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1994, 2000-2013 Free Software Foundation, Inc.
;; Author: Hans Chalupsky <hans@cs.buffalo.edu>
;; Maintainer: FSF
;; 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.
(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
(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:
If COMPILE is a negative number then it returns nil.
If COMPILE is nil then the result depends on the value of
`ad-default-compilation-action' (which see)."
- (if (integerp compile)
- (>= compile 0)
- (if compile
- compile
- (cond ((eq ad-default-compilation-action 'never)
- nil)
- ((eq ad-default-compilation-action 'always)
- t)
- ((eq ad-default-compilation-action 'like-original)
- (or (ad-subr-p (ad-get-orig-definition function))
- (ad-compiled-p (ad-get-orig-definition function))))
- ;; everything else means `maybe':
- (t (featurep 'byte-compile))))))
+ (cond
+ ;; Don't compile until the real function definition is known (bug#12965).
+ ((not (ad-real-orig-definition function)) nil)
+ ((integerp compile) (>= compile 0))
+ (compile)
+ ((eq ad-default-compilation-action 'never) nil)
+ ((eq ad-default-compilation-action 'always) t)
+ ((eq ad-default-compilation-action 'like-original)
+ (or (ad-subr-p (ad-get-orig-definition function))
+ (ad-compiled-p (ad-get-orig-definition function))))
+ ;; everything else means `maybe':
+ (t (featurep 'byte-compile))))
(defun ad-activate-advised-definition (function compile)
"Redefine FUNCTION with its advised definition from cache or scratch.
The resulting FUNCTION will be compiled if `ad-should-compile' returns t.
The current definition and its cache-id will be put into the cache."
- (let ((verified-cached-definition
- (if (ad-verify-cache-id function)
- (ad-get-cache-definition function)))
- (advicefunname (ad-get-advice-info-field function 'advicefunname)))
+ (let* ((verified-cached-definition
+ (if (ad-verify-cache-id function)
+ (ad-get-cache-definition function)))
+ (advicefunname (ad-get-advice-info-field function 'advicefunname))
+ (old-ispec (interactive-form advicefunname)))
(fset advicefunname
(or verified-cached-definition
(ad-make-advised-definition function)))
+ (unless (equal (interactive-form advicefunname) old-ispec)
+ ;; If the interactive-spec of advicefunname has changed, force nadvice to
+ ;; refresh its copy.
+ (advice-remove function advicefunname))
(advice-add function :around advicefunname)
(if (ad-should-compile function compile)
- (byte-compile advicefunname))
+ (ad-compile-function function))
(if verified-cached-definition
(if (not (eq verified-cached-definition
(symbol-function advicefunname)))
(interactive
(list (ad-read-advised-function "Activate advice of")
current-prefix-arg))
- (if (not (ad-is-advised function))
- (error "ad-activate: `%s' is not advised" function)
- ;; Just return for forward advised and not yet defined functions:
- (if (ad-get-orig-definition function)
- (if (not (ad-has-any-advice function))
- (ad-unadvise function)
- ;; Otherwise activate the advice:
- (cond ((ad-has-redefining-advice function)
- (ad-activate-advised-definition function compile)
- (ad-set-advice-info-field function 'active t)
- (eval (ad-make-hook-form function 'activation))
- function)
- ;; Here we are if we have all disabled advices:
- (t (ad-deactivate function)))))))
+ (cond
+ ((not (ad-is-advised function))
+ (error "ad-activate: `%s' is not advised" function))
+ ;; Just return for forward advised and not yet defined functions:
+ ((not (ad-get-orig-definition function)) nil)
+ ((not (ad-has-any-advice function)) (ad-unadvise function))
+ ;; Otherwise activate the advice:
+ ((ad-has-redefining-advice function)
+ (ad-activate-advised-definition function compile)
+ (ad-set-advice-info-field function 'active t)
+ (eval (ad-make-hook-form function 'activation))
+ function)
+ ;; Here we are if we have all disabled advices:
+ (t (ad-deactivate function))))
(defalias 'ad-activate-on 'ad-activate)