Overhaul annotation-function to match affixation-function

* doc/lispref/minibuf.texi (Programmed Completion): Rework
annotation-function and affixation-function.

* lisp/help-fns.el (help--symbol-completion-table-annotation): Rename
from help--symbol-completion-table-affixation.
(help--symbol-completion-table): Use
help--symbol-completion-table-annotation.

* lisp/minibuffer.el (minibuffer-completion-help): Interpret
annotation-function with more sophistication.

* lisp/simple.el (read-extended-command): Use
read-extended-command--annotation
(read-extended-command--annotation): Rename from
read-extended-command--affixation

doc/lispref/minibuf.texi

@@ -1927,21 +1927,25 @@ completion behavior is overridden.  @xref{Completion Variables}.
 @item annotation-function
 The value should be a function for @dfn{annotating} completions.  The
 function should take one argument, @var{string}, which is a possible
-completion.  It should return a string, which is displayed after the
+completion.  It may return a string, which is meant to be displayed
-completion @var{string} in the @file{*Completions*} buffer.
+along with @var{string} in the settings such as the
-Unless this function puts own face on the annotation suffix string,
+@file{*Completions*}.  If the returned is propertized with strings for
-the @code{completions-annotations} face is added by default to
+the @code{prefix} or @code{suffix} text properties (@pxref{Text
-that string.
+Properties}), those properties function as more specific hints of how
+to display.  Unless this function puts own face on the annotation
+strings, the @code{completions-annotations} face is added by default
+to them.
 
 @item affixation-function
-The value should be a function for adding prefixes and suffixes to
+This function does exactly the same as @code{annotation-function} but
-completions.  The function should take one argument,
+takes priority over it and uses a different protocol.  The value
-@var{completions}, which is a list of possible completions.  It should
+should be a function for adding prefixes and suffixes to completions.
-return such a list of @var{completions} where each element contains a list
+The function should take one argument, @var{completions}, which is a
-of three elements: a completion, a prefix which is displayed before
+list of possible completions.  It should return such a list of
-the completion string in the @file{*Completions*} buffer, and
+@var{completions} where each element contains a list of three
-a suffix displayed after the completion string.  This function
+elements: a completion, a prefix which is displayed before the
-takes priority over @code{annotation-function}.
+completion string in the @file{*Completions*} buffer, and a suffix
+displayed after the completion string.
 
 @item group-function
 The value should be a function for grouping the completion candidates.

lisp/help-fns.el

@@ -126,38 +126,40 @@ with the current prefix.  The files are chosen according to
   :group 'help
   :version "26.3")
 
