cconv.el: Fix interactive closure bug#51695

Make cconv.el detect when a closure's interactive form needs to
capture variables from the context and tweak the code accordingly
if so.

* lisp/emacs-lisp/cconv.el (cconv--interactive-form-funs): New var.
(cconv-convert): Handle the case where the interactive form captures
vars from the surrounding context.  Remove left over handling of
`declare` which was already removed from the cconv-analyze` phase.
(cconv-analyze-form): Adjust analysis of interactive forms accordingly.

* lisp/emacs-lisp/oclosure.el (cconv--interactive-helper): New type and
function.
* lisp/simple.el (function-documentation, oclosure-interactive-form):
Add methods for it.

* test/lisp/emacs-lisp/cconv-tests.el
(cconv-tests-interactive-closure-bug51695): New test.

2 files changed, 51 insertions, 15 deletions

diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el
index 7f95fa94fa1..23d0f121948 100644
--- a/lisp/emacs-lisp/cconv.el
+++ b/lisp/emacs-lisp/cconv.el
@@ -137,6 +137,11 @@ is less than this number.")
   ;; Alist associating to each function body the list of its free variables.
   )
 
+(defvar cconv--interactive-form-funs
+  ;; Table used to hold the functions we create internally for
+  ;; interactive forms.
+  (make-hash-table :test #'eq :weakness 'key))
+
 ;;;###autoload
 (defun cconv-closure-convert (form)
   "Main entry point for closure conversion.
@@ -503,9 +508,23 @@ places where they originally did not directly appear."
                               cond-forms)))
 
     (`(function (lambda ,args . ,body) . ,_)
-     (let ((docstring (if (eq :documentation (car-safe (car body)))
-                          (cconv-convert (cadr (pop body)) env extend))))
-       (cconv--convert-function args body env form docstring)))
+     (let* ((docstring (if (eq :documentation (car-safe (car body)))
+                           (cconv-convert (cadr (pop body)) env extend)))
+            (bf (if (stringp (car body)) (cdr body) body))
+            (if (when (eq 'interactive (car-safe (car bf)))
+                  (gethash form cconv--interactive-form-funs)))
+            (cif (when if (cconv-convert if env extend)))
+            (_ (pcase cif
+                 (`#'(lambda () ,form) (setf (cadr (car bf)) form) (setq cif nil))
+                 ('nil nil)
+                 ;; The interactive form needs special treatment, so the form
+                 ;; inside the `interactive' won't be used any further.
+                 (_ (setf (cadr (car bf)) nil))))
+            (cf (cconv--convert-function args body env form docstring)))
+       (if (not cif)
+           ;; Normal case, the interactive form needs no special treatment.
+           cf
+         `(cconv--interactive-helper ,cf ,cif))))
 
     (`(internal-make-closure . ,_)
      (byte-compile-report-error
@@ -589,12 +608,12 @@ places where they originally did not directly appear."
                                    (cconv-convert arg env extend))
                                  (cons fun args)))))))
 
-    (`(interactive . ,forms)
-     `(,(car form) . ,(mapcar (lambda (form)
-                                (cconv-convert form nil nil))
-                              forms)))
+    ;; The form (if any) is converted beforehand as part of the `lambda' case.
+    (`(interactive . ,_) form)
 
-    (`(declare . ,_) form)              ;The args don't contain code.
+    ;; `declare' should now be macro-expanded away (and if they're not, we're
+    ;; in trouble because they *can* contain code nowadays).
+    ;; (`(declare . ,_) form)              ;The args don't contain code.
 
     (`(oclosure--fix-type (ignore . ,vars) ,exp)
      (dolist (var vars)
@@ -739,6 +758,13 @@ This function does not return anything but instead fills the
     (`(function (lambda ,vrs . ,body-forms))
      (when (eq :documentation (car-safe (car body-forms)))
        (cconv-analyze-form (cadr (pop body-forms)) env))
+     (let ((bf (if (stringp (car body-forms)) (cdr body-forms) body-forms)))
+       (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)))
+               (setf (gethash form cconv--interactive-form-funs) f)
+               (cconv-analyze-form f env))))))
      (cconv--analyze-function vrs body-forms env form))
 
     (`(setq ,var ,expr)
@@ -803,13 +829,8 @@ This function does not return anything but instead fills the
          (cconv-analyze-form fun env)))
      (dolist (form args) (cconv-analyze-form form env)))
 
-    (`(interactive . ,forms)
-     ;; These appear within the function body but they don't have access
-     ;; to the function's arguments.
-     ;; We could extend this to allow interactive specs to refer to
-     ;; variables in the function's enclosing environment, but it doesn't
-     ;; seem worth the trouble.
-     (dolist (form forms) (cconv-analyze-form form nil)))
+    ;; The form (if any) is converted beforehand as part of the `lambda' case.
+    (`(interactive . ,_) nil)
 
     ;; `declare' should now be macro-expanded away (and if they're not, we're
     ;; in trouble because they *can* contain code nowadays).
diff --git a/lisp/emacs-lisp/oclosure.el b/lisp/emacs-lisp/oclosure.el
index 9775e8cc656..c77ac151d77 100644
--- a/lisp/emacs-lisp/oclosure.el
+++ b/lisp/emacs-lisp/oclosure.el
@@ -557,6 +557,21 @@ This has 2 uses:
 (oclosure-define (save-some-buffers-function
                   (:predicate save-some-buffers-function--p)))
 
+;; This OClosure type is used internally by `cconv.el' to handle
+;; the case where we need to build a closure whose `interactive' spec
+;; captures variables from the context.
+;; It arguably belongs with `cconv.el' but is needed at runtime,
+;; so we placed it here.
+(oclosure-define (cconv--interactive-helper) fun if)
+(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."
+  (oclosure-lambda (cconv--interactive-helper (fun fun) (if if))
+      (&rest args)
+    (apply (if (called-interactively-p 'any)
+               #'funcall-interactively #'funcall)
+           fun args)))
 
 (provide 'oclosure)
 ;;; oclosure.el ends here