master b32d4bf: Allow the caller to specify own face on suffix in annotation-function

[Juri Linkov]

branch: master
commit b32d4bf682c41e30c46d154093eb3b00dab6b0a5
Author: Juri Linkov <juri@linkov.net>
Commit: Juri Linkov <juri@linkov.net>

    Allow the caller to specify own face on suffix in annotation-function
    
    * lisp/minibuffer.el (completion--insert-strings):
    Don't add 'completions-annotations' face when the caller
    specified own face in annotation-function.
    Remove no-op code for 'unless prefix' branch.
    (completion-metadata, completion-extra-properties):
    Update docs of affixation-function.
    Suggested by Clemens <clemera@posteo.net> (bug#45780)
    
    * test/lisp/minibuffer-tests.el: Rename package name from
    completion-tests.el to minibuffer-tests.el.
    Add new test completion--insert-strings-faces.
    
    * doc/lispref/minibuf.texi (Completion Variables)
    (Programmed Completion): Update descriptions of
    annotation-function and affixation-function.
---
 doc/lispref/minibuf.texi      | 19 ++++++++++++++-----
 etc/NEWS                      |  3 +++
 lisp/minibuffer.el            | 19 ++++++++-----------
 test/lisp/minibuffer-tests.el | 24 +++++++++++++++++++++---
 4 files changed, 46 insertions(+), 19 deletions(-)

diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi
index 0ce17ed..185d355 100644
--- a/doc/lispref/minibuf.texi
+++ b/doc/lispref/minibuf.texi
@@ -1799,15 +1799,19 @@ pairs.  The following properties are supported:
 The value should be a function to add annotations in the completions
 buffer.  This function must accept one argument, a completion, and
 should either return @code{nil} or a string to be displayed next to
-the completion.
+the completion.  Unless this function puts own face on the annotation
+suffix string, the @code{completions-annotations} face is added by
+default to that string.
 
 @item :affixation-function
 The value should be a function to add prefixes and suffixes to
 completions.  This function must accept one argument, a list of
 completions, and should return such a list of completions where
 each element contains a list of three elements: a completion,
-a prefix string, and a suffix string.  This function takes priority
-over @code{:annotation-function}.
+a prefix string, and a suffix string.  When this function
+returns a list of two elements, it is interpreted as a list
+of a completion and a suffix string like in @code{:annotation-function}.
+This function takes priority over @code{:annotation-function}.
 
 @item :exit-function
 The value should be a function to run after performing completion.
@@ -1907,6 +1911,9 @@ 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.
 
 @item affixation-function
 The value should be a function for adding prefixes and suffixes to
@@ -1915,8 +1922,10 @@ completions.  The function should take one argument,
 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}.
+a suffix displayed after the completion string.  When this function
+returns a list of two elements, it is interpreted as a list of
+a completion and a suffix string like in @code{annotation-function}.
+This function takes priority over @code{annotation-function}.
 
 @item display-sort-function
 The value should be a function for sorting completions.  The function
diff --git a/etc/NEWS b/etc/NEWS
index 483375e..2949963 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -2017,6 +2017,9 @@ directory instead of the default directory.
 
 * Incompatible Lisp Changes in Emacs 28.1
 
+** 'completions-annotations' face is not used when the caller puts own face.
+This affects the suffix specified by completion 'annotation-function'.
+
 ** 'set-process-buffer' now updates the process mark.
 The mark will be set to point to the end of the new buffer.
 
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 315f2d3..03cc70c 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -122,7 +122,8 @@ This metadata is an alist.  Currently understood keys are:
    returns a string to append to STRING.
 - `affixation-function': function to prepend/append a prefix/suffix to
    entries.  Takes one argument (COMPLETIONS) and should return a list
-   of completions with a list of three elements: completion, its prefix
+   of completions with a list of either two elements: completion
+   and suffix, or three elements: completion, its prefix
    and suffix.  This function takes priority over `annotation-function'
    when both are provided, so only this function is used.
 - `display-sort-function': function to sort entries in *Completions*.
@@ -1785,22 +1786,17 @@ It also eliminates runs of equal strings."
                 (when prefix
                   (let ((beg (point))
                         (end (progn (insert prefix) (point))))
-                    (put-text-property beg end 'mouse-face nil)
-                    ;; When both prefix and suffix are added
-                    ;; by the caller via affixation-function,
-                    ;; then allow the caller to decide
-                    ;; what faces to put on prefix and suffix.
-                    (unless prefix
-                      (font-lock-prepend-text-property
-                       beg end 'face 'completions-annotations))))
+                    (put-text-property beg end 'mouse-face nil)))
                 (put-text-property (point) (progn (insert (car str)) (point))
                                    'mouse-face 'highlight)
                 (let ((beg (point))
                       (end (progn (insert suffix) (point))))
                   (put-text-property beg end 'mouse-face nil)
                   ;; Put the predefined face only when suffix
-                  ;; is added via annotation-function.
-                  (unless prefix
+                  ;; is added via annotation-function without prefix,
+                  ;; and when the caller doesn't use own face.
+                  (unless (or prefix (text-property-not-all
+                                      0 (length suffix) 'face nil suffix))
                     (font-lock-prepend-text-property
                      beg end 'face 'completions-annotations)))))
            (cond
@@ -1927,6 +1923,7 @@ These include:
 `:affixation-function': Function to prepend/append a prefix/suffix to
    completions.  The function must accept one argument, a list of
    completions, and return a list where each element is a list of
+   either two elements: a completion, and a suffix, or
    three elements: a completion, a prefix and a suffix.
    This function takes priority over `:annotation-function'
    when both are provided, so only this function is used.
diff --git a/test/lisp/minibuffer-tests.el b/test/lisp/minibuffer-tests.el
index 3ebca14..7349b19 100644
--- a/test/lisp/minibuffer-tests.el
+++ b/test/lisp/minibuffer-tests.el
@@ -1,4 +1,4 @@
-;;; completion-tests.el --- Tests for completion functions  -*- 
lexical-binding: t; -*-
+;;; minibuffer-tests.el --- Tests for completion functions  -*- 
lexical-binding: t; -*-
 
 ;; Copyright (C) 2013-2021 Free Software Foundation, Inc.
 
@@ -107,5 +107,23 @@
                                                 nil (length input))
                      (cons output (length output)))))))
 
-(provide 'completion-tests)
-;;; completion-tests.el ends here
+(ert-deftest completion--insert-strings-faces ()
+  (with-temp-buffer
+    (completion--insert-strings
+     '(("completion1" "suffix1")))
+    (should (equal (get-text-property 12 'face) '(completions-annotations))))
+  (with-temp-buffer
+    (completion--insert-strings
+     '(("completion1" #("suffix1" 0 7 (face shadow)))))
+    (should (equal (get-text-property 12 'face) 'shadow)))
+  (with-temp-buffer
+    (completion--insert-strings
+     '(("completion1" "prefix1" "suffix1")))
+    (should (equal (get-text-property 19 'face) nil)))
+  (with-temp-buffer
+    (completion--insert-strings
+     '(("completion1" "prefix1" #("suffix1" 0 7 (face shadow)))))
+    (should (equal (get-text-property 19 'face) 'shadow))))
+
+(provide 'minibuffer-tests)
+;;; minibuffer-tests.el ends here