diff options
Diffstat (limited to 'lisp/emacs-lisp/advice.el')
| -rw-r--r-- | lisp/emacs-lisp/advice.el | 94 |
1 files changed, 43 insertions, 51 deletions
diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el index aaa12e8e3f9..b9a3a32a9b6 100644 --- a/lisp/emacs-lisp/advice.el +++ b/lisp/emacs-lisp/advice.el @@ -1840,8 +1840,7 @@ function at point for which PREDICATE returns non-nil)." (or default ;; Prefer func name at point, if it's an advised function etc. (let ((function (progn - (require 'help) - (function-called-at-point)))) + (function-called-at-point)))) (and function (member (symbol-name function) ad-advised-functions) (or (null predicate) @@ -1856,7 +1855,7 @@ function at point for which PREDICATE returns non-nil)." "There are no qualifying advised functions"))) (let* ((function (completing-read - (format "%s (default %s): " (or prompt "Function") default) + (format-prompt (or prompt "Function") default) ad-advised-functions (if predicate (lambda (function) @@ -1884,7 +1883,7 @@ class of FUNCTION)." (cl-return class))) (error "ad-read-advice-class: `%s' has no advices" function))) (let ((class (completing-read - (format "%s (default %s): " (or prompt "Class") default) + (format-prompt (or prompt "Class") default) ad-advice-class-completion-table nil t))) (if (equal class "") default @@ -1894,16 +1893,16 @@ class of FUNCTION)." "Read name of existing advice of CLASS for FUNCTION with completion. An optional PROMPT is used to prompt for the name." (let* ((name-completion-table - (mapcar (function (lambda (advice) - (list (symbol-name (ad-advice-name advice))))) + (mapcar (lambda (advice) + (list (symbol-name (ad-advice-name advice)))) (ad-get-advice-info-field function class))) (default (if (null name-completion-table) (error "ad-read-advice-name: `%s' has no %s advice" function class) (car (car name-completion-table)))) - (prompt (format "%s (default %s): " (or prompt "Name") default)) - (name (completing-read prompt name-completion-table nil t))) + (name (completing-read (format-prompt (or prompt "Name") default) + name-completion-table nil t))) (if (equal name "") (intern default) (intern name)))) @@ -1923,9 +1922,9 @@ be used to prompt for the function." (defun ad-read-regexp (&optional prompt) "Read a regular expression from the minibuffer." (let ((regexp (read-from-minibuffer - (concat (or prompt "Regular expression") - (if (equal ad-last-regexp "") ": " - (format " (default %s): " ad-last-regexp)))))) + (format-prompt (or prompt "Regular expression") + (and (not (equal ad-last-regexp "")) + ad-last-regexp))))) (setq ad-last-regexp (if (equal regexp "") ad-last-regexp regexp)))) @@ -2224,8 +2223,6 @@ For that it has to be fbound with a non-autoload definition." (let ((byte-compile-warnings byte-compile-warnings) ;; Don't pop up windows showing byte-compiler warnings. (warning-suppress-types '((bytecomp)))) - (if (featurep 'cl) - (byte-compile-disable-warning 'cl-functions)) (byte-compile (ad-get-advice-info-field function 'advicefunname)))) ;; @@@ Accessing argument lists: @@ -2255,13 +2252,11 @@ element is its actual current value, and the third element is either (let* ((parsed-arglist (ad-parse-arglist arglist)) (rest (nth 2 parsed-arglist))) `(list - ,@(mapcar (function - (lambda (req) - `(list ',req ,req 'required))) + ,@(mapcar (lambda (req) + `(list ',req ,req 'required)) (nth 0 parsed-arglist)) - ,@(mapcar (function - (lambda (opt) - `(list ',opt ,opt 'optional))) + ,@(mapcar (lambda (opt) + `(list ',opt ,opt 'optional)) (nth 1 parsed-arglist)) ,@(if rest (list `(list ',rest ,rest 'rest)))))) @@ -2372,28 +2367,26 @@ The assignment starts at position INDEX." (defun ad-insert-argument-access-forms (definition arglist) "Expands arg-access text macros in DEFINITION according to ARGLIST." (ad-substitute-tree - (function - (lambda (form) - (or (eq form 'ad-arg-bindings) - (and (memq (car-safe form) - '(ad-get-arg ad-get-args ad-set-arg ad-set-args)) - (integerp (car-safe (cdr form))))))) - (function - (lambda (form) - (if (eq form 'ad-arg-bindings) - (ad-retrieve-args-form arglist) - (let ((accessor (car form)) - (index (car (cdr form))) - (val (car (cdr (ad-insert-argument-access-forms - (cdr form) arglist))))) - (cond ((eq accessor 'ad-get-arg) - (ad-get-argument arglist index)) - ((eq accessor 'ad-set-arg) - (ad-set-argument arglist index val)) - ((eq accessor 'ad-get-args) - (ad-get-arguments arglist index)) - ((eq accessor 'ad-set-args) - (ad-set-arguments arglist index val))))))) + (lambda (form) + (or (eq form 'ad-arg-bindings) + (and (memq (car-safe form) + '(ad-get-arg ad-get-args ad-set-arg ad-set-args)) + (integerp (car-safe (cdr form)))))) + (lambda (form) + (if (eq form 'ad-arg-bindings) + (ad-retrieve-args-form arglist) + (let ((accessor (car form)) + (index (car (cdr form))) + (val (car (cdr (ad-insert-argument-access-forms + (cdr form) arglist))))) + (cond ((eq accessor 'ad-get-arg) + (ad-get-argument arglist index)) + ((eq accessor 'ad-set-arg) + (ad-set-argument arglist index val)) + ((eq accessor 'ad-get-args) + (ad-get-arguments arglist index)) + ((eq accessor 'ad-set-args) + (ad-set-arguments arglist index val)))))) definition)) ;; @@@ Mapping argument lists: @@ -2412,8 +2405,9 @@ as if they had been supplied to a function with TARGET-ARGLIST directly. Excess source arguments will be neglected, missing source arguments will be supplied as nil. Returns a `funcall' or `apply' form with the second element being `function' which has to be replaced by an actual function argument. -Example: (ad-map-arglists \\='(a &rest args) \\='(w x y z)) will return - (funcall ad--addoit-function a (car args) (car (cdr args)) (nth 2 args))." +Example: + (ad-map-arglists \\='(a &rest args) \\='(w x y z)) will return + (funcall ad--addoit-function a (car args) (car (cdr args)) (nth 2 args))." (let* ((parsed-source-arglist (ad-parse-arglist source-arglist)) (source-reqopt-args (append (nth 0 parsed-source-arglist) (nth 1 parsed-source-arglist))) @@ -2623,8 +2617,8 @@ should be modified. The assembled function will be returned." (defun ad-make-hook-form (function hook-name) "Make hook-form from FUNCTION's advice bodies in class HOOK-NAME." (let ((hook-forms - (mapcar (function (lambda (advice) - (ad-body-forms (ad-advice-definition advice)))) + (mapcar (lambda (advice) + (ad-body-forms (ad-advice-definition advice))) (ad-get-enabled-advices function hook-name)))) (if hook-forms (macroexp-progn (apply 'append hook-forms))))) @@ -3167,15 +3161,14 @@ usage: (defadvice FUNCTION (CLASS NAME [POSITION] [ARGLIST] FLAG...) (setq args (cdr args))))) (flags (mapcar - (function - (lambda (flag) + (lambda (flag) (let ((completion (try-completion (symbol-name flag) ad-defadvice-flags))) (cond ((eq completion t) flag) ((member completion ad-defadvice-flags) (intern completion)) (t (error "defadvice: Invalid or ambiguous flag: %s" - flag)))))) + flag))))) args)) (advice (ad-make-advice name (memq 'protect flags) @@ -3217,11 +3210,10 @@ undone on exit of this macro." (let* ((index -1) ;; Make let-variables to store current definitions: (current-bindings - (mapcar (function - (lambda (function) + (mapcar (lambda (function) (setq index (1+ index)) (list (intern (format "ad-oRiGdEf-%d" index)) - `(symbol-function ',function)))) + `(symbol-function ',function))) functions))) `(let ,current-bindings (unwind-protect |