:group 'minibuffer
:version "30.1")
+(defface obsolete
+ '((t :inherit shadow :strike-through t))
+ "Face for deprecated or obsolete commands.")
+
(defun next-error-buffer-on-selected-frame (&optional _avoid-current
extra-test-inclusive
extra-test-exclusive)
(defvar extended-command-history nil)
-(defvar execute-extended-command--last-typed nil)
(defcustom read-extended-command-predicate nil
"Predicate to use to determine which commands to include when completing.
command-completion-using-modes-and-keymaps-p)
(function :tag "Other predicate function")))
-(defun execute-extended-command-cycle ()
- "Choose the next version of the extended command predicates.
-See `extended-command-versions'."
- (interactive)
- (throw 'cycle
- (cons (minibuffer-contents)
- (- (point) (minibuffer-prompt-end)))))
-
-(defvar extended-command-versions
- (list (list "M-x " (lambda () read-extended-command-predicate))
- (list "M-X " #'command-completion--command-for-this-buffer-function))
- "Alist of prompts and what the extended command predicate should be.
-This is used by the \\<read-extended-command-mode-map>\\[execute-extended-command-cycle] command when reading an extended command.")
-
-(defvar-keymap read-extended-command-mode-map
- :doc "Local keymap added to the current map when reading an extended command."
- "M-X" #'execute-extended-command-cycle)
-
-(define-minor-mode read-extended-command-mode
- "Minor mode used for completion in `read-extended-command'.")
-
-(defun read-extended-command (&optional prompt)
+(defun read-extended-command (&optional prompt predicate)
"Read command name to invoke via `execute-extended-command'.
Use `read-extended-command-predicate' to determine which commands
to include among completion candidates.
This function activates the `read-extended-command-mode' minor
mode when reading the command name."
- (let ((default-predicate read-extended-command-predicate)
- (read-extended-command-predicate read-extended-command-predicate)
- already-typed ret)
- ;; If we have a prompt (which is the name of the version of the
- ;; command), then set up the predicate from
- ;; `extended-command-versions'.
- (if (not prompt)
- (setq prompt (caar extended-command-versions))
- (setq read-extended-command-predicate
- (funcall (cadr (assoc prompt extended-command-versions)))))
- ;; Normally this will only execute once.
- (while (not (stringp ret))
- (when (consp (setq ret (catch 'cycle
- (read-extended-command-1 prompt
- already-typed))))
- ;; But if the user hit `M-X', then we `throw'ed out to that
- ;; `catch', and we cycle to the next setting.
- (let ((next (or (cadr (memq (assoc prompt extended-command-versions)
- extended-command-versions))
- ;; Last one; cycle back to the first.
- (car extended-command-versions))))
- ;; Restore the user's default predicate.
- (setq read-extended-command-predicate default-predicate)
- ;; Then calculate the next.
- (setq prompt (car next)
- read-extended-command-predicate (funcall (cadr next))
- already-typed ret))))
- ret))
-
-(defun read-extended-command-1 (prompt initial-input)
- (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)
- ;; This is so that we define the `M-X' toggling command.
- (read-extended-command-mode)
- (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. 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: ".
- (or prompt "M-x "))
- (lambda (string pred action)
- (if (eq action 'metadata)
- `(metadata
- (category . command)
- ,@(when completions-detailed
- '((affixation-function . read-extended-command--affixation))))
- (let ((pred
- (if (memq action '(nil t))
- ;; Exclude from completions obsolete commands
- ;; lacking a `current-name', or where `when' is
- ;; not the current major version.
- (lambda (sym)
- (let ((obsolete (get sym 'byte-obsolete-info)))
- (and (funcall pred sym)
- (or (equal string (symbol-name sym))
- (not obsolete)
- (and
- ;; Has a current-name.
- (functionp (car obsolete))
- ;; when >= emacs-major-version
- (condition-case nil
- (>= (car (version-to-list
- (caddr obsolete)))
- emacs-major-version)
- ;; If the obsoletion version isn't
- ;; valid, include the command.
- (error t)))))))
- pred)))
- (complete-with-action action obarray string pred))))
- (lambda (sym)
- (and (commandp sym)
- (cond ((null read-extended-command-predicate))
- ((functionp read-extended-command-predicate)
- ;; Don't let bugs break M-x completion; interpret
- ;; them as the absence of a predicate.
- (condition-case-unless-debug err
- (funcall read-extended-command-predicate sym buffer)
- (error (message "read-extended-command-predicate: %s: %s"
- sym (error-message-string err))))))))
- t initial-input 'extended-command-history))))
+ (let ((predicate (or predicate read-extended-command-predicate))
+ (default (and (commandp (symbol-at-point))
+ (format "%S" (symbol-at-point)))))
+ ;; Read a string, completing from and restricting to the set of
+ ;; all defined commands. Save the command read on the
+ ;; extended-command history list.
+ (completing-read
+ (format-prompt
+ (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: ".
+ (or prompt "M-x"))
+ default)
+ (completion-table-with-metadata
+ obarray
+ `((category . command)
+ ;; TODO: Add a `narrow-completions-function' using
+ ;; `command-completion--command-for-this-buffer-function', and
+ ;; also for filtering out obsolete commands.
+ ,@(when completions-detailed
+ '((affixation-function . read-extended-command--affixation)))))
+ (lambda (sym)
+ (and (commandp sym)
+ (or (null predicate)
+ (condition-case-unless-debug err
+ (funcall predicate sym minibuffer--original-buffer)
+ (error (message "read-extended-command-predicate: %s: %s"
+ sym (error-message-string err)))))))
+ t nil 'extended-command-history default)))
(defun command-completion-using-modes-p (symbol buffer)
"Say whether SYMBOL has been marked as a mode-specific command in BUFFER."
(when hy
(add-face-text-property hy (1+ hy) 'dim-hyphen nil command-name)
(dim (string-search "-" command-name (1+ hy))))))
+ (when obsolete
+ (unless extended-command-dim-hyphens
+ (setq command-name (copy-sequence command-name)))
+ (add-face-text-property 0 (length command-name)
+ 'obsolete t command-name))
(list command-name "" suffix)))
command-names)))
The value can be a length of time to show the message for.
If the value is non-nil and not a number, we wait 2 seconds.
-Also see `extended-command-suggest-shorter'.
-
If the user option `completions-detailed' in non-nil, equivalent
key-bindings are also shown in the completion list of
\\[execute-extended-command] for all commands that have them."
(natnum :tag "time" 2)
(other :tag "on" t)))
-(defcustom extended-command-suggest-shorter t
- "If non-nil, show a shorter \\[execute-extended-command] invocation \
-when there is one.
-
-Also see `suggest-key-bindings'."
- :group 'keyboard
- :type 'boolean
- :version "26.1")
-
-(defun execute-extended-command--shorter-1 (name length)
- (cond
- ((zerop length) (list ""))
- ((equal name "") nil)
- (t
- (nconc (mapcar (lambda (s) (concat (substring name 0 1) s))
- (execute-extended-command--shorter-1
- (substring name 1) (1- length)))
- (when (string-match "\\`\\(-\\)?[^-]*" name)
- (execute-extended-command--shorter-1
- (substring name (match-end 0)) length))))))
-
-(defun execute-extended-command--shorter (name typed)
- (let ((candidates '())
- commands
- (max (length typed))
- (len 1)
- binding)
- ;; Precompute a list of commands once to avoid repeated `commandp' testing
- ;; of symbols in the `completion-try-completion' call inside the loop below
- (mapatoms (lambda (s) (when (commandp s) (push s commands))))
- (while (and (not binding)
- (progn
- (unless candidates
- (setq len (1+ len))
- (setq candidates (execute-extended-command--shorter-1
- name len)))
- ;; Don't show the help message if the binding isn't
- ;; significantly shorter than the M-x command the user typed.
- (< len (- max 5))))
- (input-pending-p) ;Dummy call to trigger input-processing, bug#23002.
- (let ((candidate (pop candidates)))
- (when (equal name
- (car-safe (completion-try-completion
- candidate commands nil len)))
- (setq binding candidate))))
- binding))
-
(defvar execute-extended-command--binding-timer nil)
-(defun execute-extended-command--describe-binding-msg (function binding shorter)
+(defun execute-extended-command--describe-binding-msg (function binding)
(format-message "You can run the command `%s' with %s"
function
- (propertize (cond (shorter (concat "M-x " shorter))
- ((stringp binding) binding)
+ (propertize (cond ((stringp binding) binding)
(t (key-description binding)))
'face 'help-key-binding)))
-(defun execute-extended-command (prefixarg &optional command-name typed)
+(defun execute-extended-command (prefixarg &optional command-name)
"Read COMMAND-NAME and call that command interactively.
To pass a prefix argument PREFIXARG to the command you are invoking,
give a prefix argument to `execute-extended-command'.
Which completion candidates are shown can be controlled by
customizing `read-extended-command-predicate'."
(declare (interactive-only command-execute))
- ;; FIXME: Remember the actual text typed by the user before completion,
- ;; so that we don't later on suggest the same shortening.
- (interactive
- (let ((execute-extended-command--last-typed nil))
- (list current-prefix-arg
- (read-extended-command)
- execute-extended-command--last-typed)))
+ (interactive (list current-prefix-arg (read-extended-command)))
(let* ((function (and (stringp command-name) (intern-soft command-name)))
(binding (and suggest-key-bindings
(not executing-kbd-macro)
(where-is-internal function overriding-local-map t)))
- (delay-before-suggest 0)
- find-shorter shorter)
+ (delay-before-suggest 0))
(unless (commandp function)
(error "`%s' is not a valid command name" command-name))
;; If we're executing a command that's remapped, we can't actually
;; `where-is-internal'.
(when (and binding (command-remapping function))
(setq binding nil))
- ;; Some features, such as novice.el, rely on this-command-keys
- ;; including M-x COMMAND-NAME RET.
- (set--this-command-keys (concat "\M-x" (symbol-name function) "\r"))
(setq this-command function)
;; Normally `real-this-command' should never be changed, but here we really
;; want to pretend that M-x <cmd> RET is nothing more than a "key
;; flight.
(when execute-extended-command--binding-timer
(cancel-timer execute-extended-command--binding-timer))
- (when (and suggest-key-bindings
- (or binding
- (and extended-command-suggest-shorter typed)))
+ (when (and suggest-key-bindings binding)
;; If this command displayed something in the echo area, then
;; postpone the display of our suggestion message a bit.
(setq delay-before-suggest
((zerop (length (current-message))) 0)
((numberp suggest-key-bindings) suggest-key-bindings)
(t 2)))
- (when (and extended-command-suggest-shorter
- (not binding)
- (not executing-kbd-macro)
- (symbolp function)
- (> (length (symbol-name function)) 2))
- ;; There's no binding for CMD. Let's try and find the shortest
- ;; string to use in M-x. But don't actually do anything yet.
- (setq find-shorter t))
- (when (or binding find-shorter)
+ (when binding
(setq execute-extended-command--binding-timer
(run-at-time
delay-before-suggest nil
;; If the user has typed any other commands in the
;; meantime, then don't display anything.
(when (eq function real-last-command)
- ;; Find shorter string.
- (when find-shorter
- (while-no-input
- ;; FIXME: Can be slow. Cache it maybe?
- (setq shorter (execute-extended-command--shorter
- (symbol-name function) typed))))
- (when (or binding shorter)
+ (when binding
(with-temp-message
(execute-extended-command--describe-binding-msg
- function binding shorter)
+ function binding)
(sit-for (if (numberp suggest-key-bindings)
suggest-key-bindings
2))))))))))))
(call-interactively (intern cmd))))
"execute"))
-(defun execute-extended-command-for-buffer (prefixarg &optional
- command-name typed)
+(defun execute-extended-command-for-buffer (prefixarg &optional command-name)
"Query user for a command relevant for the current mode, and then execute it.
This is like `execute-extended-command', but it limits the
completions to commands that are particularly relevant to the
maps."
(declare (interactive-only command-execute))
(interactive
- (let ((execute-extended-command--last-typed nil))
- (list current-prefix-arg
- (read-extended-command "M-X ")
- execute-extended-command--last-typed)))
+ (list current-prefix-arg
+ (read-extended-command
+ "M-X" (command-completion--command-for-this-buffer-function))))
(with-suppressed-warnings ((interactive-only execute-extended-command))
- (execute-extended-command prefixarg command-name typed)))
+ (execute-extended-command prefixarg command-name)))
+
+(put 'execute-extended-command-for-buffer 'minibuffer-action
+ 'execute-extended-command)
(defun command-completion--command-for-this-buffer-function ()
(let ((keymaps
projects / emacs.git / commitdiff