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.

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).

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

lisp/simple.el

@@ -2653,6 +2653,9 @@ function as needed."
 (cl-defmethod function-documentation ((function accessor))
   (oclosure--accessor-docstring function)) ;; FIXME: η-reduce!
 
+(cl-defmethod function-documentation ((f cconv--interactive-helper))
+  (function-documentation (cconv--interactive-helper--fun f)))
+
 ;; This should be in `oclosure.el' but that file is loaded before `cl-generic'.
 (cl-defgeneric oclosure-interactive-form (_function)
   "Return the interactive form of FUNCTION or nil if none.
@@ -2664,6 +2667,9 @@ instead."
   ;; (interactive-form function)
   nil)
 
+(cl-defmethod oclosure-interactive-form ((f cconv--interactive-helper))
+  `(interactive (funcall ',(cconv--interactive-helper--if f))))
+
 (defun command-execute (cmd &optional record-flag keys special)
   ;; BEWARE: Called directly from the C code.
   "Execute CMD as an editor command.

test/lisp/emacs-lisp/cconv-tests.el

@@ -347,5 +347,15 @@
                       (list x (funcall g closed-x) (funcall h closed-x))))))))
   )
 
+(ert-deftest cconv-tests-interactive-closure-bug51695 ()
+  (let ((f (let ((d 51695))
+             (lambda (data)
+               (interactive (progn (setq d (1+ d)) (list d)))
+               (list (called-interactively-p 'any) data)))))
+    (should (equal (list (call-interactively f)
+                         (funcall f 51695)
+                         (call-interactively f))
+                   '((t 51696) (nil 51695) (t 51697))))))
+
 (provide 'cconv-tests)
 ;;; cconv-tests.el ends here