summaryrefslogtreecommitdiff
path: root/lisp/emacs-lisp
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/emacs-lisp')
-rw-r--r--lisp/emacs-lisp/cconv.el11
-rw-r--r--lisp/emacs-lisp/nadvice.el30
-rw-r--r--lisp/emacs-lisp/oclosure.el2
3 files changed, 33 insertions, 10 deletions
diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el
index e715bd90a00..e4268c2fb88 100644
--- a/lisp/emacs-lisp/cconv.el
+++ b/lisp/emacs-lisp/cconv.el
@@ -483,10 +483,13 @@ places where they originally did not directly appear."
(bf (if (stringp (car body)) (cdr body) body))
(if (when (eq 'interactive (car-safe (car bf)))
(gethash form cconv--interactive-form-funs)))
+ (wrapped (pcase if (`#'(lambda (_cconv--dummy) .,_) t) (_ nil)))
(cif (when if (cconv-convert if env extend)))
(_ (pcase cif
- (`#'(lambda () ,form) (setf (cadr (car bf)) form) (setq cif nil))
('nil nil)
+ (`#',f
+ (setf (cadr (car bf)) (if wrapped (nth 2 f) f))
+ (setq cif nil))
;; The interactive form needs special treatment, so the form
;; inside the `interactive' won't be used any further.
(_ (setf (cadr (car bf)) nil))))
@@ -494,7 +497,8 @@ places where they originally did not directly appear."
(if (not cif)
;; Normal case, the interactive form needs no special treatment.
cf
- `(cconv--interactive-helper ,cf ,cif))))
+ `(cconv--interactive-helper
+ ,cf ,(if wrapped cif `(list 'quote ,cif))))))
(`(internal-make-closure . ,_)
(byte-compile-report-error
@@ -742,7 +746,8 @@ This function does not return anything but instead fills the
(when (eq 'interactive (car-safe (car bf)))
(let ((if (cadr (car bf))))
(unless (macroexp-const-p if) ;Optimize this common case.
- (let ((f `#'(lambda () ,if)))
+ (let ((f (if (eq 'function (car-safe if)) if
+ `#'(lambda (_cconv--dummy) ,if))))
(setf (gethash form cconv--interactive-form-funs) f)
(cconv-analyze-form f env))))))
(cconv--analyze-function vrs body-forms env form))
diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el
index 85934d9ed0a..e457387acc9 100644
--- a/lisp/emacs-lisp/nadvice.el
+++ b/lisp/emacs-lisp/nadvice.el
@@ -178,20 +178,38 @@ DOC is a string where \"FUNCTION\" and \"OLDFUN\" are expected.")
;; ((functionp spec) (funcall spec))
(t (eval spec))))
+(defun advice--interactive-form-1 (function)
+ "Like `interactive-form' but preserves the static context if needed."
+ (let ((if (interactive-form function)))
+ (if (or (null if) (not (eq 'closure (car-safe function))))
+ if
+ (cl-assert (eq 'interactive (car if)))
+ (let ((form (cadr if)))
+ (if (macroexp-const-p form)
+ if
+ ;; The interactive is expected to be run in the static context
+ ;; that the function captured.
+ (let ((ctx (nth 1 function)))
+ `(interactive
+ ,(let* ((f (if (eq 'function (car-safe form)) (cadr form) form)))
+ ;; If the form jut returns a function, preserve the fact that
+ ;; it just returns a function, which is an info we use in
+ ;; `advice--make-interactive-form'.
+ (if (eq 'lambda (car-safe f))
+ `',(eval form ctx)
+ `(eval ',form ',ctx))))))))))
+
(defun advice--interactive-form (function)
"Like `interactive-form' but tries to avoid autoloading functions."
(if (not (and (symbolp function) (autoloadp (indirect-function function))))
- (interactive-form function)
+ (advice--interactive-form-1 function)
(when (commandp function)
`(interactive (advice-eval-interactive-spec
- (cadr (interactive-form ',function)))))))
+ (cadr (advice--interactive-form-1 ',function)))))))
(defun advice--make-interactive-form (iff ifm)
- ;; TODO: make it so that interactive spec can be a constant which
- ;; dynamically checks the advice--car/cdr to do its job.
- ;; For that, advice-eval-interactive-spec needs to be more faithful.
(let* ((fspec (cadr iff)))
- (when (eq 'function (car-safe fspec)) ;; Macroexpanded lambda?
+ (when (memq (car-safe fspec) '(function quote)) ;; Macroexpanded lambda?
(setq fspec (eval fspec t)))
(if (functionp fspec)
`(funcall ',fspec ',(cadr ifm))
diff --git a/lisp/emacs-lisp/oclosure.el b/lisp/emacs-lisp/oclosure.el
index f5a150ac4ae..40f1f54eed0 100644
--- a/lisp/emacs-lisp/oclosure.el
+++ b/lisp/emacs-lisp/oclosure.el
@@ -568,7 +568,7 @@ This has 2 uses:
(defun cconv--interactive-helper (fun if)
"Add interactive \"form\" IF to FUN.
Returns a new command that otherwise behaves like FUN.
-IF should actually not be a form but a function of no arguments."
+IF can be an ELisp form to be interpreted or a function of no arguments."
(oclosure-lambda (cconv--interactive-helper (fun fun) (if if))
(&rest args)
(apply (if (called-interactively-p 'any)