diff options
| author | Stefan Monnier | 2022-08-13 12:03:22 -0400 |
|---|---|---|
| committer | Stefan Monnier | 2022-08-13 12:04:29 -0400 |
| commit | dd2973bf5040d26d29a937d252eeaf2884dca9fb (patch) | |
| tree | ef063a3ecb770068d823623f6446b3f3f251080d | |
| parent | a1cf3b96f84794b708a9d80281d4e9deadfb610c (diff) | |
| download | emacs-dd2973bf5040d26d29a937d252eeaf2884dca9fb.tar.gz emacs-dd2973bf5040d26d29a937d252eeaf2884dca9fb.zip | |
nadvice.el: Avoid exponential blow up in interactive-form recursion
* lisp/emacs-lisp/nadvice.el (advice--interactive-form): Sink the call
to `commandp` into the autoloaded function case since it's redundant in
the other branch.
(advice--make-interactive-form): Take just the interactive forms rather
than the actual functions as arguments.
(oclosure-interactive-form): Use `advice--interactive-form` rather than
`commandp` since we'd call `advice--interactive-form` afterwards anyway.
| -rw-r--r-- | lisp/emacs-lisp/nadvice.el | 26 |
1 files changed, 13 insertions, 13 deletions
diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el index 2d5a1b5e77b..86f26fc0d84 100644 --- a/lisp/emacs-lisp/nadvice.el +++ b/lisp/emacs-lisp/nadvice.el | |||
| @@ -167,31 +167,31 @@ DOC is a string where \"FUNCTION\" and \"OLDFUN\" are expected.") | |||
| 167 | 167 | ||
| 168 | (defun advice--interactive-form (function) | 168 | (defun advice--interactive-form (function) |
| 169 | "Like `interactive-form' but tries to avoid autoloading functions." | 169 | "Like `interactive-form' but tries to avoid autoloading functions." |
| 170 | (when (commandp function) | 170 | (if (not (and (symbolp function) (autoloadp (indirect-function function)))) |
| 171 | (if (not (and (symbolp function) (autoloadp (indirect-function function)))) | 171 | (interactive-form function) |
| 172 | (interactive-form function) | 172 | (when (commandp function) |
| 173 | `(interactive (advice-eval-interactive-spec | 173 | `(interactive (advice--eval-interactive-spec |
| 174 | (cadr (interactive-form ',function))))))) | 174 | (cadr (interactive-form ',function))))))) |
| 175 | 175 | ||
| 176 | (defun advice--make-interactive-form (function main) | 176 | (defun advice--make-interactive-form (iff ifm) |
| 177 | ;; TODO: make it so that interactive spec can be a constant which | 177 | ;; TODO: make it so that interactive spec can be a constant which |
| 178 | ;; dynamically checks the advice--car/cdr to do its job. | 178 | ;; dynamically checks the advice--car/cdr to do its job. |
| 179 | ;; For that, advice-eval-interactive-spec needs to be more faithful. | 179 | ;; For that, advice-eval-interactive-spec needs to be more faithful. |
| 180 | (let* ((iff (advice--interactive-form function)) | 180 | (let* ((fspec (cadr iff))) |
| 181 | (ifm (advice--interactive-form main)) | ||
| 182 | (fspec (cadr iff))) | ||
| 183 | (when (eq 'function (car-safe fspec)) ;; Macroexpanded lambda? | 181 | (when (eq 'function (car-safe fspec)) ;; Macroexpanded lambda? |
| 184 | (setq fspec (nth 1 fspec))) | 182 | (setq fspec (eval fspec t))) |
| 185 | (if (functionp fspec) | 183 | (if (functionp fspec) |
| 186 | `(funcall ',fspec ',(cadr ifm)) | 184 | `(funcall ',fspec ',(cadr ifm)) |
| 187 | (cadr (or iff ifm))))) | 185 | (cadr (or iff ifm))))) |
| 188 | 186 | ||
| 189 | 187 | ||
| 190 | (cl-defmethod oclosure-interactive-form ((ad advice) &optional _) | 188 | (cl-defmethod oclosure-interactive-form ((ad advice) &optional _) |
| 191 | (let ((car (advice--car ad)) | 189 | (let* ((car (advice--car ad)) |
| 192 | (cdr (advice--cdr ad))) | 190 | (cdr (advice--cdr ad)) |
| 193 | (when (or (commandp car) (commandp cdr)) | 191 | (ifa (advice--interactive-form car)) |
| 194 | `(interactive ,(advice--make-interactive-form car cdr))))) | 192 | (ifd (advice--interactive-form cdr))) |
| 193 | (when (or ifa ifd) | ||
| 194 | `(interactive ,(advice--make-interactive-form ifa ifd))))) | ||
| 195 | 195 | ||
| 196 | (cl-defmethod cl-print-object ((object advice) stream) | 196 | (cl-defmethod cl-print-object ((object advice) stream) |
| 197 | (cl-assert (advice--p object)) | 197 | (cl-assert (advice--p object)) |