master 58e0c8e 01/12: Extend the syntax of `interactive' to list applicable modes

[Lars Ingebrigtsen]

branch: master
commit 58e0c8ee86e2c36245f1c5a1483f1c73600b4914
Author: Lars Ingebrigtsen <larsi@gnus.org>
Commit: Lars Ingebrigtsen <larsi@gnus.org>

    Extend the syntax of `interactive' to list applicable modes
    
    * doc/lispref/commands.texi (Using Interactive): Document the
    extended `interactive' form.
    * doc/lispref/loading.texi (Autoload): Document list-of-modes
    form.
    
    * lisp/emacs-lisp/autoload.el (make-autoload): Pick the list of
    modes from `interactive' out of the functions.
    
    * lisp/emacs-lisp/bytecomp.el (byte-compile-lambda): Allow for the
    extended `interactive' form.
    
    * src/callint.c (Finteractive): Document the extended form.
    
    * src/data.c (Finteractive_form): Return the interactive form in
    the old format (even when there's an extended `interactive') to
    avoid having other parts of Emacs be aware of this.
    (Fcommand_modes): New defun.
    
    * src/emacs-module.c (GCALIGNED_STRUCT): Allow for modules to
    return command modes.
    
    * src/lisp.h: New function module_function_command_modes.
---
 doc/lispref/commands.texi   | 19 +++++++++-
 doc/lispref/loading.texi    |  3 ++
 etc/NEWS                    |  8 ++++
 lisp/emacs-lisp/autoload.el | 15 ++++++--
 lisp/emacs-lisp/bytecomp.el | 40 ++++++++++++--------
 src/callint.c               |  9 ++++-
 src/data.c                  | 92 ++++++++++++++++++++++++++++++++++++++++++---
 src/emacs-module.c          |  8 +++-
 src/eval.c                  |  9 ++++-
 src/lisp.h                  |  3 ++
 src/lread.c                 |  1 +
 11 files changed, 179 insertions(+), 28 deletions(-)

diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi
index 3a2c7d0..d60745a 100644
--- a/doc/lispref/commands.texi
+++ b/doc/lispref/commands.texi
@@ -156,7 +156,7 @@ commands by adding the @code{interactive} form to them.
 makes a Lisp function an interactively-callable command, and how to
 examine a command's @code{interactive} form.
 
-@defspec interactive arg-descriptor
+@defspec interactive &optional arg-descriptor &rest modes
 This special form declares that a function is a command, and that it
 may therefore be called interactively (via @kbd{M-x} or by entering a
 key sequence bound to it).  The argument @var{arg-descriptor} declares
@@ -177,6 +177,23 @@ forms are executed; at this time, if the 
@code{interactive} form
 occurs within the body, the form simply returns @code{nil} without
 even evaluating its argument.
 
