mirror of
git://git.sv.gnu.org/emacs.git
synced 2025-12-15 10:30:25 -08:00
* lisp/emacs-lisp/advice.el: Only use defmacro when needed
(ad-get-advice-info): Mark it inlinable. (ad-get-advice-info-macro): Make it an obsolete alias. (ad-copy-advice-info, ad-is-advised, ad-get-advice-info-field) (ad-find-advice, ad-macrofy, ad-lambdafy, ad-lambda-p, ad-advice-p) (ad-compiled-p, ad-compiled-code, ad-get-cache-definition) (ad-get-cache-id, ad-set-cache): Turn macros into defsubsts. (ad-defadvice-flags): Make it into a plain list. (ad-set-advice-info-field): Apply a bit of CSE.
This commit is contained in:
Stefan Monnier
parent
77c3c464a1
commit
458948189e
1 changed files with 45 additions and 48 deletions
|
|
@ -1681,11 +1681,11 @@ On each iteration VAR will be bound to the name of an advised function
|
|||
(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
|
||||
|
|
@ -1697,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.
|
||||
|
|
@ -1711,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)
|
||||
|
|
@ -1934,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."
|
||||
|
|
@ -2104,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."
|
||||
|
|
@ -2692,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.
|
||||
|
|
@ -3093,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)
|
||||
|
|
@ -3175,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))))))
|
||||
|
|
@ -3216,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
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue