diff options
| -rw-r--r-- | lisp/ChangeLog | 7 | ||||
| -rw-r--r-- | lisp/emacs-lisp/nadvice.el | 34 |
2 files changed, 23 insertions, 18 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 94240d63a6c..e23f4c19a85 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,3 +1,10 @@ | |||
| 1 | 2014-03-17 Stefan <monnier@iro.umontreal.ca> | ||
| 2 | |||
| 3 | * emacs-lisp/nadvice.el (advice--interactive-form): New function. | ||
| 4 | (advice--make-interactive-form): Use it to avoid (auto)loading function. | ||
| 5 | (advice--make-1, advice-add, advice-remove): | ||
| 6 | Remove braindead :advice-pending hack. | ||
| 7 | |||
| 1 | 2014-03-17 Glenn Morris <rgm@gnu.org> | 8 | 2014-03-17 Glenn Morris <rgm@gnu.org> |
| 2 | 9 | ||
| 3 | * calendar/calendar.el (calendar-generate-month): Apply weekend | 10 | * calendar/calendar.el (calendar-generate-month): Apply weekend |
diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el index f75fb23147f..f480d17557c 100644 --- a/lisp/emacs-lisp/nadvice.el +++ b/lisp/emacs-lisp/nadvice.el | |||
| @@ -123,30 +123,34 @@ Each element has the form (WHERE BYTECODE STACK) where: | |||
| 123 | ;; ((functionp spec) (funcall spec)) | 123 | ;; ((functionp spec) (funcall spec)) |
| 124 | (t (eval spec)))) | 124 | (t (eval spec)))) |
| 125 | 125 | ||
| 126 | (defun advice--interactive-form (function) | ||
| 127 | ;; Like `interactive-form' but tries to avoid autoloading functions. | ||
| 128 | (when (commandp function) | ||
| 129 | (if (not (and (symbolp function) (autoloadp (symbol-function function)))) | ||
| 130 | (interactive-form function) | ||
| 131 | `(interactive (advice-eval-interactive-spec | ||
| 132 | (cadr (interactive-form ',function))))))) | ||
| 133 | |||
| 126 | (defun advice--make-interactive-form (function main) | 134 | (defun advice--make-interactive-form (function main) |
| 127 | ;; TODO: make it so that interactive spec can be a constant which | 135 | ;; TODO: make it so that interactive spec can be a constant which |
| 128 | ;; dynamically checks the advice--car/cdr to do its job. | 136 | ;; dynamically checks the advice--car/cdr to do its job. |
| 129 | ;; For that, advice-eval-interactive-spec needs to be more faithful. | 137 | ;; For that, advice-eval-interactive-spec needs to be more faithful. |
| 130 | (let ((fspec (cadr (interactive-form function)))) | 138 | (let* ((iff (advice--interactive-form function)) |
| 139 | (ifm (advice--interactive-form main)) | ||
| 140 | (fspec (cadr iff))) | ||
| 131 | (when (eq 'function (car-safe fspec)) ;; Macroexpanded lambda? | 141 | (when (eq 'function (car-safe fspec)) ;; Macroexpanded lambda? |
| 132 | (setq fspec (nth 1 fspec))) | 142 | (setq fspec (nth 1 fspec))) |
| 133 | (if (functionp fspec) | 143 | (if (functionp fspec) |
| 134 | `(funcall ',fspec | 144 | `(funcall ',fspec ',(cadr ifm)) |
| 135 | ',(cadr (interactive-form main))) | 145 | (cadr (or iff ifm))))) |
| 136 | (cadr (or (interactive-form function) | ||
| 137 | (interactive-form main)))))) | ||
| 138 | 146 | ||
| 139 | (defsubst advice--make-1 (byte-code stack-depth function main props) | 147 | (defun advice--make-1 (byte-code stack-depth function main props) |
| 140 | "Build a function value that adds FUNCTION to MAIN." | 148 | "Build a function value that adds FUNCTION to MAIN." |
| 141 | (let ((adv-sig (gethash main advertised-signature-table)) | 149 | (let ((adv-sig (gethash main advertised-signature-table)) |
| 142 | (advice | 150 | (advice |
| 143 | (apply #'make-byte-code 128 byte-code | 151 | (apply #'make-byte-code 128 byte-code |
| 144 | (vector #'apply function main props) stack-depth nil | 152 | (vector #'apply function main props) stack-depth nil |
| 145 | (and (or (commandp function) (commandp main)) | 153 | (and (or (commandp function) (commandp main)) |
| 146 | ;; If we're adding the advice on advice--pending, don't | ||
| 147 | ;; build an interactive-form, which won't be used anyway | ||
| 148 | ;; and would risk autoloading `main' (or `function'). | ||
| 149 | (not (eq main :advice--pending)) | ||
| 150 | (list (advice--make-interactive-form | 154 | (list (advice--make-interactive-form |
| 151 | function main)))))) | 155 | function main)))))) |
| 152 | (when adv-sig (puthash advice adv-sig advertised-signature-table)) | 156 | (when adv-sig (puthash advice adv-sig advertised-signature-table)) |
| @@ -387,14 +391,11 @@ is defined as a macro, alias, command, ..." | |||
| 387 | ;; Reasons to delay installation of the advice: | 391 | ;; Reasons to delay installation of the advice: |
| 388 | ;; - If the function is not yet defined, installing | 392 | ;; - If the function is not yet defined, installing |
| 389 | ;; the advice would affect `fboundp'ness. | 393 | ;; the advice would affect `fboundp'ness. |
| 390 | ;; - If it's an autoloaded command, | 394 | ;; - the symbol-function slot of an autoloaded |
| 391 | ;; advice--make-interactive-form would end up | 395 | ;; function is not itself a function value. |
| 392 | ;; loading the command eagerly. | ||
| 393 | ;; - `autoload' does nothing if the function is | 396 | ;; - `autoload' does nothing if the function is |
| 394 | ;; not an autoload or undefined. | 397 | ;; not an autoload or undefined. |
| 395 | ((or (not nf) (autoloadp nf)) | 398 | ((or (not nf) (autoloadp nf)) |
| 396 | (unless (get symbol 'advice--pending) | ||
| 397 | (put symbol 'advice--pending :advice--pending)) | ||
| 398 | (get symbol 'advice--pending)) | 399 | (get symbol 'advice--pending)) |
| 399 | (t (symbol-function symbol))) | 400 | (t (symbol-function symbol))) |
| 400 | function props) | 401 | function props) |
| @@ -418,9 +419,6 @@ of the piece of advice." | |||
| 418 | (t (symbol-function symbol))) | 419 | (t (symbol-function symbol))) |
| 419 | function) | 420 | function) |
| 420 | (unless (advice--p (advice--symbol-function symbol)) | 421 | (unless (advice--p (advice--symbol-function symbol)) |
| 421 | ;; Not advised any more. | ||
| 422 | (when (eq (get symbol 'advice--pending) :advice--pending) | ||
| 423 | (put symbol 'advice--pending nil)) | ||
| 424 | (remove-function (get symbol 'defalias-fset-function) | 422 | (remove-function (get symbol 'defalias-fset-function) |
| 425 | #'advice--defalias-fset) | 423 | #'advice--defalias-fset) |
| 426 | (let ((asr (get symbol 'advice--saved-rewrite))) | 424 | (let ((asr (get symbol 'advice--saved-rewrite))) |