diff options
Diffstat (limited to 'lisp/emacs-lisp/advice.el')
| -rw-r--r-- | lisp/emacs-lisp/advice.el | 63 |
1 files changed, 21 insertions, 42 deletions
diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el index ed97c8786d4..dbebf314798 100644 --- a/lisp/emacs-lisp/advice.el +++ b/lisp/emacs-lisp/advice.el @@ -2467,27 +2467,11 @@ will clear the cache." "Take a macro function DEFINITION and make a lambda out of it." `(cdr ,definition)) -;; There is no way to determine whether some subr is a special form or not, -;; hence we need this list (which is probably out of date): -(defvar ad-special-forms - (let ((tem '(and catch cond condition-case defconst defmacro - defun defvar function if interactive let let* - or prog1 prog2 progn quote save-current-buffer - save-excursion save-restriction save-window-excursion - setq setq-default unwind-protect while - with-output-to-temp-buffer))) - ;; track-mouse could be void in some configurations. - (if (fboundp 'track-mouse) - (push 'track-mouse tem)) - (mapcar 'symbol-function tem))) - -(defmacro ad-special-form-p (definition) - ;;"non-nil if DEFINITION is a special form." - (list 'memq definition 'ad-special-forms)) - -(defmacro ad-interactive-p (definition) - ;;"non-nil if DEFINITION can be called interactively." - (list 'commandp definition)) +(defun ad-special-form-p (definition) + "Non-nil iff DEFINITION is a special form." + (if (and (symbolp definition) (fboundp definition)) + (setq definition (indirect-function definition))) + (and (subrp definition) (eq (cdr (subr-arity definition)) 'unevalled))) (defmacro ad-subr-p (definition) ;;"non-nil if DEFINITION is a subr." @@ -2603,13 +2587,12 @@ that property, or otherwise use `(&rest ad-subr-args)'." docstring))) (defun ad-interactive-form (definition) - "Return the interactive form of DEFINITION." - (cond ((ad-compiled-p definition) - (and (commandp definition) - (list 'interactive (aref (ad-compiled-code definition) 5)))) - ((or (ad-advice-p definition) - (ad-lambda-p definition)) - (commandp (ad-lambda-expression definition))))) + "Return the interactive form of DEFINITION. +Like `interactive-form', but also works on pieces of advice." + (interactive-form + (if (ad-advice-p definition) + (ad-lambda-expression definition) + definition))) (defun ad-body-forms (definition) "Return the list of body forms of DEFINITION." @@ -3063,7 +3046,7 @@ in any of these classes." (ad-has-redefining-advice function)) (let* ((origdef (ad-real-orig-definition function)) (origname (ad-get-advice-info-field function 'origname)) - (orig-interactive-p (ad-interactive-p origdef)) + (orig-interactive-p (commandp origdef)) (orig-subr-p (ad-subr-p origdef)) (orig-special-form-p (ad-special-form-p origdef)) (orig-macro-p (ad-macro-p origdef)) @@ -3075,15 +3058,11 @@ in any of these classes." (interactive-form (cond (orig-macro-p nil) (advised-interactive-form) - ((ad-interactive-form origdef) - (if (and (symbolp function) (get function 'elp-info)) - (interactive-form (aref (get function 'elp-info) 2)) - (ad-interactive-form origdef))) - ;; Otherwise we must have a subr: make it interactive if - ;; we have to and initialize required arguments in case - ;; it is called interactively: - (orig-interactive-p - (interactive-form origdef)))) + ((interactive-form origdef) + (interactive-form + (if (and (symbolp function) (get function 'elp-info)) + (aref (get function 'elp-info) 2) + origdef))))) (orig-form (cond ((or orig-special-form-p orig-macro-p) ;; Special forms and macros will be advised into macros. @@ -3306,8 +3285,8 @@ advised definition from scratch." t (ad-arglist original-definition function)) (if (eq (ad-definition-type original-definition) 'function) - (equal (ad-interactive-form original-definition) - (ad-interactive-form cached-definition)))))) + (equal (interactive-form original-definition) + (interactive-form cached-definition)))))) (defun ad-get-cache-class-id (function class) "Return the part of FUNCTION's cache id that identifies CLASS." @@ -3354,8 +3333,8 @@ advised definition from scratch." (ad-arglist cached-definition)) (setq code 'interactive-form-mismatch) (or (null (nth 5 cache-id)) - (equal (ad-interactive-form original-definition) - (ad-interactive-form cached-definition))) + (equal (interactive-form original-definition) + (interactive-form cached-definition))) (setq code 'verified)))) code)) |