Overhaul annotation-function to match affixation-functionscratch/annotation-function-improvements

* 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

4 files changed, 80 insertions, 66 deletions

diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi
index 196dd990767..6324c2944c0 100644
--- a/doc/lispref/minibuf.texi
+++ b/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 @var{string} in the @file{*Completions*} buffer.
-Unless this function puts own face on the annotation suffix string,
-the @code{completions-annotations} face is added by default to
-that string.
+completion.  It may return a string, which is meant to be displayed
+along with @var{string} in the settings such as the
+@file{*Completions*}.  If the returned is propertized with strings for
+the @code{prefix} or @code{suffix} text properties (@pxref{Text
+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
-completions.  The function should take one argument,
-@var{completions}, which is a list of possible completions.  It should
-return such a list of @var{completions} where each element contains a list
-of three elements: a completion, a prefix which is displayed before
-the completion string in the @file{*Completions*} buffer, and
-a suffix displayed after the completion string.  This function
-takes priority over @code{annotation-function}.
+This function does exactly the same as @code{annotation-function} but
+takes priority over it and uses a different protocol.  The value
+should be a function for adding prefixes and suffixes to completions.
+The function should take one argument, @var{completions}, which is a
+list of possible completions.  It should return such a list of
+@var{completions} where each element contains a list of three
+elements: a completion, a prefix which is displayed before the
+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.
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index 0b0ae4364c8..4d625879de8 100644
--- a/lisp/help-fns.el
+++ b/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)
-  (mapcar (lambda (c)
-            (let* ((s (intern c))
-                   (doc (condition-case nil (documentation s) (error nil)))
-                   (doc (and doc (substring doc 0 (string-match "\n" doc)))))
-              (list c (propertize
-                       (concat (cond ((commandp s)
-                                      "c") ; command
-                                     ((eq (car-safe (symbol-function s)) 'macro)
-                                      "m") ; macro
-                                     ((fboundp s)
-                                      "f") ; function
-                                     ((custom-variable-p s)
-                                      "u") ; user option
-                                     ((boundp s)
-                                      "v") ; variable
-                                     ((facep s)
-                                      "a") ; fAce
-                                     ((and (fboundp 'cl-find-class)
-                                           (cl-find-class s))
-                                      "t")  ; CL type
-                                     (" ")) ; something else
-                               " ")         ; prefix separator
-                       'face 'completions-annotations)
-                    (if doc (propertize (format " -- %s" doc)
-                                        'face 'completions-annotations)
-                      ""))))
-          completions))
+(defun help--symbol-completion-table-annotation (completion)
+  (let* ((s (intern completion))
+         (doc (ignore-errors (documentation s)))
+         (doc (and doc (substring doc 0 (string-match "\n" doc))))
+         (annotation (and doc
+                          (propertize (format " -- %s" doc)
+                                      'face 'completions-annotations))))
+    (when annotation
+      (propertize
+       annotation
+       'prefix (propertize
+                (concat (cond ((commandp s)
+                               "c") ; command
+                              ((eq (car-safe (symbol-function s)) 'macro)
+                               "m") ; macro
+                              ((fboundp s)
+                               "f") ; function
+                              ((custom-variable-p s)
+                               "u") ; user option
+                              ((boundp s)
+                               "v") ; variable
+                              ((facep s)
+                               "a") ; fAce
+                              ((and (fboundp 'cl-find-class)
+                                    (cl-find-class s))
+                               "t")  ; CL type
+                              (" ")) ; something else
+                        " ")         ; 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)))
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index e04f1040b38..966613aa99c 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -2251,11 +2251,20 @@ variables.")
                               (funcall aff-fun completions)))
                        (ann-fun
                         (setq completions
-                              (mapcar (lambda (s)
-                                        (let ((ann (funcall ann-fun s)))
-                                          (if ann (list s ann) s)))
-                                      completions))))
-
+                              (mapcar
+                               (lambda (s)
+                                 (let* ((ann (funcall ann-fun s))
+                                        (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)
diff --git a/lisp/simple.el b/lisp/simple.el
index 2a90a076315..aaed17cb9ea 100644
--- a/lisp/simple.el
+++ b/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
-     (lambda (command-name)
-       (let* ((fun (and (stringp command-name) (intern-soft command-name)))
-              (binding (where-is-internal fun overriding-local-map t))
-              (obsolete (get fun 'byte-obsolete-info))
-              (alias (symbol-function fun))
-              (suffix (cond ((symbolp alias)
-                             (format " (%s)" alias))
-                            (obsolete
-                             (format " (%s)" (car obsolete)))
-                            ((and binding (not (stringp binding)))
-                             (format " (%s)" (key-description binding)))
-                            (t ""))))
-         (put-text-property 0 (length suffix)
-                            'face 'completions-annotations suffix)
-         (list command-name "" suffix)))
-     command-names)))
+    (let* ((fun (and (stringp command-name) (intern-soft command-name)))
+           (binding (where-is-internal fun overriding-local-map t))
+           (obsolete (get fun 'byte-obsolete-info))
+           (alias (symbol-function fun))
+           (annotation (cond ((symbolp alias)
+                              (format " (%s)" alias))
+                             (obsolete
+                              (format " (%s)" (car obsolete)))
+                             ((and binding (not (stringp binding)))
+                              (format " (%s)" (key-description binding)))
+                             (t ""))))
+      (put-text-property 0 (length annotation)
+                         'face 'completions-annotations annotation)
+      (when annotation
+        (propertize annotation 'prefix "" 'suffix annotation)))))
 
 (defcustom suggest-key-bindings t
   "Non-nil means show the equivalent key-binding when M-x command has one.