bug#54802: OClosure: Make `interactive-form` a generic function

[Stefan Monnier]

Package: Emacs
Version: 29.0.50


`nadvice.el` needs to build commands whose interactive spec is computed.
This currently can't be done with `lambda` (see also bug#51695 for
a related problem) but `nadvice.el` is unaffected because it assembles
its byte-code functions all by hand.  In order for `nadvice.el` to be
able to use OClosures, we need to address this limitation.

The patch below does it by making `interactive-form` a generic function,
so OClosures can compute their interactive specs from their slots.

Maybe it should be `call-interactively` that's turned into a generic
function (which would also open up the possibility to do more than just
compute the args to pass to the function, such as also printing the
return value or things like that), but that would be a more significant
change.

While the performance of `call-interactively` and `interactive-form` are
not critical, `commandp` is a function that is occasionally used in
tight loops (typically when filtering completions from `obarray`) so
I refrained from making it into a generic function, and instead I make
it defer to `interactive-form` when we counter what looks like an OClosure.

That keeps the common code as fast as before, tho it makes `commandp`
slow(ish) when applied to interactive OClosures.

Making `commandp` into a generic function would apparently slow down
a loop like

    (mapatoms (lambda (s) (if (commandp s) (cl-incf count))))

by a factor around 2x or 3x, which is not the end of the world but
doesn't seem justified.

The patch below also includes a use of this new generic function by
moving the interactive spec of kmacros from the kmacro objects
themselves to the generic function.  The gain is that each `kmacro` is
now 1 word smaller (negligible, in the grand scheme of things, but
I included it for illustration and testing purposes).

Any commment?  Objection?


        Stefan


diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi
index 74bf0f48692..eb29fd0044c 100644
--- a/doc/lispref/commands.texi
+++ b/doc/lispref/commands.texi
@@ -312,6 +312,8 @@ Using Interactive
 specifies how to compute its arguments.  Otherwise, the value is
 @code{nil}.  If @var{function} is a symbol, its function definition is
 used.
+This is a generic function, so additional methods can be used
+for specific function types, e.g. for advice and keyboard macros.
 @end defun
 
 @node Interactive Codes
diff --git a/etc/NEWS b/etc/NEWS
index 1043873f2d7..3728f9a9231 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1341,6 +1341,11 @@ Can dynamically generate a raw docstring depending on 
the type of
 a function.
 Used mainly for docstrings of OClosures.
 
++++
+** 'interactive-form' is now a generic function.
+This allows specific OClosure types to compute their interactive specs
+on demand rather than precompute them when created.
+
 +++
 ** Base64 encoding no longer tolerates latin-1 input.
 The functions 'base64-encode-string', 'base64url-encode-string',
diff --git a/lisp/kmacro.el b/lisp/kmacro.el
index 8a9d89929eb..9aaf90e0f5a 100644
--- a/lisp/kmacro.el
+++ b/lisp/kmacro.el
@@ -820,13 +820,14 @@ kmacro
                            (counter (or counter 0))
                            (format (or format "%d")))
       (&optional arg)
-    (interactive "p")
     ;; Use counter and format specific to the macro on the ring!
     (let ((kmacro-counter counter)
          (kmacro-counter-format-start format))
       (execute-kbd-macro keys arg #'kmacro-loop-setup-function)
       (setq counter kmacro-counter))))
 