+The @var{modes} list allows specifying which modes the command is
+meant to be used in.  This affects, for instance, completion in
+@kbd{M-x} (commands won't be offered as completions if they don't
+match (using @code{derived-mode-p}) the current major mode, or if the
+mode is a minor mode, whether it's switched on in the current buffer).
+This will also make @kbd{C-h m} list these commands (if they aren't
+bound to any keys).
+
+For instance:
+
+@lisp
+(interactive "p" dired-mode)
+@end lisp
+
+This will mark the command as applicable for modes derived from
+@code{dired-mode} only.
+
 By convention, you should put the @code{interactive} form in the
 function body, as the first top-level form.  If there is an
 @code{interactive} form in both the @code{interactive-form} symbol
diff --git a/doc/lispref/loading.texi b/doc/lispref/loading.texi
index 33f3733..8c6aeb0 100644
--- a/doc/lispref/loading.texi
+++ b/doc/lispref/loading.texi
@@ -510,6 +510,9 @@ specification is not given here; it's not needed unless the 
user
 actually calls @var{function}, and when that happens, it's time to load
 the real definition.
 
+If @var{interactive} is a list, it is interpreted as a list of modes
+this command is applicable for.
+
 You can autoload macros and keymaps as well as ordinary functions.
 Specify @var{type} as @code{macro} if @var{function} is really a macro.
 Specify @var{type} as @code{keymap} if @var{function} is really a
diff --git a/etc/NEWS b/etc/NEWS
index 08e1e94..d8f0bc6 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -2267,6 +2267,14 @@ back in Emacs 23.1.  The affected functions are: 
'make-obsolete',
 * Lisp Changes in Emacs 28.1
 
 +++
+** The 'interactive' syntax has been extended to allow listing applicable 
modes.
+Forms like '(interactive "p" dired-mode)' can be used to annotate the
+commands as being applicable for modes derived from 'dired-mode',
+or if the mode is a minor mode, that the current buffer has that
+minor mode activated.  Note that using this form will create byte code
+that is not compatible with byte code in previous Emacs versions.
+
++++
 ** New buffer-local variable 'minor-modes'.
 This permanently buffer-local variable holds a list of currently
 enabled minor modes in the current buffer (as a list of symbols).
diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el
index ec7492d..ae17039 100644
--- a/lisp/emacs-lisp/autoload.el
+++ b/lisp/emacs-lisp/autoload.el
@@ -141,9 +141,12 @@ expression, in which case we want to handle forms 
differently."
                       ((stringp (car-safe rest)) (car rest))))
            ;; Look for an interactive spec.
            (interactive (pcase body
-                          ((or `((interactive . ,_) . ,_)
-                               `(,_ (interactive . ,_) . ,_))
-                           t))))
+                          ((or `((interactive . ,iargs) . ,_)
+                               `(,_ (interactive . ,iargs) . ,_))
+                           ;; List of modes or just t.
+                           (if (nthcdr 1 iargs)
+                               (list 'quote (nthcdr 1 iargs))
+                             t)))))
         ;; Add the usage form at the end where describe-function-1
         ;; can recover it.
         (when (consp args) (setq doc (help-add-fundoc-usage doc args)))
@@ -207,7 +210,11 @@ expression, in which case we want to handle forms 
differently."
                                   easy-mmode-define-minor-mode
                                   define-minor-mode))
                      t)
-                (eq (car-safe (car body)) 'interactive))
+                (and (eq (car-safe (car body)) 'interactive)
+                     ;; List of modes or just t.
+                     (or (if (nthcdr 1 (car body))
+                             (list 'quote (nthcdr 1 (car body)))
+                           t))))
            ,(if macrop ''macro nil))))
 
      ;; For defclass forms, use `eieio-defclass-autoload'.
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 89068a1..5c6b9c2 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -2939,7 +2939,8 @@ for symbols generated by the byte compiler itself."
                     ;; unless it is the last element of the body.
                     (if (cdr body)
                         (setq body (cdr body))))))
-        (int (assq 'interactive body)))
+        (int (assq 'interactive body))
+         command-modes)
     (when lexical-binding
       (dolist (var arglistvars)
         (when (assq var byte-compile--known-dynamic-vars)
@@ -2951,9 +2952,10 @@ for symbols generated by the byte compiler itself."
       (if (eq int (car body))
          (setq body (cdr body)))
       (cond ((consp (cdr int))
-            (if (cdr (cdr int))
-                (byte-compile-warn "malformed interactive spec: %s"
-                                   (prin1-to-string int)))
+            (unless (seq-every-p #'symbolp (cdr (cdr int)))
+              (byte-compile-warn "malformed interactive specc: %s"
+                                 (prin1-to-string int)))
+             (setq command-modes (cdr (cdr int)))
             ;; If the interactive spec is a call to `list', don't
             ;; compile it, because `call-interactively' looks at the
             ;; args of `list'.  Actually, compile it to get warnings,
@@ -2964,14 +2966,15 @@ for symbols generated by the byte compiler itself."
                 (while (consp (cdr form))
                   (setq form (cdr form)))
                 (setq form (car form)))
