master c1ef7ad 04/12: Add 'read-extended-command-predicate'

[Lars Ingebrigtsen]

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

    Add 'read-extended-command-predicate'
    
    * doc/emacs/m-x.texi (M-x): Document it.
    * doc/lispref/commands.texi (Interactive Call): Document it further.
    
    * lisp/simple.el (read-extended-command-predicate): New user option.
    (read-extended-command-predicate): Use it.
    (completion-in-mode-p): New function (the default predicate).
---
 doc/emacs/m-x.texi        |   5 ++
 doc/lispref/commands.texi |   9 ++++
 etc/NEWS                  |   5 ++
 lisp/emacs-lisp/seq.el    |   1 +
 lisp/simple.el            | 131 +++++++++++++++++++++++++++++-----------------
 5 files changed, 103 insertions(+), 48 deletions(-)

diff --git a/doc/emacs/m-x.texi b/doc/emacs/m-x.texi
index 865220f..689125e 100644
--- a/doc/emacs/m-x.texi
+++ b/doc/emacs/m-x.texi
@@ -94,3 +94,8 @@ the command is followed by arguments.
   @kbd{M-x} works by running the command
 @code{execute-extended-command}, which is responsible for reading the
 name of another command and invoking it.
+
+@vindex read-extended-command-predicate
+  This command heeds the @code{read-extended-command-predicate}
+variable, which will (by default) filter out commands that are not
+applicable to the current major mode (or enabled minor modes).
diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi
index d60745a..b3bcdf3 100644
--- a/doc/lispref/commands.texi
+++ b/doc/lispref/commands.texi
@@ -773,6 +773,15 @@ part of the prompt.
      @result{} t
 @end group
 @end example
+
+@vindex read-extended-command-predicate
+This command heeds the @code{read-extended-command-predicate}
+variable, which will (by default) filter out commands that are not
+applicable to the current major mode (or enabled minor modes).
+@code{read-extended-command-predicate} will be called with two
+parameters: The symbol that is to be included or not, and the current
+buffer.  If should return non-@code{nil} if the command is to be
+included when completing.
 @end deffn
 
 @node Distinguish Interactive
diff --git a/etc/NEWS b/etc/NEWS
index 3b6467b..9c3396d 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -251,6 +251,11 @@ commands.  The new keystrokes are 'C-x x g' 
('revert-buffer'),
 
 * Editing Changes in Emacs 28.1
 
++++
+** New user option 'read-extended-command-predicate'.
+This option controls how 'M-x TAB' performs completions.  The default
+predicate excludes modes for which the command is not applicable.
+
 ---
 ** 'eval-expression' now no longer signals an error on incomplete expressions.
 Previously, typing 'M-: ( RET' would result in Emacs saying "End of
diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el
index 31c15fe..55ce6d9 100644
--- a/lisp/emacs-lisp/seq.el
+++ b/lisp/emacs-lisp/seq.el
@@ -455,6 +455,7 @@ negative integer or 0, nil is returned."
         (setq sequence (seq-drop sequence n)))
       (nreverse result))))
 
