scratch/oclosure d93b0ad4d4 06/25: (interactive-form, function-docstring): New generic functions

[Stefan Monnier]

branch: scratch/oclosure
commit d93b0ad4d4ad5c3704aec56ee22b35daae7a9867
Author: Stefan Monnier <monnier@iro.umontreal.ca>
Commit: Stefan Monnier <monnier@iro.umontreal.ca>

    (interactive-form, function-docstring): New generic functions
    
    Change `interactive-form` to be a generic function, and
    change `documentation` to delegate to a new `function-docstring`
    generic function so that we can use `cl-defmethod` to construct
    the docstrings and interactive forms of OClosures.
    
    * src/eval.c (Fcommandp): Rewrite to delegate to `interactive-form`
    when potentially necessary.
    
    * src/doc.c (Fdocumentation): Delegate to `function-docstring` in
    most cases.
    
    * src/data.c (Finternal__interactive_form): Rename from
    `Finteractive_form` and simplify to only handle the cases we can't (yet)
    handle from Lisp.
    (syms_of_data): Adjust accordingly.
    
    * src/callint.c (Fcall_interactively): `interactive-form` is now
    defined in Lisp.
    
    * lisp/simple.el: Require `subr-x`.
    (function-docstring, interactive-form): New generic functions.
    
    * lisp/loadup.el ("simple"): Postpone loading it after `cl-generic`.
    
    * lisp/emacs-lisp/macroexp.el (internal-macroexpand-for-load):
    Don't neuter eager macroexpansion errors.
    
    * lisp/emacs-lisp/cl-generic.el (cl--generic-lambda):
    Avoid `interactive-form` to avoid breaking bootstrap since it's now
    defined as a generic function.
    (cl-defmethod): Simplify.
    (cl--generic-compiler): New var.
    (cl--generic-get-dispatcher): Use it.
    (cl--generic-prefill-dispatchers): Rebind it.
---
 lisp/ansi-color.el                |  2 +-
 lisp/cus-edit.el                  |  2 +-
 lisp/cus-theme.el                 |  2 +-
 lisp/emacs-lisp/cl-generic.el     | 28 ++++++++---
 lisp/emacs-lisp/macroexp.el       | 17 ++-----
 lisp/emacs-lisp/syntax.el         |  2 +-
 lisp/emacs-lisp/tabulated-list.el |  2 +-
 lisp/files.el                     |  2 +-
 lisp/ido.el                       |  2 +-
 lisp/loadup.el                    |  3 +-
 lisp/simple.el                    | 52 +++++++++++++++++++++
 src/callint.c                     |  2 +-
 src/data.c                        | 58 ++---------------------
 src/doc.c                         | 52 ++-------------------
 src/eval.c                        | 97 +++++++++++++++++++++++++++------------
 15 files changed, 162 insertions(+), 161 deletions(-)

diff --git a/lisp/ansi-color.el b/lisp/ansi-color.el
index c962cbd478..b23e826a0a 100644
--- a/lisp/ansi-color.el
+++ b/lisp/ansi-color.el
@@ -414,7 +414,7 @@ and it should apply face FACE to the text between BEG and 
END.")
   (setq ansi-color-for-comint-mode 'filter))
 
 ;;;###autoload
-(defun ansi-color-process-output (ignored)
+(defun ansi-color-process-output (_ignored)
   "Maybe translate SGR control sequences of comint output into text properties.
 
 Depending on variable `ansi-color-for-comint-mode' the comint output is
diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el
index b7c53a4dfe..ac586b67fa 100644
--- a/lisp/cus-edit.el
+++ b/lisp/cus-edit.el
@@ -1511,7 +1511,7 @@ If TYPE is `groups', include only groups."
      "*Customize Apropos*")))
 
 ;;;###autoload