-              (if (and (eq (car-safe form) 'list)
-                        ;; For code using lexical-binding, form is not
-                        ;; valid lisp, but rather an intermediate form
-                        ;; which may include "calls" to
-                        ;; internal-make-closure (Bug#29988).
-                        (not lexical-binding))
-                  nil
-                (setq int `(interactive ,newform)))))
+              (setq int
+                    (if (and (eq (car-safe form) 'list)
+                              ;; For code using lexical-binding, form is not
+                              ;; valid lisp, but rather an intermediate form
+                              ;; which may include "calls" to
+                              ;; internal-make-closure (Bug#29988).
+                              (not lexical-binding))
+                         `(interactive ,form)
+                       `(interactive ,newform)))))
            ((cdr int)
             (byte-compile-warn "malformed interactive spec: %s"
                                (prin1-to-string int)))))
@@ -3002,9 +3005,16 @@ for symbols generated by the byte compiler itself."
                      (list (help-add-fundoc-usage doc arglist)))
                     ((or doc int)
                      (list doc)))
-              ;; optionally, the interactive spec.
-              (if int
-                  (list (nth 1 int))))))))
+              ;; optionally, the interactive spec (and the modes the
+              ;; command applies to).
+              (cond
+               ;; We have some command modes, so use the vector form.
+               (command-modes
+                (list (vector (nth 1 int) command-modes)))
+               ;; No command modes, use the simple form with just the
+               ;; interactive spec.
+               (int
+                (list (nth 1 int)))))))))
 
 (defvar byte-compile-reserved-constants 0)
 
diff --git a/src/callint.c b/src/callint.c
index d3f49bc..1862463 100644
--- a/src/callint.c
+++ b/src/callint.c
@@ -104,7 +104,14 @@ If the string begins with `^' and `shift-select-mode' is 
non-nil,
  Emacs first calls the function `handle-shift-selection'.
 You may use `@', `*', and `^' together.  They are processed in the
  order that they appear, before reading any arguments.
-usage: (interactive &optional ARG-DESCRIPTOR)  */
+
+If MODES is present, it should be a list of mode names (symbols) that
+this command is applicable for.  The main effect of this is that
+`M-x TAB' (by default) won't list this command if the current buffer's
+mode doesn't match the list.  That is, if either the major mode isn't
+derived from them, or (when it's a minor mode) the mode isn't in effect.
+
+usage: (interactive &optional ARG-DESCRIPTOR &rest MODES)  */
        attributes: const)
   (Lisp_Object args)
 {
diff --git a/src/data.c b/src/data.c
index 38cde0f..7bddc03 100644
--- a/src/data.c
+++ b/src/data.c
@@ -904,7 +904,17 @@ Value, if non-nil, is a list (interactive SPEC).  */)
   else if (COMPILEDP (fun))
     {
       if (PVSIZE (fun) > COMPILED_INTERACTIVE)
-       return list2 (Qinteractive, AREF (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))
@@ -920,10 +930,80 @@ Value, if non-nil, is a list (interactive SPEC).  */)
   else if (CONSP (fun))
     {
       Lisp_Object funcar = XCAR (fun);
-      if (EQ (funcar, Qclosure))
-       return Fassq (Qinteractive, Fcdr (Fcdr (XCDR (fun))));
-      else if (EQ (funcar, Qlambda))
-       return Fassq (Qinteractive, Fcdr (XCDR (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;
+}
+
+DEFUN ("command-modes", Fcommand_modes, Scommand_modes, 1, 1, 0,
+       doc: /* Return the modes COMMAND is defined for.
+If COMMAND is not a command, the return value is nil.
+The value, if non-nil, is a list of mode name symbols.  */)
+  (Lisp_Object command)
+{
+  Lisp_Object fun = indirect_function (command); /* Check cycles.  */
+
+  if (NILP (fun))
+    return Qnil;
+
+  fun = command;
+  while (SYMBOLP (fun))
+    fun = Fsymbol_function (fun);
+
+  if (SUBRP (fun))
+    {
+      if (!NILP (XSUBR (fun)->command_modes))
+       return XSUBR (fun)->command_modes;
+    }
+  else if (COMPILEDP (fun))
+    {
+      Lisp_Object form = AREF (fun, COMPILED_INTERACTIVE);
+      if (VECTORP (form))
+       /* New form -- the second element is the command modes. */
+       return AREF (form, 1);
+      else
+       /* Old .elc file -- no command modes. */
+       return Qnil;
+    }
+#ifdef HAVE_MODULES
+  else if (MODULE_FUNCTIONP (fun))
+    {
+      Lisp_Object form
+        = module_function_command_modes (XMODULE_FUNCTION (fun));
+      if (! NILP (form))
+        return form;
+    }
+#endif
+  else if (AUTOLOADP (fun))
+    {
+      Lisp_Object modes = Fnth (make_int (3), fun);
+      if (CONSP (modes))
+       return modes;
+      else
+       return 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);
+         return Fcdr (Fcdr (Fassq (Qinteractive, form)));
+       }
     }
   return Qnil;
 }
@@ -3908,6 +3988,7 @@ syms_of_data (void)
 
   defsubr (&Sindirect_variable);
   defsubr (&Sinteractive_form);
+  defsubr (&Scommand_modes);
   defsubr (&Seq);
   defsubr (&Snull);
   defsubr (&Stype_of);
@@ -4030,6 +4111,7 @@ This variable cannot be set; trying to do so will signal 
an error.  */);
   DEFSYM (Qunlet, "unlet");
   DEFSYM (Qset, "set");
   DEFSYM (Qset_default, "set-default");
+  DEFSYM (Qcommand_modes, "command-modes");
   defsubr (&Sadd_variable_watcher);
   defsubr (&Sremove_variable_watcher);
   defsubr (&Sget_variable_watchers);
diff --git a/src/emacs-module.c b/src/emacs-module.c
index 894dffc..f8fb54c 100644
--- a/src/emacs-module.c
+++ b/src/emacs-module.c
@@ -549,7 +549,7 @@ struct Lisp_Module_Function
   union vectorlike_header header;
 
   /* Fields traced by GC; these must come first.  */
-  Lisp_Object documentation, interactive_form;
+  Lisp_Object documentation, interactive_form, command_modes;
 
   /* Fields ignored by GC.  */
   ptrdiff_t min_arity, max_arity;
@@ -646,6 +646,12 @@ module_function_interactive_form (const struct 
Lisp_Module_Function *fun)
   return fun->interactive_form;
 }
 
+Lisp_Object
+module_function_command_modes (const struct Lisp_Module_Function *fun)
+{
+  return fun->command_modes;
+}
+
 static emacs_value
 module_funcall (emacs_env *env, emacs_value func, ptrdiff_t nargs,
                emacs_value *args)
diff --git a/src/eval.c b/src/eval.c
index 91fc4e6..542d7f6 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -2080,14 +2080,21 @@ then strings and vectors are not accepted.  */)
 DEFUN ("autoload", Fautoload, Sautoload, 2, 5, 0,
        doc: /* Define FUNCTION to autoload from FILE.
 FUNCTION is a symbol; FILE is a file name string to pass to `load'.
+
 Third arg DOCSTRING is documentation for the function.
-Fourth arg INTERACTIVE if non-nil says function can be called interactively.
+
+Fourth arg INTERACTIVE if non-nil says function can be called
+interactively.  If INTERACTIVE is a list, it is interpreted as a list
+of modes the function is applicable for.
+
 Fifth arg TYPE indicates the type of the object:
    nil or omitted says FUNCTION is a function,
    `keymap' says FUNCTION is really a keymap, and
    `macro' or t says FUNCTION is really a macro.
+
 Third through fifth args give info about the real definition.
 They default to nil.
+
 If FUNCTION is already defined other than as an autoload,
 this does nothing and returns nil.  */)
   (Lisp_Object function, Lisp_Object file, Lisp_Object docstring, Lisp_Object 
interactive, Lisp_Object type)
diff --git a/src/lisp.h b/src/lisp.h
index 0847324..697dd89 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -2060,6 +2060,7 @@ struct Lisp_Subr
     const char *symbol_name;
     const char *intspec;
     EMACS_INT doc;
+    Lisp_Object command_modes;
   } GCALIGNED_STRUCT;
 union Aligned_Lisp_Subr
   {
@@ -4221,6 +4222,8 @@ extern Lisp_Object module_function_documentation
   (struct Lisp_Module_Function const *);
 extern Lisp_Object module_function_interactive_form
   (const struct Lisp_Module_Function *);
+extern Lisp_Object module_function_command_modes
+  (const struct Lisp_Module_Function *);
 extern module_funcptr module_function_address
   (struct Lisp_Module_Function const *);
 extern void *module_function_data (const struct Lisp_Module_Function *);
diff --git a/src/lread.c b/src/lread.c
index dea1b23..8b8ba93 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -4467,6 +4467,7 @@ defsubr (union Aligned_Lisp_Subr *aname)
   XSETPVECTYPE (sname, PVEC_SUBR);
   XSETSUBR (tem, sname);
   set_symbol_function (sym, tem);
+  sname->command_modes = Qnil;
 }
 
 #ifdef NOTDEF /* Use fset in subr.el now!  */