+(cl-defmethod interactive-form ((_ kmacro) &optional _) '(interactive "p"))
+
 ;;;###autoload
 (defun kmacro-lambda-form (mac &optional counter format)
   ;; Apparently, there are two different ways this is called:
diff --git a/lisp/simple.el b/lisp/simple.el
index eb657018039..f14da3d6d74 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -2389,6 +2389,39 @@ function-documentation
 (cl-defmethod function-documentation ((function accessor))
   (oclosure--accessor-docstring function)) ;; FIXME: η-reduce!
 
+(cl-defgeneric interactive-form (cmd &optional original-name)
+  "Return the interactive form of CMD or nil if none.
+If CMD is not a command, the return value is nil.
+Value, if non-nil, is a list (interactive SPEC).
+ORIGINAL-NAME is used internally only."
+  (pcase cmd
+    ((pred symbolp)
+     (let ((fun (indirect-function cmd)))  ;Check cycles.
+       (when fun
+          (or (get cmd 'interactive-form)
+              (interactive-form (symbol-function cmd)
+                                (or original-name cmd))))))
+    ((pred byte-code-function-p)
+     (when (> (length cmd) 5)
+       (let ((form (aref cmd 5)))
+         (list 'interactive
+              (if (vectorp form)
+                  ;; The vector form is the new form, where the first
+                  ;; element is the interactive spec, and the second
+                  ;; is the "command modes" info.
+                  (aref form 0)
+                form)))))
+    ((pred autoloadp)
+     (interactive-form (autoload-do-load cmd original-name)))
+    ((or `(lambda ,_args . ,body)
+         `(closure ,_env ,_args . ,body))
+     (let ((spec (assq 'interactive body)))
+       (if (cddr spec)
+           ;; Drop the "command modes" info.
+           (list 'interactive (cadr spec))
+         spec)))
+    (_ (internal--interactive-form cmd))))
+
 (defun command-execute (cmd &optional record-flag keys special)
   ;; BEWARE: Called directly from the C code.
   "Execute CMD as an editor command.
diff --git a/src/callint.c b/src/callint.c
index 31919d6bb81..92bfaf8d397 100644
--- a/src/callint.c
+++ b/src/callint.c
@@ -315,7 +315,7 @@ DEFUN ("call-interactively", Fcall_interactively, 
Scall_interactively, 1, 3, 0,
   Lisp_Object up_event = Qnil;
 
   /* Set SPECS to the interactive form, or barf if not interactive.  */
-  Lisp_Object form = Finteractive_form (function);
+  Lisp_Object form = call1 (Qinteractive_form, function);
   if (! CONSP (form))
     wrong_type_argument (Qcommandp, function);
   Lisp_Object specs = Fcar (XCDR (form));
diff --git a/src/data.c b/src/data.c
index f06b561dcc6..888e3f66b27 100644
--- a/src/data.c
+++ b/src/data.c
@@ -1065,29 +1065,12 @@ DEFUN ("native-comp-unit-set-file", 
Fnative_comp_unit_set_file,
 
 #endif
 
-DEFUN ("interactive-form", Finteractive_form, Sinteractive_form, 1, 1, 0,
-       doc: /* Return the interactive form of CMD or nil if none.
+DEFUN ("internal--interactive-form", Finternal__interactive_form, 
Sinternal__interactive_form, 1, 1, 0,
+       doc: /* Return the interactive form of FUN or nil if none.
 If CMD is not a command, the return value is nil.
 Value, if non-nil, is a list (interactive SPEC).  */)
-  (Lisp_Object cmd)
+  (Lisp_Object fun)
 {
-  Lisp_Object fun = indirect_function (cmd); /* Check cycles.  */
-
-  if (NILP (fun))
-    return Qnil;
-
-  /* Use an `interactive-form' property if present, analogous to the
-     function-documentation property.  */
-  fun = cmd;
-  while (SYMBOLP (fun))
-    {
-      Lisp_Object tmp = Fget (fun, Qinteractive_form);
-      if (!NILP (tmp))
-       return tmp;
-      else
-       fun = Fsymbol_function (fun);
-    }
-
   if (SUBRP (fun))
     {
       if (SUBR_NATIVE_COMPILEDP (fun) && !NILP (XSUBR (fun)->native_intspec))
@@ -1099,21 +1082,6 @@ DEFUN ("interactive-form", Finteractive_form, 
Sinteractive_form, 1, 1, 0,
                      (*spec != '(') ? build_string (spec) :
                      Fcar (Fread_from_string (build_string (spec), Qnil, 
Qnil)));
     }
-  else if (COMPILEDP (fun))
-    {
-      if (PVSIZE (fun) > COMPILED_INTERACTIVE)
-       {
-         Lisp_Object form = AREF (fun, COMPILED_INTERACTIVE);
-         if (VECTORP (form))
-           /* The vector form is the new form, where the first
-              element is the interactive spec, and the second is the
-              command modes. */
-           return list2 (Qinteractive, AREF (form, 0));
-         else
-           /* Old form -- just the interactive spec. */
-           return list2 (Qinteractive, form);
-       }
-    }
 #ifdef HAVE_MODULES
   else if (MODULE_FUNCTIONP (fun))
     {
@@ -1123,24 +1091,6 @@ DEFUN ("interactive-form", Finteractive_form, 
Sinteractive_form, 1, 1, 0,
         return form;
     }
 #endif
-  else if (AUTOLOADP (fun))
-    return Finteractive_form (Fautoload_do_load (fun, cmd, Qnil));
-  else if (CONSP (fun))
-    {
-      Lisp_Object funcar = XCAR (fun);
-      if (EQ (funcar, Qclosure)
-         || EQ (funcar, Qlambda))
-       {
-         Lisp_Object form = Fcdr (XCDR (fun));
-         if (EQ (funcar, Qclosure))
-           form = Fcdr (form);
-         Lisp_Object spec = Fassq (Qinteractive, form);
-         if (NILP (Fcdr (Fcdr (spec))))
-           return spec;
-         else
-           return list2 (Qinteractive, Fcar (Fcdr (spec)));
-       }
-    }
   return Qnil;
 }
 
@@ -4255,7 +4205,7 @@ #define PUT_ERROR(sym, tail, msg)                 \
   DEFSYM (Qbyte_code_function_p, "byte-code-function-p");
 
   defsubr (&Sindirect_variable);
-  defsubr (&Sinteractive_form);
+  defsubr (&Sinternal__interactive_form);
   defsubr (&Scommand_modes);
   defsubr (&Seq);
   defsubr (&Snull);
diff --git a/src/eval.c b/src/eval.c
index a1cebcd0257..35a9f70d7b5 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -2032,8 +2032,7 @@ DEFUN ("commandp", Fcommandp, Scommandp, 1, 2, 0,
   (Lisp_Object function, Lisp_Object for_call_interactively)
 {
   register Lisp_Object fun;
-  register Lisp_Object funcar;
-  Lisp_Object if_prop = Qnil;
+  bool genfun = false; /* If true, we should consult `interactive-form`.  */
 
   fun = function;
 
@@ -2041,52 +2040,92 @@ DEFUN ("commandp", Fcommandp, Scommandp, 1, 2, 0,
   if (NILP (fun))
     return Qnil;
 
-  /* Check an `interactive-form' property if present, analogous to the
-     function-documentation property.  */
-  fun = function;
-  while (SYMBOLP (fun))
-    {
-      Lisp_Object tmp = Fget (fun, Qinteractive_form);
-      if (!NILP (tmp))
-       if_prop = Qt;
-      fun = Fsymbol_function (fun);
-    }
-
   /* Emacs primitives are interactive if their DEFUN specifies an
      interactive spec.  */
   if (SUBRP (fun))
-    return XSUBR (fun)->intspec ? Qt : if_prop;
-
+    {
+      if (XSUBR (fun)->intspec)
+        return Qt;
+    }
   /* Bytecode objects are interactive if they are long enough to
      have an element whose index is COMPILED_INTERACTIVE, which is
      where the interactive spec is stored.  */
   else if (COMPILEDP (fun))
-    return (PVSIZE (fun) > COMPILED_INTERACTIVE ? Qt : if_prop);
+    {
+      if (PVSIZE (fun) > COMPILED_INTERACTIVE)
+        return Qt;
+      else if (PVSIZE (fun) > COMPILED_DOC_STRING)
+        genfun = true;
+    }
 
 #ifdef HAVE_MODULES
   /* Module functions are interactive if their `interactive_form'
      field is non-nil. */
   else if (MODULE_FUNCTIONP (fun))
-    return NILP (module_function_interactive_form (XMODULE_FUNCTION (fun)))
-             ? if_prop
-             : Qt;
+    {
+      if (!NILP (module_function_interactive_form (XMODULE_FUNCTION (fun))))
+        return Qt;
+    }
 #endif
 
   /* Strings and vectors are keyboard macros.  */
-  if (STRINGP (fun) || VECTORP (fun))
+  else if (STRINGP (fun) || VECTORP (fun))
     return (NILP (for_call_interactively) ? Qt : Qnil);
 
   /* Lists may represent commands.  */
-  if (!CONSP (fun))
+  else if (!CONSP (fun))
     return Qnil;
-  funcar = XCAR (fun);
-  if (EQ (funcar, Qclosure))
-    return (!NILP (Fassq (Qinteractive, Fcdr (Fcdr (XCDR (fun)))))
-           ? Qt : if_prop);
-  else if (EQ (funcar, Qlambda))
-    return !NILP (Fassq (Qinteractive, Fcdr (XCDR (fun)))) ? Qt : if_prop;
-  else if (EQ (funcar, Qautoload))
-    return !NILP (Fcar (Fcdr (Fcdr (XCDR (fun))))) ? Qt : if_prop;
+  else
+    {
+      Lisp_Object funcar = XCAR (fun);
+      if (EQ (funcar, Qautoload))
+        {
+          if (!NILP (Fcar (Fcdr (Fcdr (XCDR (fun))))))
+            return Qt;
+        }
+      else
+        {
+          Lisp_Object body = CDR_SAFE (XCDR (fun));
+          if (EQ (funcar, Qclosure))
+            body = CDR_SAFE (body);
+          else if (!EQ (funcar, Qlambda))
+           return Qnil;
+         if (!NILP (Fassq (Qinteractive, body)))
+           return Qt;
+         else
+           {
+             Lisp_Object first = CAR_SAFE (body);
+             if (!NILP (CDR_SAFE (body))
+                 && (STRINGP (first) || FIXNUMP (first) ||
+                     FIXNUMP (CDR_SAFE (first))))
+               genfun = true;
+           }
+       }
+    }
+
+  /* By now, if it's not a function we already returned nil.  */
+
+  /* Check an `interactive-form' property if present, analogous to the
+     function-documentation property.  */
+  fun = function;
+  while (SYMBOLP (fun))
+    {
+      Lisp_Object tmp = Fget (fun, Qinteractive_form);
+      if (!NILP (tmp))
+       error ("Found an `interactive-form` property!");
+      fun = Fsymbol_function (fun);
+    }
+
+  /* If there's no immediate interactive form but there's a docstring,
+     then delegate to the generic-function in case it's an FCR with
+     a type-specific interactive-form.  */
+  if (genfun
+      /* Avoid burping during bootstrap.  */
+      && !NILP (Fsymbol_function (Qinteractive_form)))
+    {
+      Lisp_Object iform = call1 (Qinteractive_form, fun);
+      return NILP (iform) ? Qnil : Qt;
+    }
   else
     return Qnil;
 }