-(defun customize-apropos-options (regexp &optional ignored)
+(defun customize-apropos-options (regexp &optional _ignored)
   "Customize all loaded customizable options matching REGEXP."
   (interactive (list (apropos-read-pattern "options")))
   (customize-apropos regexp 'options))
diff --git a/lisp/cus-theme.el b/lisp/cus-theme.el
index f618e3341c..ce3f16255d 100644
--- a/lisp/cus-theme.el
+++ b/lisp/cus-theme.el
@@ -142,7 +142,7 @@ remove them from your saved Custom file.\n\n")
     (widget-create 'push-button
                   :tag " Revert "
                   :help-echo "Revert this buffer to its original state."
-                  :action (lambda (&rest ignored) (revert-buffer)))
+                  :action (lambda (&rest _) (revert-buffer)))
 
     (widget-insert "\n\nTheme name : ")
     (setq custom-theme-name
diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index b7b2d2cd22..1407b3fffa 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -379,9 +379,9 @@ the specializer used will be the one returned by BODY."
                                    . ,(lambda () spec-args))
                                  macroexpand-all-environment)))
       (require 'cl-lib)        ;Needed to expand `cl-flet' and `cl-function'.
-      (when (interactive-form (cadr fun))
+      (when (assq 'interactive body)
         (message "Interactive forms unsupported in generic functions: %S"
-                 (interactive-form (cadr fun))))
+                 (assq 'interactive body)))
       ;; First macroexpand away the cl-function stuff (e.g. &key and
       ;; destructuring args, `declare' and whatnot).
       (pcase (macroexpand fun macroenv)
@@ -507,12 +507,11 @@ The set of acceptable TYPEs (also called 
\"specializers\") is defined
     (pcase-let* ((`(,uses-cnm . ,fun) (cl--generic-lambda args body)))
       `(progn
          ,(and (get name 'byte-obsolete-info)
-               (or (not (fboundp 'byte-compile-warning-enabled-p))
-                   (byte-compile-warning-enabled-p 'obsolete name))
                (let* ((obsolete (get name 'byte-obsolete-info)))
                  (macroexp-warn-and-return
                   (macroexp--obsolete-warning name obsolete "generic function")
-                  nil)))
+                  nil
+                  (list 'obsolete name))))
          ;; You could argue that `defmethod' modifies rather than defines the
          ;; function, so warnings like "not known to be defined" are fair game.
          ;; But in practice, it's common to use `cl-defmethod'
@@ -600,6 +599,15 @@ The set of acceptable TYPEs (also called \"specializers\") 
is defined
 
 (defvar cl--generic-dispatchers (make-hash-table :test #'equal))
 
+
+(defvar cl--generic-compiler
+  ;; Don't byte-compile the dispatchers if cl-generic itself is not
+  ;; byte compiled.  Otherwise the byte-compiler and all the code on
+  ;; which it depends needs to be usable before cl-generic is loaded,
+  ;; which imposes a significant burden on the bootstrap.
+  (if (byte-code-function-p (lambda (x) (+ x 1)))
+      #'byte-compile (lambda (exp) (eval exp t))))
+
 (defun cl--generic-get-dispatcher (dispatch)
   (with-memoization
       (gethash dispatch cl--generic-dispatchers)
@@ -642,7 +650,8 @@ The set of acceptable TYPEs (also called \"specializers\") 
is defined
       ;; FIXME: For generic functions with a single method (or with 2 methods,
       ;; one of which always matches), using a tagcode + hash-table is
       ;; overkill: better just use a `cl-typep' test.
-      (byte-compile
+      (funcall
+       cl--generic-compiler
        `(lambda (generic dispatches-left methods)
           ;; FIXME: We should find a way to expand `with-memoize' once
           ;; and forall so we don't need `subr-x' when we get here.
@@ -875,7 +884,12 @@ those methods.")
               `(,arg-or-context
                 ,@(apply #'append
                          (mapcar #'cl-generic-generalizers specializers))
-                ,cl--generic-t-generalizer))))
+                ,cl--generic-t-generalizer)))
+        ;; When compiling `cl-generic' during bootstrap, make sure
+        ;; we prefill with compiled dispatchers even though the loaded
+        ;; `cl-generic' is still interpreted.
+        (cl--generic-compiler
+         (if (featurep 'bytecomp) #'byte-compile cl--generic-compiler)))
     ;; Recompute dispatch at run-time, since the generalizers may be slightly
     ;; different (e.g. byte-compiled rather than interpreted).
     ;; FIXME: There is a risk that the run-time generalizer is not equivalent
diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el
index a20c424e2b..4226ed231f 100644
--- a/lisp/emacs-lisp/macroexp.el
+++ b/lisp/emacs-lisp/macroexp.el
@@ -702,18 +702,11 @@ test of free variables in the following ways:
       (push 'skip macroexp--pending-eager-loads)
       form))
    (t
-    (condition-case err
-        (let ((macroexp--pending-eager-loads
-               (cons load-file-name macroexp--pending-eager-loads)))
-          (if full-p
-              (macroexpand-all form)
-            (macroexpand form)))
-      (error
-       ;; Hopefully this shouldn't happen thanks to the cycle detection,
-       ;; but in case it does happen, let's catch the error and give the
-       ;; code a chance to macro-expand later.
-       (message "Eager macro-expansion failure: %S" err)
-       form)))))
+    (let ((macroexp--pending-eager-loads
+           (cons load-file-name macroexp--pending-eager-loads)))
+      (if full-p
+          (macroexpand-all form)
+        (macroexpand form))))))
 
 ;; ¡¡¡ Big Ugly Hack !!!
 ;; src/bootstrap-emacs is mostly used to compile .el files, so it needs
diff --git a/lisp/emacs-lisp/syntax.el b/lisp/emacs-lisp/syntax.el
index 0bb1b8916b..7ed1b2b137 100644
--- a/lisp/emacs-lisp/syntax.el
+++ b/lisp/emacs-lisp/syntax.el
@@ -487,7 +487,7 @@ These are valid when the buffer has no restriction.")
 
 (define-obsolete-function-alias 'syntax-ppss-after-change-function
   #'syntax-ppss-flush-cache "27.1")
-(defun syntax-ppss-flush-cache (beg &rest ignored)
+(defun syntax-ppss-flush-cache (beg &rest _)
   "Flush the cache of `syntax-ppss' starting at position BEG."
   ;; Set syntax-propertize to refontify anything past beg.
   (unless syntax-propertize--inhibit-flush
diff --git a/lisp/emacs-lisp/tabulated-list.el 
b/lisp/emacs-lisp/tabulated-list.el
index 075fe836f6..70ecda0fe4 100644
--- a/lisp/emacs-lisp/tabulated-list.el
+++ b/lisp/emacs-lisp/tabulated-list.el
@@ -378,7 +378,7 @@ Optional arg POS is a buffer position where to look for a 
fake header;
 defaults to `point-min'."
   (overlays-at (or pos (point-min))))
 
-(defun tabulated-list-revert (&rest ignored)
+(defun tabulated-list-revert (&rest _)
   "The `revert-buffer-function' for `tabulated-list-mode'.
 It runs `tabulated-list-revert-hook', then calls `tabulated-list-print'."
   (interactive)
diff --git a/lisp/files.el b/lisp/files.el
index 9ed63a60f8..d2a9a90ea5 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -3786,7 +3786,7 @@ If these settings come from directory-local variables, 
then
 DIR-NAME is the name of the associated directory.  Otherwise it is nil."
   ;; Find those variables that we may want to save to
   ;; `safe-local-variable-values'.
-  (let (all-vars risky-vars unsafe-vars ignored)
+  (let (all-vars risky-vars unsafe-vars)
     (dolist (elt variables)
       (let ((var (car elt))
            (val (cdr elt)))
diff --git a/lisp/ido.el b/lisp/ido.el
index 6767d66988..31b32f09dd 100644
--- a/lisp/ido.el
+++ b/lisp/ido.el
@@ -3916,7 +3916,7 @@ If `ido-change-word-sub' cannot be found in WORD, return 
nil."
   "Return dotted pair (RES . 1)."
   (cons res 1))
 
-(defun ido-choose-completion-string (choice &rest ignored)
+(defun ido-choose-completion-string (choice &rest _)
   (when (ido-active)
     ;; Insert the completion into the buffer where completion was requested.
     (and ido-completion-buffer
diff --git a/lisp/loadup.el b/lisp/loadup.el
index 46063f9b97..33c81f3e8c 100644
--- a/lisp/loadup.el
+++ b/lisp/loadup.el
@@ -200,8 +200,6 @@
 (load "emacs-lisp/nadvice")
 (load "obarray")        ;abbrev.el is implemented in terms of obarrays.
 (load "abbrev")         ;lisp-mode.el and simple.el use define-abbrev-table.
-(load "simple")
-
 (load "help")
 
 (load "jka-cmpr-hook")
@@ -251,6 +249,7 @@
 (let ((max-specpdl-size (max max-specpdl-size 1800)))
   ;; A particularly demanding file to load; 1600 does not seem to be enough.
   (load "emacs-lisp/cl-generic"))
+(load "simple")
 (load "minibuffer") ;Needs cl-generic (and define-minor-mode).
 (load "frame")
 (load "startup")
diff --git a/lisp/simple.el b/lisp/simple.el
index 84928caa31..09e1c7d845 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -29,6 +29,7 @@
 ;;; Code:
 
 (eval-when-compile (require 'cl-lib))
+(eval-when-compile (require 'subr-x))
 
 (declare-function widget-convert "wid-edit" (type &rest args))
 (declare-function shell-mode "shell" ())
@@ -2324,6 +2325,57 @@ maps."
   (with-suppressed-warnings ((interactive-only execute-extended-command))
     (execute-extended-command prefixarg command-name typed)))
 
+(cl-defgeneric function-docstring (function)
+  "Extract the raw docstring info from FUNCTION.
+FUNCTION is expected to be a function value rather than, say, a mere symbol."
+  (pcase function
+   ((pred byte-code-function-p)
+    (if (> (length function) 4) (aref function 4)))
+   ((or (pred stringp) (pred vectorp)) "Keyboard macro.")
+   (`(keymap . ,_)
+    "Prefix command (definition is a keymap associating keystrokes with 
commands).")
+   ((or `(lambda ,_args . ,body) `(closure ,_env ,_args . ,body)
+        `(autoload ,_file . ,body))
+    (let ((doc (car body)))
+      (when (and (or (stringp doc)
+                     (fixnump doc) (fixnump (cdr-safe doc)))
+                ;; Handle a doc reference--but these never come last
+                ;; in the function body, so reject them if they are last.
+                 (cdr body))
+        doc)))
+   (_ (signal 'invalid-function))))
+
+(cl-defgeneric interactive-form (cmd)
+  "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)."
+  (let ((fun (indirect-function cmd)))  ;Check cycles.
+    (when fun
+      (named-let loop ((fun cmd))
+        (pcase fun
+         ((pred symbolp)
+          (or (get fun 'interactive-form)
+              (loop (symbol-function fun))))
+         ((pred byte-code-function-p)
+          (when (> (length fun) 5)
+            (let ((form (aref fun 5)))
+              (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.
+                 (list 'interactive (aref form 0))
+               (list 'interactive form)))))
+        ((pred autoloadp)
+          (interactive-form (autoload-do-load fun cmd)))
+         ((or `(lambda ,_args . ,body)
+              `(closure ,_env ,_args . ,body))
+          (let ((spec (assq 'interactive body)))
+            (if (cddr spec)
+                ;; Drop the "applicable modes" info.
+                (list 'interactive (cadr spec))
+              spec)))
+         (_ (internal--interactive-form fun)))))))
+
 (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 68f103759a..afe4b62fa0 100644
--- a/src/callint.c
+++ b/src/callint.c
@@ -315,7 +315,7 @@ invoke it (via an `interactive' spec that contains, for 
instance, an
   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 f07667b000..6c1fd7d1a1 100644
--- a/src/data.c
+++ b/src/data.c
@@ -945,29 +945,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))
@@ -979,21 +962,6 @@ Value, if non-nil, is a list (interactive SPEC).  */)
                      (*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))
     {
@@ -1003,24 +971,6 @@ Value, if non-nil, is a list (interactive SPEC).  */)
         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;
 }
 
@@ -4078,7 +4028,7 @@ syms_of_data (void)
   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/doc.c b/src/doc.c
index 6be023bb93..1551dfa06e 100644
--- a/src/doc.c
+++ b/src/doc.c
@@ -327,6 +327,8 @@ string is passed through `substitute-command-keys'.  */)
     xsignal1 (Qvoid_function, function);
   if (CONSP (fun) && EQ (XCAR (fun), Qmacro))
     fun = XCDR (fun);
+  /* FIXME: The code for subrs and module functions should be
+     in `function-docstring`.  */
 #ifdef HAVE_NATIVE_COMP
   if (!NILP (Fsubr_native_elisp_p (fun)))
     doc = native_function_doc (fun);
@@ -338,56 +340,8 @@ string is passed through `substitute-command-keys'.  */)
   else if (MODULE_FUNCTIONP (fun))
     doc = module_function_documentation (XMODULE_FUNCTION (fun));
 #endif
-  else if (COMPILEDP (fun))
-    {
-      if (PVSIZE (fun) <= COMPILED_DOC_STRING)
-       return Qnil;
-      else
-       {
-         Lisp_Object tem = AREF (fun, COMPILED_DOC_STRING);
-         if (STRINGP (tem))
-           doc = tem;
-         else if (FIXNATP (tem) || CONSP (tem))
-           doc = tem;
-         else
-           return Qnil;
-       }
-    }
-  else if (STRINGP (fun) || VECTORP (fun))
-    {
-      return build_string ("Keyboard macro.");
-    }
-  else if (CONSP (fun))
-    {
-      Lisp_Object funcar = XCAR (fun);
-      if (!SYMBOLP (funcar))
-       xsignal1 (Qinvalid_function, fun);
-      else if (EQ (funcar, Qkeymap))
-       return build_string ("Prefix command (definition is a keymap 
associating keystrokes with commands).");
-      else if (EQ (funcar, Qlambda)
-              || (EQ (funcar, Qclosure) && (fun = XCDR (fun), 1))
-              || EQ (funcar, Qautoload))
-       {
-         Lisp_Object tem1 = Fcdr (Fcdr (fun));
-         Lisp_Object tem = Fcar (tem1);
-         if (STRINGP (tem))
-           doc = tem;
-         /* Handle a doc reference--but these never come last
-            in the function body, so reject them if they are last.  */
-         else if ((FIXNATP (tem) || (CONSP (tem) && FIXNUMP (XCDR (tem))))
-                  && !NILP (XCDR (tem1)))
-           doc = tem;
-         else
-           return Qnil;
-       }
-      else
-       goto oops;
-    }
   else
-    {
-    oops:
-      xsignal1 (Qinvalid_function, fun);
-    }
+    doc = call1 (intern ("function-docstring"), fun);
 
   /* If DOC is 0, it's typically because of a dumped file missing
      from the DOC file (bug in src/Makefile.in).  */
diff --git a/src/eval.c b/src/eval.c
index 1942fbdfb8..ffc3b2b832 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -2171,8 +2171,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;
 
   fun = function;
 
@@ -2180,52 +2179,92 @@ 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 ? 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
+           {
+             body = CAR_SAFE (body);
+             if (!NILP (CDR_SAFE (body))
+                 && (STRINGP (body) || FIXNUMP (body) ||
+                     FIXNUMP (CDR_SAFE (body))))
+               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))
+       return Qt;
+      fun = Fsymbol_function (fun);
+    }
+
+  /* If there's no immdiate 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;
 }