summaryrefslogtreecommitdiff
path: root/lisp/emacs-lisp
diff options
context:
space:
mode:
authorStefan Monnier <monnier@iro.umontreal.ca>2018-09-17 14:02:05 -0400
committerStefan Monnier <monnier@iro.umontreal.ca>2018-09-17 14:02:05 -0400
commit458948189e56a110739ff9002236d269b8382293 (patch)
tree8be4c8a64aafbc8471fe36152c3fcb5ce4c36633 /lisp/emacs-lisp
parent77c3c464a1603e2675347c88bb8cde26a6a3e2f8 (diff)
downloademacs-458948189e56a110739ff9002236d269b8382293.tar.gz
emacs-458948189e56a110739ff9002236d269b8382293.tar.bz2
emacs-458948189e56a110739ff9002236d269b8382293.zip
* 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.
Diffstat (limited to 'lisp/emacs-lisp')
-rw-r--r--lisp/emacs-lisp/advice.el93
1 files changed, 45 insertions, 48 deletions
diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el
index 6fb28c4c4d3..04d2fbf444e 100644
--- a/lisp/emacs-lisp/advice.el
+++ b/lisp/emacs-lisp/advice.el
@@ -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