New generic function `oclosure-interactive-form`

It's used by `interactive-form` when it encounters an OClosure.
This lets one compute the `interactive-form` of OClosures
dynamically by adding appropriate methods.
This does not include support for `command-modes` for Oclosures.

* lisp/simple.el (oclosure-interactive-form): New generic function.

* src/data.c (Finteractive_form): Delegate to
`oclosure-interactive-form` if the arg is an OClosure.
(syms_of_data): New symbol `Qoclosure_interactive_form`.
* src/eval.c (Fcommandp): Delegate to `interactive-form` if the arg is
an OClosure.

* src/lisp.h (VALID_DOCSTRING_P): New function, extracted from
`store_function_docstring`.
* src/doc.c (store_function_docstring): Use it.

* lisp/kmacro.el (kmacro): Don't carry any interactive form.
(oclosure-interactive-form) <kmacro>: New method, instead.

* test/lisp/emacs-lisp/oclosure-tests.el (oclosure-interactive-form)
<oclosure-test>: New method.
(oclosure-test-interactive-form): New test.

* doc/lispref/commands.texi (Using Interactive):
Document `oclosure-interactive-form`.

1 files changed, 65 insertions, 29 deletions

diff --git a/src/eval.c b/src/eval.c
index 37bc03465cc..77ec47e2b79 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -2032,8 +2032,7 @@ then strings and vectors are not accepted.  */)
   (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,89 @@ then strings and vectors are not accepted.  */)
   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.string ? Qt : if_prop;
-
+    {
+      if (XSUBR (fun)->intspec.string)
+        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)
+        {
+          Lisp_Object doc = AREF (fun, COMPILED_DOC_STRING);
+          /* An invalid "docstring" is a sign that we have an OClosure.  */
+          genfun = !(NILP (doc) || VALID_DOCSTRING_P (doc));
+        }
+    }
 
 #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 if (VALID_DOCSTRING_P (CAR_SAFE (body)))
+            /* A "docstring" is a sign that we may have an OClosure.  */
+            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 it's an OClosure,
+     then delegate to the generic-function in case it has
+     a type-specific interactive-form.  */
+  if (genfun)
+    {
+      Lisp_Object iform = call1 (Qinteractive_form, fun);
+      return NILP (iform) ? Qnil : Qt;
+    }
   else
     return Qnil;
 }