Optionally annotate 'M-x' completions with short descriptions

* lisp/simple.el (read-extended-command--affixation): Align
annotations and add documentation one-liners when available.
(read-extended-command-1): Respect 'completions-detailed'.
(suggest-key-bindings): Mention 'completions-detailed'.

* etc/NEWS: Announce.

diff --git a/etc/NEWS b/etc/NEWS
index 59078abd757c4399aeed7e64ddd257caaba014d1..52c0410a0237b1947c68bce7aa9bc0d3f58a9806 100644 (file)
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -781,6 +781,11 @@ extra details about buffer name completion candidates in the
 "*Completions*" buffer as completion annotations.  This affects
 commands that read a buffer name with completion, such as 'C-x b'.
 
+---
+*** 'M-x' completions can now show a short description next to each candidate.
+Emacs now displays short descriptions next to command name completion
+candidates when user option 'completions-detailed' in non-nil.
+
 +++
 *** New command 'minibuffer-set-completion-styles'.
 This command, bound to 'C-x /' in the minibuffer, lets you set the

diff --git a/lisp/simple.el b/lisp/simple.el
index 3df9891a7fc22eaffa65f4a459edd3dd30b5695a..f721cec4d71534cf45e923118140204436b9a208 100644 (file)
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -2366,10 +2366,12 @@ mode when reading the command name."
               ;; and it serves as a shorthand for "Extended command: ".
                (or prompt "M-x "))
        (lambda (string pred action)
-         (if (and suggest-key-bindings (eq action 'metadata))
-            '(metadata
-              (affixation-function . read-extended-command--affixation)
-              (category . command))
+         (if (eq action 'metadata)
+            `(metadata
+               (category . command)
+              ,@(when completions-detailed
+                   '((affixation-function . read-extended-command--affixation)))
+               (display-sort-function . minibuffer-sort-by-history))
            (let ((pred
                   (if (memq action '(nil t))
                       ;; Exclude from completions obsolete commands
@@ -2479,26 +2481,74 @@ or (if one of MODES is a minor mode), if it is switched on in BUFFER."
          (eq (get-text-property (point) 'category) category))))
 
 (defun read-extended-command--affixation (command-names)
-  (with-selected-window (or (minibuffer-selected-window) (selected-window))
+  (let* ((max-name (seq-max (mapcar #'string-width
+                                    (or (remove nil command-names)
+                                        '("")))))
+         (spc-dsp1 (propertize " " 'display
+                               `(space :align-to ,(+ max-name 2))))
+         (bindings
+          (when suggest-key-bindings
+            (with-selected-window (or (minibuffer-selected-window)
+                                      (selected-window))
+              (mapcar
+               (lambda (command-name)
+                 (let* ((fun (and (stringp command-name)
+                                  (intern-soft command-name)))
+                        (binding (where-is-internal
+                                  fun overriding-local-map t)))
+                   (cons fun (and binding (not (stringp binding))
+                                  (key-description binding)))))
+               command-names))))
+         (max-bind (seq-max (mapcar #'string-width
+                                    (or (remove nil (mapcar #'cdr bindings))
+                                        '("")))))
+         (spc-dsp2 (propertize " " 'display
+                               `(space :align-to ,(+ max-name max-bind 4)))))
     (mapcar
      (lambda (command-name)
        (let* ((fun (and (stringp command-name) (intern-soft command-name)))
-              (binding (where-is-internal fun overriding-local-map t))
+              (binding (alist-get fun bindings))
               (obsolete (get fun 'byte-obsolete-info))
               (alias (symbol-function fun))
+              (doc (condition-case nil (documentation fun) (error nil)))
+              (doc (and doc (substring doc 0 (string-search "\n" doc))))
               (suffix (cond ((symbolp alias)
-                             (format " (%s)" alias))
+                             (propertize
+                              (concat spc-dsp2 "alias for "
+                                      (substitute-quotes
+                                       (concat "`" (symbol-name alias) "'")))
+                              'face 'completions-annotations))
                             (obsolete
-                             (format " (%s)" (car obsolete)))
-                            ((and binding (not (stringp binding)))
-                             (format " (%s)" (key-description binding)))
+                             (if-let ((other (car obsolete))
+                                      (string
+                                       (cond
+                                        ((symbolp other)
+                                         (concat "deprecated in favor of `"
+                                                 (symbol-name other) "'"))
+                                        ((stringp other) other))))
+                                 (concat spc-dsp2
+                                         (propertize
+                                          (substitute-quotes string)
+                                          'face 'completions-annotations))
+                               ""))
+                            (binding
+                             (concat spc-dsp1
+                                     (propertize binding 'face 'help-key-binding)
+                                     (when doc
+                                       (concat spc-dsp2
+                                               (propertize
+                                                doc 'face
+                                                'completions-annotations)))))
+                            (doc
+                             (concat spc-dsp2 (propertize
+                                               doc 'face
+                                               'completions-annotations)))
                             (t ""))))
-         (put-text-property 0 (length suffix)
-                            'face 'completions-annotations suffix)
          (when extended-command-dim-hyphens
            (named-let dim ((hy (string-search "-" command-name)))
              (when hy
-               (add-face-text-property hy (1+ hy) 'dim-hyphen nil command-name)
+               (add-face-text-property hy (1+ hy)
+                                       'dim-hyphen nil command-name)
                (dim (string-search "-" command-name (1+ hy))))))
          (list command-name "" suffix)))
      command-names)))
@@ -2511,7 +2561,8 @@ If the value is non-nil and not a number, we wait 2 seconds.
 
 Also see `extended-command-suggest-shorter'.
 
-Equivalent key-bindings are also shown in the completion list of
+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."
   :group 'keyboard
   :type '(choice (const :tag "off" nil)