+;;;###autoload
 (cl-defgeneric seq-intersection (sequence1 sequence2 &optional testfn)
   "Return a list of the elements that appear in both SEQUENCE1 and SEQUENCE2.
 Equality is defined by TESTFN if non-nil or by `equal' if nil."
diff --git a/lisp/simple.el b/lisp/simple.el
index 9057355..015fa9e 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -1900,55 +1900,90 @@ to get different commands to edit and resubmit."
 (defvar extended-command-history nil)
 (defvar execute-extended-command--last-typed nil)
 
+(defcustom read-extended-command-predicate #'completion-in-mode-p
+  "Predicate to use to determine which commands to include when completing.
+The predicate function is called with two parameter: The
+symbol (i.e., command) in question that should be included or
+not, and the current buffer.  The predicate should return non-nil
+if the command should be present when doing `M-x TAB'."
+  :version "28.1"
+  :type '(choice (const :tag "Exclude commands not relevant to this mode"
+                        #'completion-in-mode-p)
+                 (const :tag "All commands" (lambda (_ _) t))
+                 (function :tag "Other function")))
+
 (defun read-extended-command ()
-  "Read command name to invoke in `execute-extended-command'."
-  (minibuffer-with-setup-hook
-      (lambda ()
-        (add-hook 'post-self-insert-hook
-                  (lambda ()
-                    (setq execute-extended-command--last-typed
-                              (minibuffer-contents)))
-                  nil 'local)
-        (setq-local minibuffer-default-add-function
-            (lambda ()
-              ;; Get a command name at point in the original buffer
-              ;; to propose it after M-n.
-              (let ((def (with-current-buffer
-                             (window-buffer (minibuffer-selected-window))
-                           (and (commandp (function-called-at-point))
-                                (format "%S" (function-called-at-point)))))
-                    (all (sort (minibuffer-default-add-completions)
-                                #'string<)))
-                (if def
-                    (cons def (delete def all))
-                  all)))))
-    ;; Read a string, completing from and restricting to the set of
-    ;; all defined commands.  Don't provide any initial input.
-    ;; Save the command read on the extended-command history list.
-    (completing-read
-     (concat (cond
-             ((eq current-prefix-arg '-) "- ")
-             ((and (consp current-prefix-arg)
-                   (eq (car current-prefix-arg) 4)) "C-u ")
-             ((and (consp current-prefix-arg)
-                   (integerp (car current-prefix-arg)))
-              (format "%d " (car current-prefix-arg)))
-             ((integerp current-prefix-arg)
-              (format "%d " current-prefix-arg)))
-            ;; This isn't strictly correct if `execute-extended-command'
-            ;; is bound to anything else (e.g. [menu]).
-            ;; It could use (key-description (this-single-command-keys)),
-            ;; but actually a prompt other than "M-x" would be confusing,
-            ;; because "M-x" is a well-known prompt to read a command
-            ;; and it serves as a shorthand for "Extended command: ".
-            "M-x ")
-     (lambda (string pred action)
-       (if (and suggest-key-bindings (eq action 'metadata))
-          '(metadata
-            (affixation-function . read-extended-command--affixation)
-            (category . command))
-         (complete-with-action action obarray string pred)))
-     #'commandp t nil 'extended-command-history)))
+  "Read command name to invoke in `execute-extended-command'.
+This function uses the `read-extended-command-predicate' user option."
+  (let ((buffer (current-buffer)))
+    (minibuffer-with-setup-hook
+        (lambda ()
+          (add-hook 'post-self-insert-hook
+                    (lambda ()
+                      (setq execute-extended-command--last-typed
+                            (minibuffer-contents)))
+                    nil 'local)
+          (setq-local minibuffer-default-add-function
+                     (lambda ()
+                       ;; Get a command name at point in the original buffer
+                       ;; to propose it after M-n.
+                       (let ((def
+                               (with-current-buffer
+                                  (window-buffer (minibuffer-selected-window))
+                                (and (commandp (function-called-at-point))
+                                     (format
+                                       "%S" (function-called-at-point)))))
+                             (all (sort (minibuffer-default-add-completions)
+                                         #'string<)))
+                         (if def
+                             (cons def (delete def all))
+                           all)))))
+      ;; Read a string, completing from and restricting to the set of
+      ;; all defined commands.  Don't provide any initial input.
+      ;; Save the command read on the extended-command history list.
+      (completing-read
+       (concat (cond
+               ((eq current-prefix-arg '-) "- ")
+               ((and (consp current-prefix-arg)
+                     (eq (car current-prefix-arg) 4)) "C-u ")
+               ((and (consp current-prefix-arg)
+                     (integerp (car current-prefix-arg)))
+                (format "%d " (car current-prefix-arg)))
+               ((integerp current-prefix-arg)
+                (format "%d " current-prefix-arg)))
+              ;; This isn't strictly correct if `execute-extended-command'
+              ;; is bound to anything else (e.g. [menu]).
+              ;; It could use (key-description (this-single-command-keys)),
+              ;; but actually a prompt other than "M-x" would be confusing,
+              ;; because "M-x" is a well-known prompt to read a command
+              ;; and it serves as a shorthand for "Extended command: ".
+              "M-x ")
+       (lambda (string pred action)
+         (if (and suggest-key-bindings (eq action 'metadata))
+            '(metadata
+              (affixation-function . read-extended-command--affixation)
+              (category . command))
+           (complete-with-action action obarray string pred)))
+       (lambda (sym)
+         (and (commandp sym)
+              (if (get sym 'completion-predicate)
+                  (funcall (get sym 'completion-predicate) sym buffer)
+                (funcall read-extended-command-predicate sym buffer))))
+       t nil 'extended-command-history))))
+
+(defun completion-in-mode-p (symbol buffer)
+  "Say whether SYMBOL should be offered as a completion.
+This is true if the command is applicable to the major mode in
+BUFFER."
+  (or (null (command-modes symbol))
+      ;; It's derived from a major mode.
+      (apply #'provided-mode-derived-p
+             (buffer-local-value 'major-mode buffer)
+             (command-modes symbol))
+      ;; It's a minor mode.
+      (seq-intersection (command-modes symbol)
+                        (buffer-local-value 'minor-modes buffer)
+                        #'eq)))
 
 (defun completion-with-modes-p (modes buffer)
   (apply #'provided-mode-derived-p