diff options
Diffstat (limited to 'lisp/emacs-lisp/advice.el')
| -rw-r--r-- | lisp/emacs-lisp/advice.el | 120 |
1 files changed, 56 insertions, 64 deletions
diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el index 3ab7e1fe988..2034f33d0e6 100644 --- a/lisp/emacs-lisp/advice.el +++ b/lisp/emacs-lisp/advice.el @@ -1514,7 +1514,7 @@ ;; `ad-return-value' in a piece of after advice. For example: ;; ;; (defmacro foom (x) -;; (` (list (, x)))) +;; `(list ,x)) ;; foom ;; ;; (foom '(a)) @@ -1547,8 +1547,8 @@ ;; (defadvice foom (after fg-print-x act) ;; "Print the value of X." ;; (setq ad-return-value -;; (` (progn (print (, x)) -;; (, ad-return-value))))) +;; `(progn (print ,x) +;; ,ad-return-value))) ;; foom ;; ;; (macroexpand '(foom '(a))) @@ -1575,7 +1575,6 @@ ;; ============================== (require 'macroexp) -;; At run-time also, since ad-do-advised-functions returns code that uses it. (eval-when-compile (require 'cl-lib)) ;; @@ Variable definitions: @@ -1662,18 +1661,14 @@ generates a copy of TREE." ;; (this list is maintained as a completion table): (defvar ad-advised-functions nil) -(defmacro ad-pushnew-advised-function (function) +(defun ad-pushnew-advised-function (function) "Add FUNCTION to `ad-advised-functions' unless its already there." - `(if (not (assoc (symbol-name ,function) ad-advised-functions)) - (setq ad-advised-functions - (cons (list (symbol-name ,function)) - ad-advised-functions)))) + (add-to-list 'ad-advised-functions (symbol-name function))) -(defmacro ad-pop-advised-function (function) +(defun ad-pop-advised-function (function) "Remove FUNCTION from `ad-advised-functions'." - `(setq ad-advised-functions - (delq (assoc (symbol-name ,function) ad-advised-functions) - ad-advised-functions))) + (setq ad-advised-functions + (delete (symbol-name function) ad-advised-functions))) (defmacro ad-do-advised-functions (varform &rest body) "`dolist'-style iterator that maps over advised functions. @@ -1683,14 +1678,14 @@ On each iteration VAR will be bound to the name of an advised function \(a symbol)." (declare (indent 1)) `(dolist (,(car varform) ad-advised-functions) - (setq ,(car varform) (intern (car ,(car varform)))) + (setq ,(car varform) (intern ,(car varform))) ,@body)) -(defun ad-get-advice-info (function) +(defsubst ad-get-advice-info (function) (get function 'ad-advice-info)) -(defmacro ad-get-advice-info-macro (function) - `(get ,function 'ad-advice-info)) +(define-obsolete-function-alias 'ad-get-advice-info-macro + #'ad-get-advice-info "27.1") (defsubst ad-set-advice-info (function advice-info) (cond @@ -1702,13 +1697,12 @@ On each iteration VAR will be bound to the name of an advised function #'ad--defalias-fset))) (put function 'ad-advice-info advice-info)) -(defmacro ad-copy-advice-info (function) - `(copy-tree (get ,function 'ad-advice-info))) +(defsubst ad-copy-advice-info (function) + (copy-tree (get function 'ad-advice-info))) -(defmacro ad-is-advised (function) +(defalias 'ad-is-advised #'ad-get-advice-info "Return non-nil if FUNCTION has any advice info associated with it. -This does not mean that the advice is also active." - `(ad-get-advice-info-macro ,function)) +This does not mean that the advice is also active.") (defun ad-initialize-advice-info (function) "Initialize the advice info for FUNCTION. @@ -1716,19 +1710,19 @@ Assumes that FUNCTION has not yet been advised." (ad-pushnew-advised-function function) (ad-set-advice-info function (list (cons 'active nil)))) -(defmacro ad-get-advice-info-field (function field) +(defsubst ad-get-advice-info-field (function field) "Retrieve the value of the advice info FIELD of FUNCTION." - `(cdr (assq ,field (ad-get-advice-info-macro ,function)))) + (cdr (assq field (ad-get-advice-info function)))) (defun ad-set-advice-info-field (function field value) "Destructively modify VALUE of the advice info FIELD of FUNCTION." - (and (ad-is-advised function) - (cond ((assq field (ad-get-advice-info-macro function)) - ;; A field with that name is already present: - (rplacd (assq field (ad-get-advice-info-macro function)) value)) - (t;; otherwise, create a new field with that name: - (nconc (ad-get-advice-info-macro function) - (list (cons field value))))))) + (let ((info (ad-get-advice-info function))) + (and info + (cond ((assq field info) + ;; A field with that name is already present: + (rplacd (assq field info) value)) + (t;; otherwise, create a new field with that name: + (nconc info (list (cons field value)))))))) ;; Don't make this a macro so we can use it as a predicate: (defun ad-is-active (function) @@ -1849,7 +1843,7 @@ function at point for which PREDICATE returns non-nil)." (require 'help) (function-called-at-point)))) (and function - (assoc (symbol-name function) ad-advised-functions) + (member (symbol-name function) ad-advised-functions) (or (null predicate) (funcall predicate function)) function)) @@ -1939,9 +1933,9 @@ be used to prompt for the function." ;; @@ Finding, enabling, adding and removing pieces of advice: ;; =========================================================== -(defmacro ad-find-advice (function class name) +(defsubst ad-find-advice (function class name) "Find the first advice of FUNCTION in CLASS with NAME." - `(assq ,name (ad-get-advice-info-field ,function ,class))) + (assq name (ad-get-advice-info-field function class))) (defun ad-advice-position (function class name) "Return position of first advice of FUNCTION in CLASS with NAME." @@ -2109,34 +2103,33 @@ the cache-id will clear the cache." ;; @@ Accessing and manipulating function definitions: ;; =================================================== -(defmacro ad-macrofy (definition) +(defsubst ad-macrofy (definition) "Take a lambda function DEFINITION and make a macro out of it." - `(cons 'macro ,definition)) + (cons 'macro definition)) -(defmacro ad-lambdafy (definition) - "Take a macro function DEFINITION and make a lambda out of it." - `(cdr ,definition)) +(defalias 'ad-lambdafy #'cdr + "Take a macro function DEFINITION and make a lambda out of it.") -(defmacro ad-lambda-p (definition) +(defsubst ad-lambda-p (definition) ;;"non-nil if DEFINITION is a lambda expression." - `(eq (car-safe ,definition) 'lambda)) + (eq (car-safe definition) 'lambda)) ;; see ad-make-advice for the format of advice definitions: -(defmacro ad-advice-p (definition) +(defsubst ad-advice-p (definition) ;;"non-nil if DEFINITION is a piece of advice." - `(eq (car-safe ,definition) 'advice)) + (eq (car-safe definition) 'advice)) -(defmacro ad-compiled-p (definition) +(defsubst ad-compiled-p (definition) "Return non-nil if DEFINITION is a compiled byte-code object." - `(or (byte-code-function-p ,definition) - (and (macrop ,definition) - (byte-code-function-p (ad-lambdafy ,definition))))) + (or (byte-code-function-p definition) + (and (macrop definition) + (byte-code-function-p (ad-lambdafy definition))))) -(defmacro ad-compiled-code (compiled-definition) +(defsubst ad-compiled-code (compiled-definition) "Return the byte-code object of a COMPILED-DEFINITION." - `(if (macrop ,compiled-definition) - (ad-lambdafy ,compiled-definition) - ,compiled-definition)) + (if (macrop compiled-definition) + (ad-lambdafy compiled-definition) + compiled-definition)) (defun ad-lambda-expression (definition) "Return the lambda expression of a function/macro/advice DEFINITION." @@ -2697,15 +2690,15 @@ should be modified. The assembled function will be returned." ;; the added efficiency. The validation itself is also pretty cheap, certainly ;; a lot cheaper than reconstructing an advised definition. -(defmacro ad-get-cache-definition (function) - `(car (ad-get-advice-info-field ,function 'cache))) +(defsubst ad-get-cache-definition (function) + (car (ad-get-advice-info-field function 'cache))) -(defmacro ad-get-cache-id (function) - `(cdr (ad-get-advice-info-field ,function 'cache))) +(defsubst ad-get-cache-id (function) + (cdr (ad-get-advice-info-field function 'cache))) -(defmacro ad-set-cache (function definition id) - `(ad-set-advice-info-field - ,function 'cache (cons ,definition ,id))) +(defsubst ad-set-cache (function definition id) + (ad-set-advice-info-field + function 'cache (cons definition id))) (defun ad-clear-cache (function) "Clears a previously cached advised definition of FUNCTION. @@ -2813,7 +2806,7 @@ advised definition from scratch." ;; advised definition will be generated. (defun ad-preactivate-advice (function advice class position) - "Preactivate FUNCTION and returns the constructed cache." + "Preactivate FUNCTION and return the constructed cache." (let* ((advicefunname (ad-get-advice-info-field function 'advicefunname)) (old-advice (symbol-function advicefunname)) (old-advice-info (ad-copy-advice-info function)) @@ -3098,9 +3091,8 @@ deactivation, which might run hooks and get into other trouble." ;; Completion alist of valid `defadvice' flags -(defvar ad-defadvice-flags - '(("protect") ("disable") ("activate") - ("compile") ("preactivate"))) +(defconst ad-defadvice-flags + '("protect" "disable" "activate" "compile" "preactivate")) ;;;###autoload (defmacro defadvice (function args &rest body) @@ -3180,7 +3172,7 @@ usage: (defadvice FUNCTION (CLASS NAME [POSITION] [ARGLIST] FLAG...) (let ((completion (try-completion (symbol-name flag) ad-defadvice-flags))) (cond ((eq completion t) flag) - ((assoc completion ad-defadvice-flags) + ((member completion ad-defadvice-flags) (intern completion)) (t (error "defadvice: Invalid or ambiguous flag: %s" flag)))))) @@ -3221,7 +3213,7 @@ usage: (defadvice FUNCTION (CLASS NAME [POSITION] [ARGLIST] FLAG...) For any members of FUNCTIONS that are not currently advised the rebinding will be a noop. Any modifications done to the definitions of FUNCTIONS will be undone on exit of this macro." - (declare (indent 1)) + (declare (indent 1) (obsolete nil "27.1")) (let* ((index -1) ;; Make let-variables to store current definitions: (current-bindings |