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).
This commit is contained in:
Lars Ingebrigtsen 2021-02-14 13:56:53 +01:00
parent 2bfcd93e83
commit c1ef7adeb6
5 changed files with 103 additions and 48 deletions

View file

@ -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).

View file

@ -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

View file

@ -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

View file

@ -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."

View file

@ -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