From bde46c491238385430228e535eab0c355bb092b7 Mon Sep 17 00:00:00 2001 From: Eshel Yaron Date: Sat, 29 Jun 2024 20:40:43 +0200 Subject: [PATCH] (read-extended-command): Be less weird --- lisp/simple.el | 300 ++++++++++++------------------------------------- 1 file changed, 69 insertions(+), 231 deletions(-) diff --git a/lisp/simple.el b/lisp/simple.el index 45113a7b0f2..947735fec91 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -268,6 +268,10 @@ all other buffers." :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) @@ -2221,7 +2225,6 @@ 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 nil "Predicate to use to determine which commands to include when completing. @@ -2264,150 +2267,55 @@ are available: 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 \\\\[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." @@ -2566,6 +2474,11 @@ or (if one of MODES is a minor mode), if it is switched on 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))) @@ -2575,8 +2488,6 @@ or (if one of MODES is a minor mode), if it is switched on in BUFFER." 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." @@ -2585,64 +2496,16 @@ key-bindings are also shown in the completion list of (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'. @@ -2651,19 +2514,12 @@ This command provides completion when reading the command name. 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 @@ -2671,9 +2527,6 @@ customizing `read-extended-command-predicate'." ;; `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 RET is nothing more than a "key @@ -2687,9 +2540,7 @@ customizing `read-extended-command-predicate'." ;; 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 @@ -2697,15 +2548,7 @@ customizing `read-extended-command-predicate'." ((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 @@ -2713,16 +2556,10 @@ customizing `read-extended-command-predicate'." ;; 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)))))))))))) @@ -2734,8 +2571,7 @@ customizing `read-extended-command-predicate'." (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 @@ -2745,12 +2581,14 @@ minor modes), as well as commands bound in the active local key 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 -- 2.39.2