aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--lisp/ChangeLog7
-rw-r--r--lisp/emacs-lisp/nadvice.el34
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 @@
12014-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
12014-03-17 Glenn Morris <rgm@gnu.org> 82014-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)))