-(defun help--symbol-completion-table-affixation (completions)
+(defun help--symbol-completion-table-annotation (completion)
-  (mapcar (lambda (c)
+  (let* ((s (intern completion))
-            (let* ((s (intern c))
+         (doc (ignore-errors (documentation s)))
-                   (doc (condition-case nil (documentation s) (error nil)))
+         (doc (and doc (substring doc 0 (string-match "\n" doc))))
-                   (doc (and doc (substring doc 0 (string-match "\n" doc)))))
+         (annotation (and doc
-              (list c (propertize
+                          (propertize (format " -- %s" doc)
-                       (concat (cond ((commandp s)
+                                      'face 'completions-annotations))))
-                                      "c") ; command
+    (when annotation
-                                     ((eq (car-safe (symbol-function s)) 'macro)
+      (propertize
-                                      "m") ; macro
+       annotation
-                                     ((fboundp s)
+       'prefix (propertize
-                                      "f") ; function
+                (concat (cond ((commandp s)
-                                     ((custom-variable-p s)
+                               "c") ; command
-                                      "u") ; user option
+                              ((eq (car-safe (symbol-function s)) 'macro)
-                                     ((boundp s)
+                               "m") ; macro
-                                      "v") ; variable
+                              ((fboundp s)
-                                     ((facep s)
+                               "f") ; function
-                                      "a") ; fAce
+                              ((custom-variable-p s)
-                                     ((and (fboundp 'cl-find-class)
+                               "u") ; user option
-                                           (cl-find-class s))
+                              ((boundp s)
-                                      "t")  ; CL type
+                               "v") ; variable
-                                     (" ")) ; something else
+                              ((facep s)
-                               " ")         ; prefix separator
+                               "a") ; fAce
-                       'face 'completions-annotations)
+                              ((and (fboundp 'cl-find-class)
-                    (if doc (propertize (format " -- %s" doc)
+                                    (cl-find-class s))
-                                        'face 'completions-annotations)
+                               "t")  ; CL type
-                      ""))))
+                              (" ")) ; something else
-          completions))
+                        " ")         ; prefix separator
+                'face 'completions-annotations)
+       'suffix annotation))))
 
 (defun help--symbol-completion-table (string pred action)
   (if (and completions-detailed (eq action 'metadata))
-      '(metadata (affixation-function . help--symbol-completion-table-affixation))
+      '(metadata (annotation-function . help--symbol-completion-table-annotation))
     (when help-enable-completion-autoload
       (let ((prefixes (radix-tree-prefixes (help-definition-prefixes) string)))
         (help--load-prefixes prefixes)))

lisp/minibuffer.el

@@ -2251,11 +2251,20 @@ variables.")
                               (funcall aff-fun completions)))
                        (ann-fun
                         (setq completions
-                              (mapcar (lambda (s)
+                              (mapcar
-                                        (let ((ann (funcall ann-fun s)))
+                               (lambda (s)
-                                          (if ann (list s ann) s)))
+                                 (let* ((ann (funcall ann-fun s))
-                                      completions))))
+                                        (prefix-hint
-
+                                         (and ann
+                                              (get-text-property 0 'prefix ann)))
+                                        (suffix-hint
+                                         (and ann
+                                              (get-text-property 0 'suffix ann))))
+                                   (cond (prefix-hint
+                                          (list s prefix-hint (or suffix-hint "")))
+                                         (ann (list s ann))
+                                         (t s))))
+                               completions))))
                       (with-current-buffer standard-output
                         (setq-local completion-base-position
                              (list (+ start base-size)

lisp/simple.el

@@ -2004,7 +2004,7 @@ This function uses the `read-extended-command-predicate' user option."
        (lambda (string pred action)
          (if (and suggest-key-bindings (eq action 'metadata))
 	     '(metadata
-	       (affixation-function . read-extended-command--affixation)
+	       (annotation-function . read-extended-command--annotation)
 	       (category . command))
            (let ((pred
                   (if (memq action '(nil t))
@@ -2093,25 +2093,24 @@ or (if one of MODES is a minor mode), if it is switched on in BUFFER."
     (and (get-text-property (point) 'button)
          (eq (get-text-property (point) 'category) category))))
 
-(defun read-extended-command--affixation (command-names)
+(defun read-extended-command--annotation (command-name)
+  ;; why is this `with-selected-window' here?
   (with-selected-window (or (minibuffer-selected-window) (selected-window))
-    (mapcar
+    (let* ((fun (and (stringp command-name) (intern-soft command-name)))
-     (lambda (command-name)
+           (binding (where-is-internal fun overriding-local-map t))
-       (let* ((fun (and (stringp command-name) (intern-soft command-name)))
+           (obsolete (get fun 'byte-obsolete-info))
-              (binding (where-is-internal fun overriding-local-map t))
+           (alias (symbol-function fun))
-              (obsolete (get fun 'byte-obsolete-info))
+           (annotation (cond ((symbolp alias)
-              (alias (symbol-function fun))
+                              (format " (%s)" alias))
-              (suffix (cond ((symbolp alias)
+                             (obsolete
-                             (format " (%s)" alias))
+                              (format " (%s)" (car obsolete)))
-                            (obsolete
+                             ((and binding (not (stringp binding)))
-                             (format " (%s)" (car obsolete)))
+                              (format " (%s)" (key-description binding)))
-                            ((and binding (not (stringp binding)))
+                             (t ""))))
-                             (format " (%s)" (key-description binding)))
+      (put-text-property 0 (length annotation)
-                            (t ""))))
+                         'face 'completions-annotations annotation)
-         (put-text-property 0 (length suffix)
+      (when annotation
-                            'face 'completions-annotations suffix)
+        (propertize annotation 'prefix "" 'suffix annotation)))))
-         (list command-name "" suffix)))
-     command-names)))
 
 (defcustom suggest-key-bindings t
   "Non-nil means show the equivalent key-binding when M-x command has one.