[PATCH] `completing-read`: Add `group-function` support to completion metadata

[PATCH] `completing-read`: Add `group-function` support to completion metadata

[Daniel Mendler]

[-- Attachment #1: Type: text/plain, Size: 930 bytes --]

I attached a patch which adds grouping support to the completions 
buffer. The completion table can specify a `group-function` via its 
completion metadata.

Currently groups are only displayed in the *Completions* buffer if 
`completions-format=one-column`. My proposal is to split up the function 
`completion--insert-strings` into three functions 
`completion--insert-strings-one-column/vertical/horizontal` in a 
follow-up patch. Then the grouping display can also be implemented for 
the other display formats.

Group title support is already present in the Vertico, Selectrum and 
external Icomplete-vertical UI. Similarly we can add support to the 
recently added `icomplete-vertical-mode` by Gregory.

There is a patch to `xref.el` included, which makes use of the grouping 
functionality, when the `completing-read` show function is used:

(setq xref-show-xrefs-function #'xref-show-definitions-completing-read)

Daniel


[-- Attachment #2: 0001-completing-read-Add-group-function-to-completion-met.patch --]
[-- Type: text/x-diff, Size: 17730 bytes --]

From f79806a7b41f55b1e78e6e708d6f3045bfb428e2 Mon Sep 17 00:00:00 2001
From: Daniel Mendler <mail@daniel-mendler.de>
Date: Sun, 25 Apr 2021 13:07:29 +0200
Subject: [PATCH] (completing-read): Add `group-function` to completion
 metadata

A completion table can specify a `group-function` in its metadata.
The group function takes two arguments, a completion string and a
transform argument. The group function is used to group the candidates
after sorting.

If the transform argument is nil, the function should return the group
title of the group to which the completion belongs. Otherwise the
function should return the transformed candidate. The transformation
allows to remove parts of the candidate, which is then displayed in
the title.

This specific form of the `group-function` has been chosen in order to
allow allocation-free grouping. This is important for completion UIs,
which continously update the displayed set of candidates (Icomplete,
Vertico, Ivy, etc.). Only when the transform argument is non-nil the
candidate transformation is performed, which may involve a string
allocation as for example in `xref--completing-read-group`.

The function `xref-show-definitions-completing-read` makes use of the
`group-function`, by moving the file name prefix to the title. If
group titles are activated the *Completions* are displayed as "line
number:matching line" instead of "file name:line number:matching
line". This way the *Completions* buffer resembles the *Occur* buffer.

* doc/lispref/minibuf.texi: Add documentation.

* lisp/minibuffer.el: Add documentation for `group-function` as part
of completion metadata.
(completions-group-format): Add format string for group titles. The
format string can be nil in order to disable the titles.
(completions-group-title): Add face for group titles.
(completions-group-separator): Add face for group separator.
(minibuffer--group-by): New grouping function.
(completion-all-sorted-completions): Use it.
(minibuffer-completion-help): Use it.
(display-completion-list): Add optional GROUP-FUN argument.
(completion--insert-strings): Add optional GROUP-FUN argument, insert
group titles if `completions-format` is `one-column`.

* lisp/progmodes/xref.el:
(xref--completing-read-group): New grouping function.
(xref-show-definitions-completing-read): Use it.
---
 doc/lispref/minibuf.texi |  10 ++++
 lisp/minibuffer.el       | 117 ++++++++++++++++++++++++++++++++-------
 lisp/progmodes/xref.el   |  18 ++++--
 3 files changed, 121 insertions(+), 24 deletions(-)

diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi
index 7cf2fcf68f..a934a90862 100644
--- a/doc/lispref/minibuf.texi
+++ b/doc/lispref/minibuf.texi
@@ -1947,6 +1947,16 @@ Programmed Completion
 a completion and a suffix string like in @code{annotation-function}.
 This function takes priority over @code{annotation-function}.
 
+@item group-function
+The value should be a function for grouping the completion candidates.
+The function should take two arguments, @var{completion}, which is a
+completion candidate and @var{transform}, which is a boolean flag.  If
+@var{transform} is @code{nil}, the function should return a group
+title, to which the candidate belongs. Otherwise the function should
+return the transformed candidate. The transformation can for example
+remove a redundant prefix, which is displayed in the group title
+instead.
+
 @item display-sort-function
 The value should be a function for sorting completions.  The function
 should take one argument, a list of completion strings, and return a
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 98691c2ede..dd59e6cfd6 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -126,6 +126,13 @@ completion-metadata
    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.
+- `group-function': function for grouping the completion candidates.
+   Takes two arguments: a completion candidate (COMPLETION) and a
+   boolean flag (TRANSFORM).  If TRANSFORM is nil, the function
+   returns a group title, to which the candidate belongs.  Otherwise
+   the function returns the transformed candidate.  The transformation
+   can remove a redundant prefix, which is displayed in the group
+   title instead.
 - `display-sort-function': function to sort entries in *Completions*.
    Takes one argument (COMPLETIONS) and should return a new list
    of completions.  Can operate destructively.
@@ -1401,6 +1408,17 @@ minibuffer--sort-preprocess-history
                      (substring c base-size)))
                  hist)))))
 
+(defun minibuffer--group-by (fun elems)
+  "Group ELEMS by FUN."
+  (let ((groups))
+    (dolist (cand elems)
+      (let* ((key (funcall fun cand nil))
+             (group (assoc key groups)))
+        (if group
+            (setcdr group (cons cand (cdr group)))
+          (push (list key cand) groups))))
+    (mapcan (lambda (x) (nreverse (cdr x))) (nreverse groups))))
+
 (defun completion-all-sorted-completions (&optional start end)
   (or completion-all-sorted-completions
       (let* ((start (or start (minibuffer-prompt-end)))
@@ -1420,7 +1438,8 @@ completion-all-sorted-completions
                                            base-size md
                                            minibuffer-completion-table
                                            minibuffer-completion-predicate))
-             (sort-fun (completion-metadata-get all-md 'cycle-sort-function)))
+             (sort-fun (completion-metadata-get all-md 'cycle-sort-function))
+             (group-fun (completion-metadata-get all-md 'group-function)))
         (when last
           (setcdr last nil)
 
@@ -1442,6 +1461,13 @@ completion-all-sorted-completions
                           (substring string 0 base-size))
                          all))))
 
+          ;; Group candidates using the group function after sorting.
+          ;; While the candidates are separated in groups, the sorting
+          ;; order is preserved within the groups. The first
+          ;; completion determines which group is presented first.
+          (when group-fun
+            (setq all (minibuffer--group-by group-fun all)))
+
           ;; Cache the result.  This is not just for speed, but also so that
           ;; repeated calls to minibuffer-force-complete can cycle through
           ;; all possibilities.
@@ -1729,6 +1755,22 @@ completion-in-region--single-word
 (defface completions-annotations '((t :inherit (italic shadow)))
   "Face to use for annotations in the *Completions* buffer.")
 
+(defcustom completions-group-format
+  (concat
+   (propertize "    " 'face 'completions-group-separator)
+   (propertize " %s " 'face 'completions-group-title)
+   (propertize " " 'face 'completions-group-separator
+               'display '(space :align-to right)))
+  "Format string used for the group title."
+  :type '(choice (const :tag "No group titles" nil)
+                 string))
+
+(defface completions-group-title '((t :inherit shadow :slant italic))
+  "Face used for the title text of the candidate group headlines.")
+
+(defface completions-group-separator '((t :inherit shadow :strike-through t))
+  "Face used for the separator lines of the candidate groups.")
+
 (defcustom completions-format 'horizontal
   "Define the appearance and sorting of completions.
 If the value is `vertical', display completions sorted vertically
@@ -1747,11 +1789,17 @@ completions-detailed
   :type 'boolean
   :version "28.1")
 
-(defun completion--insert-strings (strings)
+;; TODO: Split up this function in one function per `completions-format'.
+;; TODO: Add group title support for horizontal and vertical format.
+(defun completion--insert-strings (strings &optional group-fun)
   "Insert a list of STRINGS into the current buffer.
-Uses columns to keep the listing readable but compact.
-It also eliminates runs of equal strings."
+Uses columns to keep the listing readable but compact.  It also
+eliminates runs of equal strings.  GROUP-FUN is a `group-function'
+used for grouping the completion."
   (when (consp strings)
+    ;; Enable grouping only for 'one-column-format
+    (unless (and (eq completions-format 'one-column) completions-group-format)
+      (setq group-fun nil))
     (let* ((length (apply #'max
 			  (mapcar (lambda (s)
 				    (if (consp s)
@@ -1768,6 +1816,7 @@ completion--insert-strings
 		     (max 1 (/ (length strings) 2))))
 	   (colwidth (/ wwidth columns))
            (column 0)
+           (last-title nil)
 	   (rows (/ (length strings) columns))
 	   (row 0)
            (first t)
@@ -1780,6 +1829,12 @@ completion--insert-strings
       ;; The insertion should be "sensible" no matter what choices were made
       ;; for the parameters above.
       (dolist (str strings)
+        ;; Add group titles.
+        (when group-fun
+          (let ((title (funcall group-fun (if (consp str) (car str) str) nil)))
+            (unless (equal title last-title)
+              (insert (format completions-group-format title))
+              (setq last-title title))))
 	(unless (equal laststring str) ; Remove (consecutive) duplicates.
 	  (setq laststring str)
           ;; FIXME: `string-width' doesn't pay attention to
@@ -1825,7 +1880,13 @@ completion--insert-strings
 		  nil))))
             (setq first nil)
             (if (not (consp str))
-                (put-text-property (point) (progn (insert str) (point))
+                (put-text-property (point)
+                                   (progn
+                                     (insert
+                                      (if group-fun
+                                          (funcall group-fun str 'transform)
+                                        str))
+                                     (point))
                                    'mouse-face 'highlight)
               ;; If `str' is a list that has 2 elements,
               ;; then the second element is a suffix annotation.
@@ -1837,7 +1898,13 @@ completion--insert-strings
                   (let ((beg (point))
                         (end (progn (insert prefix) (point))))
                     (put-text-property beg end 'mouse-face nil)))
-                (put-text-property (point) (progn (insert (car str)) (point))
+                (put-text-property (point)
+                                   (progn
+                                     (insert
+                                      (if group-fun
+                                          (funcall group-fun (car str) 'transform)
+                                        (car str)))
+                                     (point))
                                    'mouse-face 'highlight)
                 (let ((beg (point))
                       (end (progn (insert suffix) (point))))
@@ -1923,7 +1990,7 @@ completion-hilit-commonality
         completions)
        base-size))))
 
-(defun display-completion-list (completions &optional common-substring)
+(defun display-completion-list (completions &optional common-substring group-fun)
   "Display the list of completions, COMPLETIONS, using `standard-output'.
 Each element may be just a symbol or string
 or may be a list of two strings to be printed as if concatenated.
@@ -1933,7 +2000,8 @@ display-completion-list
 The actual completion alternatives, as inserted, are given `mouse-face'
 properties of `highlight'.
 At the end, this runs the normal hook `completion-setup-hook'.
-It can find the completion buffer in `standard-output'."
+It can find the completion buffer in `standard-output'.
+GROUP-FUN is a `group-function' used for grouping the completion."
   (declare (advertised-calling-convention (completions) "24.4"))
   (if common-substring
       (setq completions (completion-hilit-commonality
@@ -1946,7 +2014,7 @@ display-completion-list
 	(let ((standard-output (current-buffer))
 	      (completion-setup-hook nil))
           (with-suppressed-warnings ((callargs display-completion-list))
-	    (display-completion-list completions common-substring)))
+	    (display-completion-list completions common-substring group-fun)))
 	(princ (buffer-string)))
 
     (with-current-buffer standard-output
@@ -1954,7 +2022,7 @@ display-completion-list
       (if (null completions)
           (insert "There are no possible completions of what you have typed.")
         (insert "Possible completions are:\n")
-        (completion--insert-strings completions))))
+        (completion--insert-strings completions group-fun))))
 
   (run-hooks 'completion-setup-hook)
   nil)
@@ -2067,6 +2135,8 @@ minibuffer-completion-help
              (aff-fun (or (completion-metadata-get all-md 'affixation-function)
                           (plist-get completion-extra-properties
                                      :affixation-function)))
+             (sort-fun (completion-metadata-get all-md 'display-sort-function))
+             (group-fun (completion-metadata-get all-md 'group-function))
              (mainbuf (current-buffer))
              ;; If the *Completions* buffer is shown in a new
              ;; window, mark it as softly-dedicated, so bury-buffer in
@@ -2098,15 +2168,22 @@ minibuffer-completion-help
                       ;; Remove the base-size tail because `sort' requires a properly
                       ;; nil-terminated list.
                       (when last (setcdr last nil))
-                      (setq completions
-                            ;; FIXME: This function is for the output of all-completions,
-                            ;; not completion-all-completions.  Often it's the same, but
-                            ;; not always.
-                            (let ((sort-fun (completion-metadata-get
-                                             all-md 'display-sort-function)))
-                              (if sort-fun
-                                  (funcall sort-fun completions)
-                                (sort completions 'string-lessp))))
+
+                      ;; Sort first using the `display-sort-function'.
+                      ;; FIXME: This function is for the output of
+                      ;; all-completions, not
+                      ;; completion-all-completions.  Often it's the
+                      ;; same, but not always.
+                      (setq completions (if sort-fun
+                                            (funcall sort-fun completions)
+                                          (sort completions 'string-lessp)))
+
+                      ;; After sorting, group the candidates using the
+                      ;; `group-function'.
+                      (when group-fun
+                        (setq completions
+                              (minibuffer--group-by group-fun completions)))
+
                       (cond
                        (aff-fun
                         (setq completions
@@ -2152,7 +2229,7 @@ minibuffer-completion-help
                                                      (if (eq (car bounds) (length result))
                                                          'exact 'finished)))))))
 
-                      (display-completion-list completions)))))
+                      (display-completion-list completions nil group-fun)))))
           nil)))
     nil))
 
diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el
index e80603f23e..40faf99f20 100644
--- a/lisp/progmodes/xref.el
+++ b/lisp/progmodes/xref.el
@@ -1044,6 +1044,12 @@ xref-show-definitions-buffer-at-bottom
 (define-obsolete-function-alias 'xref--show-defs-buffer-at-bottom
   #'xref-show-definitions-buffer-at-bottom "28.1")
 
+(defun xref--completing-read-group (cand transform)
+  "Return title of candidate CAND or TRANSFORM the candidate."
+  (if transform
+      (substring cand (1+ (next-single-property-change 0 'xref--group cand)))
+    (get-text-property 0 'xref--group cand)))
+
 (defun xref-show-definitions-completing-read (fetcher alist)
   "Let the user choose the target definition with completion.
 
@@ -1072,10 +1078,12 @@ xref-show-definitions-completing-read
                                     (format #("%d:" 0 2 (face xref-line-number))
                                             line)
                                   ""))
+                               (group-prefix
+                                (substring group group-prefix-length))
                                (group-fmt
-                                (propertize
-                                 (substring group group-prefix-length)
-                                 'face 'xref-file-header))
+                                (propertize group-prefix
+                                            'face 'xref-file-header
+                                            'xref--group group-prefix))
                                (candidate
                                 (format "%s:%s%s" group-fmt line-fmt summary)))
                           (push (cons candidate xref) xref-alist-with-line-info)))))
@@ -1087,7 +1095,9 @@ xref-show-definitions-completing-read
                          (lambda (string pred action)
                            (cond
                             ((eq action 'metadata)
-                             '(metadata . ((category . xref-location))))
+                             `(metadata
+                               . ((category . xref-location)
+                                  (group-function . ,#'xref--completing-read-group))))
                             (t
                              (complete-with-action action collection string pred)))))
                         (def (caar collection)))
-- 
2.20.1

Re: [PATCH] `completing-read`: Add `group-function` support to completion metadata

[Dmitry Gutov]

On 25.04.2021 16:32, Daniel Mendler wrote:
> I attached a patch which adds grouping support to the completions 
> buffer. The completion table can specify a `group-function` via its 
> completion metadata.
> 
> Currently groups are only displayed in the *Completions* buffer if 
> `completions-format=one-column`. My proposal is to split up the function 
> `completion--insert-strings` into three functions 
> `completion--insert-strings-one-column/vertical/horizontal` in a 
> follow-up patch. Then the grouping display can also be implemented for 
> the other display formats.
> 
> Group title support is already present in the Vertico, Selectrum and 
> external Icomplete-vertical UI. Similarly we can add support to the 
> recently added `icomplete-vertical-mode` by Gregory.
> 
> There is a patch to `xref.el` included, which makes use of the grouping 
> functionality, when the `completing-read` show function is used:
> 
> (setq xref-show-xrefs-function #'xref-show-definitions-completing-read)

The result looks nice (when enabled), though this function still doesn't 
work very well with the default completing read. So whether this feature 
works okay will depend on the alternative UI used.

I wonder if there can be other examples of group-function usage added 
which work okay with the default completion UI.

Speaking of group-function's implementation there, the text-properties 
approach seems like an overkill since we can reliably string-match 
anyway. But it's a minor thing.

Another minor issue is that the docstring still says "Return title of 
candidate" rather than "group title" or "group name".

Not going to comment on the changes to minibuffer.el, at least for now.

Re: [PATCH] `completing-read`: Add `group-function` support to completion metadata

[Daniel Mendler]

On 4/25/21 9:35 PM, Dmitry Gutov wrote:
> The result looks nice (when enabled), though this function still doesn't 
> work very well with the default completing read. So whether this feature 
> works okay will depend on the alternative UI used.

Dmitry, thank you for looking at the patch!

What do you mean exactly by "it does not work well"? There was an issue 
with `choose-completion` which I just fixed in the revised version of 
the patch, where the command `choose-completion` returned the 
transformed candidate.

> I wonder if there can be other examples of group-function usage added 
> which work okay with the default completion UI.

I am sure we can find more uses. But this functionality is also targeted 
at package authors who want to write commands with an UI enhanced by 
grouping.

> Speaking of group-function's implementation there, the text-properties 
> approach seems like an overkill since we can reliably string-match 
> anyway. But it's a minor thing.

I've chosen the text property approach such that the group title 
retrieval does not lead to allocations (transform=nil). The 
transform=nil call is performance critical for continuously updating UIs 
like Icomplete, Vertico etc., since the candidates are grouped after 
sorting. When displaying the set of candidates in the *Completions* 
buffer or a subset of the candidates in the minibuffer, the allocations 
do not hurt as much.

> Another minor issue is that the docstring still says "Return title of 
> candidate" rather than "group title" or "group name".

Okay, I will change this.

Daniel

Re: [PATCH] `completing-read`: Add `group-function` support to completion metadata

[Dmitry Gutov]

On 25.04.2021 22:47, Daniel Mendler wrote:
> On 4/25/21 9:35 PM, Dmitry Gutov wrote:
>> The result looks nice (when enabled), though this function still 
>> doesn't work very well with the default completing read. So whether 
>> this feature works okay will depend on the alternative UI used.
> 
> Dmitry, thank you for looking at the patch!
> 
> What do you mean exactly by "it does not work well"?

Sorry, I was basically referring to an earlier discussions where the 
consensus was that xref-show-definitions-completiong-read doesn't play 
very well with the default completing-read. Its completion table is odd, 
one could say. The proposed feature simply doesn't change that.

Perhaps if all currently planned uses of group-function are similarly 
"odd" (and no additional uses in the core are going to be added in the 
foreseeable future), you don't need to worry/care about having 
:group-function added to the core, or at least not yet. Or about 
updating the *Completions* UI.

And keep it like "unofficial extension", which I'll be happy to support 
in Xref anyway (and Xref is in ELPA Core, so users will always be able 
to install the latest version). There are benefits to being such 
extension: once you're a proper part of the protocol, you become much 
more set in stone.

>> Speaking of group-function's implementation there, the text-properties 
>> approach seems like an overkill since we can reliably string-match 
>> anyway. But it's a minor thing.
> 
> I've chosen the text property approach such that the group title 
> retrieval does not lead to allocations (transform=nil). The 
> transform=nil call is performance critical for continuously updating UIs 
> like Icomplete, Vertico etc., since the candidates are grouped after 
> sorting.

But when the list is updated, the elements are basically recreated from 
the external process's output every time, right? So this only helps if 
you want to cache the result for repeated invocations of group-function 
on the same result set.

I'd be curious to see some benchmark results for both versions.

Also, xref-find-definitions usually deals with a limited number of 
search results. But I guess some of your users set 
xref-show-xrefs-function to xref-show-definitions-completiong-read too.

Re: [PATCH] `completing-read`: Add `group-function` support to completion metadata

[Daniel Mendler]

On 4/25/21 11:50 PM, Dmitry Gutov wrote:
> Sorry, I was basically referring to an earlier discussions where the 
> consensus was that xref-show-definitions-completiong-read doesn't play 
> very well with the default completing-read. Its completion table is odd, 
> one could say. The proposed feature simply doesn't change that.

I understand. But in which way do you think the function 
`xref-show-definitions-completiong-read` is odd? If you use completion 
styles like `flex` or `orderless` you can quickly narrow down the number 
of candidates and select. It works well for me and the grouping makes 
the view more clear.

> Perhaps if all currently planned uses of group-function are similarly 
> "odd" (and no additional uses in the core are going to be added in the 
> foreseeable future), you don't need to worry/care about having 
> :group-function added to the core, or at least not yet. Or about 
> updating the *Completions* UI.

I assume there are more commands in Emacs where grouping functionality 
is useful. Grouping is heavily used in Helm and in my Consult package, 
so having such functionality officially present in Emacs is certainly 
valuable.

> And keep it like "unofficial extension", which I'll be happy to support 
> in Xref anyway (and Xref is in ELPA Core, so users will always be able 
> to install the latest version). There are benefits to being such 
> extension: once you're a proper part of the protocol, you become much 
> more set in stone.

Yes, this would be the most minimal change - only define 
`group-function` as an official metadata which can then be used by 
commands and UIs which support it. However it would certainly be more 
encouraging to make use of the functionality if thereis support in the 
default completion UI or Icomplete.

>>> Speaking of group-function's implementation there, the 
>>> text-properties approach seems like an overkill since we can reliably 
>>> string-match anyway. But it's a minor thing.
>>
>> I've chosen the text property approach such that the group title 
>> retrieval does not lead to allocations (transform=nil). The 
>> transform=nil call is performance critical for continuously updating 
>> UIs like Icomplete, Vertico etc., since the candidates are grouped 
>> after sorting.
> 
> But when the list is updated, the elements are basically recreated from 
> the external process's output every time, right? So this only helps if 
> you want to cache the result for repeated invocations of group-function 
> on the same result set.

I am not entirely sure I understand you correctly here. The candidate 
set is generated once from the external process. Then the properties are 
attached once per candidate. In the subsequent filtering/completing of 
the candidates, the candidate set and the attached properties are *not* 
regenerated. This means we save a lot of work here. In particular with 
continuously updating UIs we avoid regenerating the properties every key 
press.

> Also, xref-find-definitions usually deals with a limited number of 
> search results. But I guess some of your users set 
> xref-show-xrefs-function to xref-show-definitions-completiong-read too.

Yes, this the use case I proposed. Then you can have many more candidates.

Daniel

Re: [PATCH] `completing-read`: Add `group-function` support to completion metadata

[Dmitry Gutov]

On 26.04.2021 01:10, Daniel Mendler wrote:
> On 4/25/21 11:50 PM, Dmitry Gutov wrote:
>> Sorry, I was basically referring to an earlier discussions where the 
>> consensus was that xref-show-definitions-completiong-read doesn't play 
>> very well with the default completing-read. Its completion table is 
>> odd, one could say. The proposed feature simply doesn't change that.
> 
> I understand. But in which way do you think the function 
> `xref-show-definitions-completiong-read` is odd?

It doesn't work as well with default UI because you don't see the 
options without pressing TAB, and you don't know what to type.

Paraphrasing the words of our maintainer, completion is for when you 
know what to type, just to be able to do it quickly. And (as might be 
summed up from the same recent discussion) what that completion table 
needs is "selection".

So it's better if at least icomplete-mode is enabled, preferably with an 
option which shows the completions right away with no input. And the 
vertical style should be even better.

>> Perhaps if all currently planned uses of group-function are similarly 
>> "odd" (and no additional uses in the core are going to be added in the 
>> foreseeable future), you don't need to worry/care about having 
>> :group-function added to the core, or at least not yet. Or about 
>> updating the *Completions* UI.
> 
> I assume there are more commands in Emacs where grouping functionality 
> is useful. Grouping is heavily used in Helm and in my Consult package, 
> so having such functionality officially present in Emacs is certainly 
> valuable.

Helm and Consult use it mostly for sources which return some sort of 
"matches" from a Grep-like program, right? Lots of matches, none of them 
knowable in advance? Stock Emacs usually uses a buffer for that use case 
(like M-x rgrep).

>> And keep it like "unofficial extension", which I'll be happy to 
>> support in Xref anyway (and Xref is in ELPA Core, so users will always 
>> be able to install the latest version). There are benefits to being 
>> such extension: once you're a proper part of the protocol, you become 
>> much more set in stone.
> 
> Yes, this would be the most minimal change - only define 
> `group-function` as an official metadata which can then be used by 
> commands and UIs which support it. However it would certainly be more 
> encouraging to make use of the functionality if thereis support in the 
> default completion UI or Icomplete.

That's a valid argument too, of course.

>> But when the list is updated, the elements are basically recreated 
>> from the external process's output every time, right? So this only 
>> helps if you want to cache the result for repeated invocations of 
>> group-function on the same result set.
> 
> I am not entirely sure I understand you correctly here. The candidate 
> set is generated once from the external process. Then the properties are 
> attached once per candidate. In the subsequent filtering/completing of 
> the candidates, the candidate set and the attached properties are *not* 
> regenerated. This means we save a lot of work here. In particular with 
> continuously updating UIs we avoid regenerating the properties every key 
> press.

OK, I see. So you fuzzy-match it on the client, if the user types 
further characters to narrow down the search.

Re: [PATCH] `completing-read`: Add `group-function` support to completion metadata

[Daniel Mendler]

On 4/26/21 12:40 AM, Dmitry Gutov wrote:
> So it's better if at least icomplete-mode is enabled, preferably with an 
> option which shows the completions right away with no input. And the 
> vertical style should be even better.

I agree that Icomplete/Vertico/Ivy works better if you are selecting 
instead of completing. However if an extension like `group-function` is 
made to the completion metadata it should also be available by the 
default completion UI.

> Helm and Consult use it mostly for sources which return some sort of 
> "matches" from a Grep-like program, right? Lots of matches, none of them 
> knowable in advance? Stock Emacs usually uses a buffer for that use case 
> (like M-x rgrep).

No, Consult also offers commands, where you can know the matches in 
advance. For example I have these commands, which should satisfy your 
criterion:

* consult-org-agenda: Select headline (Grouped by file name)
* consult-imenu: Select imenu item (Grouped by type, function, variable etc)
* consult-buffer: Switch to recent files, buffers, bookmarks
* consult-mode-command: Invoke command associated with the current mode 
(Grouped in local/global minor-mode and major-mode)
* consult-minor-mode-menu: Toggle minor modes by name (Grouped by on/off 
local/global)

There are more commands which may fall more into the search category 
where you don't know exactly what you are looking for.

Note that there are also users who implemented small extensions for the 
default completion UI, e.g., such that the *Completions* buffers appears 
after a delay and a few characters of input. I believe Protesilaos 
Stavrou is doing that. For such UIs the *Completions* buffer is as fully 
capable as one of the aforementioned vertical minibuffer UIs.

Daniel

Re: [PATCH] `completing-read`: Add `group-function` support to completion metadata

[Protesilaos Stavrou]

[-- Attachment #1: Type: text/plain, Size: 2936 bytes --]

On 2021-04-26, 00:58 +0200, Daniel Mendler <mail@daniel-mendler.de> wrote:

> Note that there are also users who implemented small extensions for the
> default completion UI, e.g., such that the *Completions* buffers appears
> after a delay and a few characters of input. I believe Protesilaos
> Stavrou is doing that. For such UIs the *Completions* buffer is as fully
> capable as one of the aforementioned vertical minibuffer UIs.

Hello!  Just to comment on this point: yes, I am using the standard
Completions' buffer and the default minibuffer in a way that looks like
other vertical completion UIs.  I do it mostly as an exercise in Elisp,
so the code itself is not really worthy of consideration here, plus I
still need to make it a minor mode that could be reproduced elsewhere.

In outline:

+ The Completions' buffer is (setq completions-format 'one-column).

+ The display-buffer-alist controls the placement of the Completions'
  buffer so that (i) it appears in a bottom side window, and (ii) it
  hides its mode line.  This makes the minibuffer and the Completions
  look like parts of the same contiguous space.

+ There are commands for moving up and down which cycle from the
  minibuffer to the Completions' one.  Because those two look like they
  are part of the same area, the cycling feels natural: just go up/down.

+ There is a live-updating snippet that pops-up the Completions' buffer
  automatically and then updates it to match user input.  There also are
  minimum character and delay thresholds, a blocklist and a passlist for
  commands that should not or should always live update.  Those are all
  configurable.

+ The Completions' buffer normally has some helper text at the top.  It
  is removed to keep only completion candidates.

+ The hl-line-mode provides the familiar "current line here" which helps
  with cycling.  Its face is remapped for the Completions' buffer so
  that it is better suited for this particular task.

+ Same principle for display-line-numbers-mode.

+ Another command lets you pass a prefix argument to pick the Nth
  candidate in the Completions' buffer.  The implementation is not
  great, but the idea works.  It can be called from either the
  minibuffer or the Completions.

+ While in the Completions' buffer and while using a prompt of
  completing-read-multiple, another command can be used to append the
  candidate at point to the minibuffer, insert the crm-separator, and go
  back to the Completions' buffer.

The overall experience is good to the point where I do not miss other
interactive UIs.  And I feel that it could be improved further though I
am not there yet skills-wise.

I also use other packages, like Orderless[1] and Marginalia[2].

[1]: <https://github.com/oantolin/orderless>.
[2]: <https://github.com/minad/marginalia>.

I attach a screenshot, though I understand this does not say that much.

-- 
Protesilaos Stavrou
https://protesilaos.com


[-- Attachment #2: Screenshot from 2021-04-26 07-49-55.png --]
[-- Type: image/png, Size: 116906 bytes --]

Re: [PATCH] `completing-read`: Add `group-function` support to completion metadata

[Juri Linkov]

> In outline:
>
> + The Completions' buffer is (setq completions-format 'one-column).
> [...]
>
> The overall experience is good to the point where I do not miss other
> interactive UIs.  And I feel that it could be improved further though I
> am not there yet skills-wise.

Thanks for sharing your settings.  Such UI using the default Completions buffer
is long awaited.  Recently we tried to do something similar with a new mode
zcomplete-mode.  But it would be better to implement most enhancements
in minibuffer.el where additional features could be enabled with new options.
Then zcomplete-mode could just enable these options, like e.g. recently added
icomplete-vertical-mode tweaks icomplete options to build new UI.

> I attach a screenshot, though I understand this does not say that much.

Looks nice.  One thing is unclear: the format of buffers is like
in the output of 'C-x C-b' (list-buffers) that uses tabulated-list
to print buffer information.  Are these buffers in the Completions buffer
formatted with tabulated-list as well?

Re: [PATCH] `completing-read`: Add `group-function` support to completion metadata

[Protesilaos Stavrou]

[-- Attachment #1: Type: text/plain, Size: 2326 bytes --]

On 2021-04-27, 19:53 +0300, Juri Linkov <juri@linkov.net> wrote:

>> In outline:
>>
>> + The Completions' buffer is (setq completions-format 'one-column).
>> [...]
>>
>> The overall experience is good to the point where I do not miss other
>> interactive UIs.  And I feel that it could be improved further though I
>> am not there yet skills-wise.
>
> Thanks for sharing your settings.  Such UI using the default Completions buffer
> is long awaited.  Recently we tried to do something similar with a new mode
> zcomplete-mode.  But it would be better to implement most enhancements
> in minibuffer.el where additional features could be enabled with new options.
> Then zcomplete-mode could just enable these options, like e.g. recently added
> icomplete-vertical-mode tweaks icomplete options to build new UI.

I think those issues are best decided by you and/or the other
maintainers.

To facilitate this exchange, I attach a shortened version of my
extensions without requiring any external libraries (what I wrote before
stands---you are welcome to improve upon it if you want, as I still have
a lot to learn).

Put those in the scratch buffer of emacs -Q, 'M-x eval-buffer' and then
try 'C-h v RET mini' to get an idea of how it works (I implement a
minimum input threshold).

I also attach the original file, prot-minibuffer.el, and here is the
section with my configurations for it:
<https://protesilaos.com/dotemacs/#h:c110e399-3f43-4555-8427-b1afe44c0779>.

If something is unclear, please let me know.

[ I just noticed a bug in my code when (setq completions-detailed t)
  where prot-minibuffer-previous-completion-or-mini does not do what it is
  supposed to---will fix it later. ]

>> I attach a screenshot, though I understand this does not say that much.
>
> Looks nice.  One thing is unclear: the format of buffers is like
> in the output of 'C-x C-b' (list-buffers) that uses tabulated-list
> to print buffer information.  Are these buffers in the Completions buffer
> formatted with tabulated-list as well?

That is done by the Marginalia library, which I think is a nice extra:
<https://github.com/minad/marginalia/>.  No, the mode does not change to
tabulated-list.  Daniel Mendler (in cc) is one of its maintainers and
can elaborate on the technicalities.

-- 
Protesilaos Stavrou
https://protesilaos.com

[-- Attachment #2: 2021-04-28-emacs-Q-prot-minibuffer-excerpt.el --]
[-- Type: text/plain, Size: 20939 bytes --]

;; This buffer is for text that is not saved, and for Lisp evaluation.
;; To create a file, visit it with C-x C-f and enter text in its buffer.


;;; Excerpt of my configurations

(add-to-list 'display-buffer-alist
             '("\\*\\(Embark\\)?.*Completions.*"
               (display-buffer-in-side-window)
               (side . bottom)
               (slot . 0)
               (window-parameters . ((no-other-window . t)
                                     (mode-line-format . none)))))

(setq completion-show-help nil)
(setq completion-auto-help t)
(setq completions-format 'one-column)
(setq completions-detailed nil)
(file-name-shadow-mode 1)


(setq prot-minibuffer-remove-shadowed-file-names t)
(setq prot-minibuffer-minimum-input 3)
(setq prot-minibuffer-live-update-delay 0.3)
;; ;; NOTE: `prot-minibuffer-completion-blocklist' can be used for
;; ;; commands with lots of candidates, depending also on how low
;; ;; `prot-minibuffer-minimum-input' is.  With my current settings,
;; ;; this is not required, otherwise I would use this list:
;;
;; '( describe-symbol describe-function
;;    describe-variable execute-extended-command
;;    insert-char)
(setq prot-minibuffer-completion-blocklist nil)
(setq prot-minibuffer-completion-passlist nil)

;; This is for commands that should always pop up the completions'
;; buffer.  It circumvents the default method of waiting for some user
;; input before displaying and updating the completions' buffer.
(setq prot-minibuffer-completion-passlist nil)

(define-key global-map (kbd "s-v") #'prot-minibuffer-focus-mini-or-completions)
(let ((map completion-list-mode-map))
  (define-key map (kbd "M-v") #'prot-minibuffer-focus-minibuffer)
  (define-key map (kbd "C-g") #'prot-minibuffer-keyboard-quit-dwim)
  (define-key map (kbd "C-n") #'prot-minibuffer-next-completion-or-mini)
  (define-key map (kbd "<down>") #'prot-minibuffer-next-completion-or-mini)
  (define-key map (kbd "C-p") #'prot-minibuffer-previous-completion-or-mini)
  (define-key map (kbd "<up>") #'prot-minibuffer-previous-completion-or-mini)
  (define-key map (kbd "<return>") #'prot-minibuffer-choose-completion-exit)
  (define-key map (kbd "<M-return>") #'prot-minibuffer-choose-completion-dwim))
(let ((map minibuffer-local-completion-map))
  (define-key map (kbd "M-g") #'prot-minibuffer-choose-completion-number)
  (define-key map (kbd "C-n") #'prot-minibuffer-switch-to-completions-top)
  (define-key map (kbd "<down>") #'prot-minibuffer-switch-to-completions-top)
  (define-key map (kbd "C-p") #'prot-minibuffer-switch-to-completions-bottom)
  (define-key map (kbd "<up>") #'prot-minibuffer-switch-to-completions-bottom)
  (define-key map (kbd "C-l") #'prot-minibuffer-toggle-completions))

(add-hook 'completion-list-mode-hook #'prot-minibuffer-hl-line)
(add-hook 'completion-list-mode-hook #'prot-minibuffer-display-line-numbers)



;;; Excerpt of prot-minibuffer.el

(defcustom prot-minibuffer-completion-windows-regexp
  "\\*\\(Completions\\|Embark Collect \\(Live\\|Completions\\)\\)"
  "Regexp to match window names with completion candidates.
Used by `prot-minibuffer--get-completion-window'."
  :group 'prot-minibuffer
  :type 'string)

(defcustom prot-minibuffer-remove-shadowed-file-names nil
  "Delete shadowed parts of file names.

For example, if the user types ~/ after a long path name,
everything preceding the ~/ is removed so the interactive
selection process starts again from the user's $HOME.

Only works when variable `file-name-shadow-mode' is non-nil."
  :type 'boolean
  :group 'prot-minibuffer)

(defcustom prot-minibuffer-minimum-input 3
  "Live update completions when input is >= N.

Setting this to a value greater than 1 can help reduce the total
number of candidates that are being computed."
  :type 'integer
  :group 'prot-minibuffer)

(defcustom prot-minibuffer-live-update-delay 0.3
  "Delay in seconds before updating the Completions' buffer.

Set this to 0 to disable the delay."
  :type 'number
  :group 'prot-minibuffer)

(defcustom prot-minibuffer-completion-blocklist nil
  "Commands that do not do live updating of completions.

A less drastic measure is to set `prot-minibuffer-minimum-input'
to an appropriate value.

The Completions' buffer can still be accessed with commands that
put it in a window (e.g. `prot-minibuffer-toggle-completions',
`prot-minibuffer-switch-to-completions-top')."
  :type '(repeat symbol)
  :group 'prot-minibuffer)

(defcustom prot-minibuffer-completion-passlist nil
  "Commands that do live updating of completions from the start.

This means that they ignore `prot-minibuffer-minimum-input' and
the inherent constraint of updating the Completions' buffer only
upon user input.  Furthermore, they also bypass any possible
delay introduced by `prot-minibuffer-live-update-delay'."
  :type '(repeat symbol)
  :group 'prot-minibuffer)



;; Thanks to Omar Antolín Camarena for providing the messageless and
;; stealthily.  Source: <https://github.com/oantolin/emacs-config>.
(defun prot-minibuffer--messageless (fn &rest args)
  "Set `minibuffer-message-timeout' to 0.
Meant as advice around minibuffer completion FN with ARGS."
  (let ((minibuffer-message-timeout 0))
    (apply fn args)))

(dolist (fn '(exit-minibuffer
              choose-completion
              minibuffer-force-complete
              minibuffer-complete-and-exit
              minibuffer-force-complete-and-exit))
  (advice-add fn :around #'prot-minibuffer--messageless))

;; Copied from Daniel Mendler's `vertico' library:
;; <https://github.com/minad/vertico>.
(defun prot-minibuffer--crm-indicator (args)
  "Add prompt indicator to `completing-read-multiple' filter ARGS."
  (cons (concat "[CRM] " (car args)) (cdr args)))

(advice-add #'completing-read-multiple :filter-args #'prot-minibuffer--crm-indicator)

;; Adapted from Omar Antolín Camarena's live-completions library:
;; <https://github.com/oantolin/live-completions>.
(defun prot-minibuffer--honor-inhibit-message (fn &rest args)
  "Skip applying FN to ARGS if `inhibit-message' is t.
Meant as `:around' advice for `minibuffer-message', which does
not honor minibuffer message."
  (unless inhibit-message
    (apply fn args)))

(advice-add #'minibuffer-message :around #'prot-minibuffer--honor-inhibit-message)

;; Note that this solves bug#45686 and is only considered a temporary
;; measure: <https://debbugs.gnu.org/cgi/bugreport.cgi?bug=45686>
(defun prot-minibuffer--stealthily (fn &rest args)
  "Prevent minibuffer default from counting as a modification.
Meant as advice for FN `minibuf-eldef-setup-minibuffer' with rest
ARGS."
  (let ((inhibit-modification-hooks t))
    (apply fn args)))

(advice-add 'minibuf-eldef-setup-minibuffer :around #'prot-minibuffer--stealthily)



;; Copied from icomplete.el
(defun prot-minibuffer--field-beg ()
  "Determine beginning of completion."
  (if (window-minibuffer-p)
      (minibuffer-prompt-end)
    (nth 0 completion-in-region--data)))

;; Copied from icomplete.el
(defun prot-minibuffer--field-end ()
  "Determine end of completion."
  (if (window-minibuffer-p)
      (point-max)
    (nth 1 completion-in-region--data)))

;; Copied from icomplete.el
(defun prot-minibuffer--completion-category ()
  "Return completion category."
  (let* ((beg (prot-minibuffer--field-beg))
         (md (completion--field-metadata beg)))
    (alist-get 'category (cdr md))))

;; Adapted from icomplete.el
(defun prot-minibuffer--shadow-filenames (&rest _)
  "Hide shadowed file names."
  (let ((saved-point (point)))
    (when (and
           prot-minibuffer-remove-shadowed-file-names
           (eq (prot-minibuffer--completion-category) 'file)
           rfn-eshadow-overlay (overlay-buffer rfn-eshadow-overlay)
           (eq this-command 'self-insert-command)
           (= saved-point (prot-minibuffer--field-end))
           (or (>= (- (point) (overlay-end rfn-eshadow-overlay)) 2)
               (eq ?/ (char-before (- (point) 2)))))
      (delete-region (overlay-start rfn-eshadow-overlay)
                     (overlay-end rfn-eshadow-overlay)))))

(defun prot-minibuffer--setup-shadow-files ()
  "Set up shadowed file name deletion.
To be assigned to `minibuffer-setup-hook'."
  (add-hook 'after-change-functions #'prot-minibuffer--shadow-filenames nil t))

(add-hook 'minibuffer-setup-hook #'prot-minibuffer--setup-shadow-files)

;;;###autoload
(defun prot-minibuffer-focus-minibuffer ()
  "Focus the active minibuffer."
  (interactive)
  (let ((mini (active-minibuffer-window)))
    (when mini
      (select-window mini))))

(defun prot-minibuffer--get-completion-window ()
  "Find a live window showing completion candidates."
  (get-window-with-predicate
   (lambda (window)
     (string-match-p
      prot-minibuffer-completion-windows-regexp
      (format "%s" window)))))

(defun prot-minibuffer-focus-mini-or-completions ()
  "Focus the active minibuffer or the completions' window.

If both the minibuffer and the Completions are present, this
command will first move per invocation to the former, then the
latter, and then continue to switch between the two.

The continuous switch is essentially the same as running
`prot-minibuffer-focus-minibuffer' and `switch-to-completions' in
succession.

What constitutes a completions' window is ultimately determined
by `prot-minibuffer-completion-windows-regexp'."
  (interactive)
  (let* ((mini (active-minibuffer-window))
         (completions (prot-minibuffer--get-completion-window)))
    (cond
     ((and mini (not (minibufferp)))
      (select-window mini nil))
     ((and completions (not (eq (selected-window) completions)))
      (select-window completions nil)))))


(defface prot-minibuffer-hl-line
  '((default :extend t)
    (((class color) (min-colors 88) (background light))
     :background "#b0d8ff" :foreground "#000000")
    (((class color) (min-colors 88) (background dark))
     :background "#103265" :foreground "#ffffff")
    (t :inherit (font-lock-string-face elfeed-search-title-face)))
  "Face for current line in the completions' buffer."
  :group 'prot-minibuffer)

(defface prot-minibuffer-line-number
  '((default :inherit default)
    (((class color) (min-colors 88) (background light))
     :background "#f2eff3" :foreground "#252525")
    (((class color) (min-colors 88) (background dark))
     :background "#151823" :foreground "#dddddd")
    (t :inverse-video t))
  "Face for line numbers in the completions' buffer."
  :group 'prot-minibuffer)

(defface prot-minibuffer-line-number-current-line
  '((default :inherit default)
    (((class color) (min-colors 88) (background light))
     :background "#8ac7ff" :foreground "#000000")
    (((class color) (min-colors 88) (background dark))
     :background "#142a79" :foreground "#ffffff")
    (t :inverse-video t))
  "Face for current line number in the completions' buffer."
  :group 'prot-minibuffer)

(autoload 'display-line-numbers-mode "display-line-numbers")
(autoload 'face-remap-remove-relative "face-remap")

;;;###autoload
(defun prot-minibuffer-display-line-numbers ()
  "Set up line numbers for the completions' buffer.
Add this to `completion-list-mode-hook'."
  (when (derived-mode-p 'completion-list-mode)
    (face-remap-add-relative 'line-number 'prot-minibuffer-line-number)
    (face-remap-add-relative 'line-number-current-line
                             'prot-minibuffer-line-number-current-line)
    (display-line-numbers-mode 1)))

;;;###autoload
(defun prot-minibuffer-hl-line ()
  "Set up line highlighting for the completions' buffer.
Add this to `completion-list-mode-hook'."
  (when (derived-mode-p 'completion-list-mode)
    (face-remap-add-relative 'hl-line 'prot-minibuffer-hl-line)
    (hl-line-mode 1)))


;; Thanks to Omar Antolín Camarena for recommending the use of
;; `cursor-sensor-functions' and the concomitant hook with
;; `cursor-censor-mode' instead of the dirty hacks I had before to
;; prevent the cursor from moving to that position where no completion
;; candidates could be found at point (e.g. it would break `embark-act'
;; as it could not read the topmost candidate when point was at the
;; beginning of the line, unless the point was moved forward).
(defun prot-minibuffer--clean-completions ()
  "Keep only completion candidates in the Completions."
  (with-current-buffer standard-output
    (let ((inhibit-read-only t))
      (goto-char (point-min))
      (delete-region (point-at-bol) (1+ (point-at-eol)))
      (insert (propertize " "
                          'cursor-sensor-functions
                          (list
                           (lambda (_win prev dir)
                             (when (eq dir 'entered)
                               (goto-char prev))))))
      (put-text-property (point-min) (point) 'invisible t))))

(add-hook 'completion-list-mode-hook #'cursor-sensor-mode)
(add-hook 'completion-setup-hook #'prot-minibuffer--clean-completions)

(defun prot-minibuffer--fit-completions-window ()
  "Fit Completions' buffer to its window."
  (fit-window-to-buffer (get-buffer-window "*Completions*")
                        (floor (frame-height) 2) 1))

(defun prot-minibuffer--input-string ()
  "Return the contents of the minibuffer as a string."
  (buffer-substring-no-properties (minibuffer-prompt-end) (point-max)))

(defun prot-minibuffer--minimum-input ()
  "Test for minimum requisite input for live completions."
  (>= (length (prot-minibuffer--input-string)) prot-minibuffer-minimum-input))

;; Adapted from Omar Antolín Camarena's live-completions library:
;; <https://github.com/oantolin/live-completions>.
(defun prot-minibuffer--live-completions (&rest _)
  "Update the *Completions* buffer.
Meant to be added to `after-change-functions'."
  (when (minibufferp) ; skip if we've exited already
    (let ((while-no-input-ignore-events '(selection-request)))
      (while-no-input
        (if (prot-minibuffer--minimum-input)
            (condition-case nil
                (save-match-data
                  (save-excursion
                    (goto-char (point-max))
                    (let ((inhibit-message t)
                          ;; don't ring the bell in `minibuffer-completion-help'
                          ;; when <= 1 completion exists.
                          (ring-bell-function #'ignore))
                      (minibuffer-completion-help)
                      (prot-minibuffer--fit-completions-window))))
              (quit (abort-recursive-edit)))
          (minibuffer-hide-completions))))))

(defun prot-minibuffer--live-completions-timer (&rest _)
  "Update Completions with `prot-minibuffer-live-update-delay'."
  (let ((delay prot-minibuffer-live-update-delay))
    (when (>= delay 0)
      (run-with-idle-timer delay nil #'prot-minibuffer--live-completions))))

(defun prot-minibuffer--setup-completions ()
  "Set up the completions buffer."
  (cond
   ((member this-command prot-minibuffer-completion-passlist)
    (minibuffer-completion-help)
    (add-hook 'after-change-functions #'prot-minibuffer--live-completions nil t))
   ((unless (member this-command prot-minibuffer-completion-blocklist)
    (add-hook 'after-change-functions #'prot-minibuffer--live-completions-timer nil t)))))

(add-hook 'minibuffer-setup-hook #'prot-minibuffer--setup-completions)

;;;###autoload
(defun prot-minibuffer-toggle-completions ()
  "Toggle the presentation of the completions' buffer."
  (interactive)
  (if (get-buffer-window "*Completions*" 0)
      (minibuffer-hide-completions)
    (minibuffer-completion-help)))

;;;###autoload
(defun prot-minibuffer-keyboard-quit-dwim ()
  "Control the exit behaviour for completions' buffers.

If in a completions' buffer and unless the region is active, run
`abort-recursive-edit'.  Otherwise run `keyboard-quit'.

If the region is active, deactivate it.  A second invocation of
this command is then required to abort the session."
  (interactive)
  (when (derived-mode-p 'completion-list-mode)
    (if (use-region-p)
        (keyboard-quit)
      (abort-recursive-edit))))

(defun prot-minibuffer--switch-to-completions ()
  "Subroutine for switching to the completions' buffer."
  (unless (get-buffer-window "*Completions*" 0)
    (minibuffer-completion-help))
  (switch-to-completions)
  (prot-minibuffer--fit-completions-window))

;;;###autoload
(defun prot-minibuffer-switch-to-completions-top ()
  "Switch to the top of the completions' buffer.
Meant to be bound in `minibuffer-local-completion-map'."
  (interactive)
  (prot-minibuffer--switch-to-completions)
  (goto-char (point-min))
  (next-completion 1))

;;;###autoload
(defun prot-minibuffer-switch-to-completions-bottom ()
  "Switch to the bottom of the completions' buffer.
Meant to be bound in `minibuffer-local-completion-map'."
  (interactive)
  (prot-minibuffer--switch-to-completions)
  (goto-char (point-max))
  (next-completion -1)
  (goto-char (point-at-bol))
  (recenter
   (- -1
      (min (max 0 scroll-margin)
           (truncate (/ (window-body-height) 4.0))))
      t))

;;;###autoload
(defun prot-minibuffer-next-completion-or-mini (&optional arg)
  "Move to the next completion or switch to the minibuffer.
This performs a regular motion for optional ARG lines, but when
point can no longer move in that direction it switches to the
minibuffer."
  (interactive "p")
  (if (or (eobp)
          (eq (point-max)
              (save-excursion (forward-line 1) (point))))
      (prot-minibuffer-focus-minibuffer)
    (next-completion (or arg 1)))
  (setq this-command 'next-line))

;;;###autoload
(defun prot-minibuffer-previous-completion-or-mini (&optional arg)
  "Move to the next completion or switch to the minibuffer.
This performs a regular motion for optional ARG lines, but when
point can no longer move in that direction it switches to the
minibuffer."
  (interactive "p")
  (let ((num (* -1 arg)))
    (if (or (bobp)
            (eq (point) (1+ (point-min)))) ; see hack in `prot-minibuffer--clean-completions'
        (prot-minibuffer-focus-minibuffer)
      (next-completion (or num 1)))))

;;;###autoload
(defun prot-minibuffer-choose-completion-exit ()
  "Run `choose-completion' in the Completions buffer and exit."
  (interactive)
  (when (and (derived-mode-p 'completion-list-mode)
             (active-minibuffer-window))
    (choose-completion)
    (minibuffer-force-complete-and-exit)))

(defun prot-minibuffer--goto-line (n &optional args)
  "Go to line N in the Completions' with optional ARGS."
  (let ((bounds (count-lines (point-min) (point-max))))
    (if (<= n bounds)
        (progn
          `(,@args)
          (goto-char (point-min))
          (forward-line (1- n))
          (choose-completion))
      (user-error "%d is not within Completions' buffer bounds (%d)" n bounds))))

;;;###autoload
(defun prot-minibuffer-choose-completion-number (n)
  "Select completion candidate on line number N with prefix arg.

The idea is to pass a prefix numeric argument that refers to a
line number in the Completions' buffer."
  (interactive "p")
  (if current-prefix-arg
      (cond
       ((and (derived-mode-p 'completion-list-mode)
             (active-minibuffer-window))
        (prot-minibuffer--goto-line n))
       ((and (minibufferp)
             (prot-minibuffer--get-completion-window))
        (prot-minibuffer--goto-line n (select-window (prot-minibuffer--get-completion-window))))
       (t
        (user-error "Only use this inside the minibuffer of the Completions")))
    (user-error "Pass a numeric argument first")))

(defvar crm-completion-table)

;;;###autoload
(defun prot-minibuffer-choose-completion-dwim ()
  "Append to minibuffer when at `completing-read-multiple' prompt.
Otherwise behave like `prot-minibuffer-choose-completion-exit'."
  (interactive)
  (when (and (derived-mode-p 'completion-list-mode)
             (active-minibuffer-window))
    (choose-completion)
    (with-current-buffer (window-buffer (active-minibuffer-window))
      (unless (eq (prot-minibuffer--completion-category) 'file)
        (minibuffer-force-complete))
      (when crm-completion-table
        ;; FIXME 2021-04-02: assumes the `crm-separator' as constant.
        ;; UPDATE 2021-04-22: actually `crm-default-separator' is a
        ;; defconst, so I am leaving this here just in case I ever need
        ;; it.  We will have a problem if some command let-binds its own
        ;; value, but it is not our fault here...
        (insert ",")
        (let ((inhibit-message t))
          (switch-to-completions))))))


[-- Attachment #3: prot-minibuffer.el --]
[-- Type: text/plain, Size: 26406 bytes --]

;;; prot-minibuffer.el --- Extensions for the minibuffer -*- lexical-binding: t -*-

;; Copyright (C) 2020-2021  Protesilaos Stavrou

;; Author: Protesilaos Stavrou <info@protesilaos.com>
;; URL: https://protesilaos.com/dotemacs
;; Version: 0.1.0
;; Package-Requires: ((emacs "28.1"))

;; This file is NOT part of GNU Emacs.

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or (at
;; your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <https://www.gnu.org/licenses/>.

;;; Commentary:
;;
;; Extensions for the minibuffer, intended for my Emacs setup:
;; <https://protesilaos.com/dotemacs/>.
;;
;; Remember that every piece of Elisp that I write is for my own
;; educational and recreational purposes.  I am not a programmer and I
;; do not recommend that you copy any of this if you are not certain of
;; what it does.

;;; Code:

;;;; General utilities

(require 'prot-common)

(defgroup prot-minibuffer ()
  "Extensions for the minibuffer."
  :group 'minibuffer)

(defcustom prot-minibuffer-completion-windows-regexp
  "\\*\\(Completions\\|Embark Collect \\(Live\\|Completions\\)\\)"
  "Regexp to match window names with completion candidates.
Used by `prot-minibuffer--get-completion-window'."
  :group 'prot-minibuffer
  :type 'string)

(defcustom prot-minibuffer-mini-cursors nil
  "Allow `cursor-type' to be modified in the minibuffer.
Refer to the source of `prot-minibuffer-mini-cursor' and
`prot-minibuffer-completions-cursor'"
  :group 'prot-minibuffer
  :type 'boolean)

(defcustom prot-minibuffer-remove-shadowed-file-names nil
  "Delete shadowed parts of file names.

For example, if the user types ~/ after a long path name,
everything preceding the ~/ is removed so the interactive
selection process starts again from the user's $HOME.

Only works when variable `file-name-shadow-mode' is non-nil."
  :type 'boolean
  :group 'prot-minibuffer)

(defcustom prot-minibuffer-minimum-input 3
  "Live update completions when input is >= N.

Setting this to a value greater than 1 can help reduce the total
number of candidates that are being computed."
  :type 'integer
  :group 'prot-minibuffer)

(defcustom prot-minibuffer-live-update-delay 0.3
  "Delay in seconds before updating the Completions' buffer.

Set this to 0 to disable the delay."
  :type 'number
  :group 'prot-minibuffer)

(defcustom prot-minibuffer-completion-blocklist nil
  "Commands that do not do live updating of completions.

A less drastic measure is to set `prot-minibuffer-minimum-input'
to an appropriate value.

The Completions' buffer can still be accessed with commands that
put it in a window (e.g. `prot-minibuffer-toggle-completions',
`prot-minibuffer-switch-to-completions-top')."
  :type '(repeat symbol)
  :group 'prot-minibuffer)

(defcustom prot-minibuffer-completion-passlist nil
  "Commands that do live updating of completions from the start.

This means that they ignore `prot-minibuffer-minimum-input' and
the inherent constraint of updating the Completions' buffer only
upon user input.  Furthermore, they also bypass any possible
delay introduced by `prot-minibuffer-live-update-delay'."
  :type '(repeat symbol)
  :group 'prot-minibuffer)

;;;; Minibuffer behaviour

;; Thanks to Omar Antolín Camarena for providing the messageless and
;; stealthily.  Source: <https://github.com/oantolin/emacs-config>.
(defun prot-minibuffer--messageless (fn &rest args)
  "Set `minibuffer-message-timeout' to 0.
Meant as advice around minibuffer completion FN with ARGS."
  (let ((minibuffer-message-timeout 0))
    (apply fn args)))

(dolist (fn '(exit-minibuffer
              choose-completion
              minibuffer-force-complete
              minibuffer-complete-and-exit
              minibuffer-force-complete-and-exit))
  (advice-add fn :around #'prot-minibuffer--messageless))

;; Copied from Daniel Mendler's `vertico' library:
;; <https://github.com/minad/vertico>.
(defun prot-minibuffer--crm-indicator (args)
  "Add prompt indicator to `completing-read-multiple' filter ARGS."
  (cons (concat "[CRM] " (car args)) (cdr args)))

(advice-add #'completing-read-multiple :filter-args #'prot-minibuffer--crm-indicator)

;; Adapted from Omar Antolín Camarena's live-completions library:
;; <https://github.com/oantolin/live-completions>.
(defun prot-minibuffer--honor-inhibit-message (fn &rest args)
  "Skip applying FN to ARGS if `inhibit-message' is t.
Meant as `:around' advice for `minibuffer-message', which does
not honor minibuffer message."
  (unless inhibit-message
    (apply fn args)))

(advice-add #'minibuffer-message :around #'prot-minibuffer--honor-inhibit-message)

;; Note that this solves bug#45686 and is only considered a temporary
;; measure: <https://debbugs.gnu.org/cgi/bugreport.cgi?bug=45686>
(defun prot-minibuffer--stealthily (fn &rest args)
  "Prevent minibuffer default from counting as a modification.
Meant as advice for FN `minibuf-eldef-setup-minibuffer' with rest
ARGS."
  (let ((inhibit-modification-hooks t))
    (apply fn args)))

(advice-add 'minibuf-eldef-setup-minibuffer :around #'prot-minibuffer--stealthily)

;; Copied from icomplete.el
(defun prot-minibuffer--field-beg ()
  "Determine beginning of completion."
  (if (window-minibuffer-p)
      (minibuffer-prompt-end)
    (nth 0 completion-in-region--data)))

;; Copied from icomplete.el
(defun prot-minibuffer--field-end ()
  "Determine end of completion."
  (if (window-minibuffer-p)
      (point-max)
    (nth 1 completion-in-region--data)))

;; Copied from icomplete.el
(defun prot-minibuffer--completion-category ()
  "Return completion category."
  (let* ((beg (prot-minibuffer--field-beg))
         (md (completion--field-metadata beg)))
    (alist-get 'category (cdr md))))

;; Adapted from icomplete.el
(defun prot-minibuffer--shadow-filenames (&rest _)
  "Hide shadowed file names."
  (let ((saved-point (point)))
    (when (and
           prot-minibuffer-remove-shadowed-file-names
           (eq (prot-minibuffer--completion-category) 'file)
           rfn-eshadow-overlay (overlay-buffer rfn-eshadow-overlay)
           (eq this-command 'self-insert-command)
           (= saved-point (prot-minibuffer--field-end))
           (or (>= (- (point) (overlay-end rfn-eshadow-overlay)) 2)
               (eq ?/ (char-before (- (point) 2)))))
      (delete-region (overlay-start rfn-eshadow-overlay)
                     (overlay-end rfn-eshadow-overlay)))))

(defun prot-minibuffer--setup-shadow-files ()
  "Set up shadowed file name deletion.
To be assigned to `minibuffer-setup-hook'."
  (add-hook 'after-change-functions #'prot-minibuffer--shadow-filenames nil t))

(add-hook 'minibuffer-setup-hook #'prot-minibuffer--setup-shadow-files)

;;;; Cursor appearance

(defun prot-minibuffer--cursor-type ()
  "Determine whether `cursor-type' is a list and return value.
If it is a list, this actually returns its car."
  (if (listp cursor-type)
      (car cursor-type)
    cursor-type))

;;;###autoload
(defun prot-minibuffer-mini-cursor ()
  "Local value of `cursor-type' for `minibuffer-setup-hook'."
  (when prot-minibuffer-mini-cursors
    (pcase (prot-minibuffer--cursor-type)
      ('hbar (setq-local cursor-type '(hbar . 8)))
      ('bar (setq-local cursor-type '(hbar . 3)))
      (_  (setq-local cursor-type '(bar . 2))))))

;;;###autoload
(defun prot-minibuffer-completions-cursor ()
  "Local value of `cursor-type' for `completion-list-mode-hook'."
  (when prot-minibuffer-mini-cursors
    (pcase (prot-minibuffer--cursor-type)
      ('hbar (setq-local cursor-type 'box))
      ('bar (setq-local cursor-type '(hbar . 8)))
      (_  (setq-local cursor-type '(bar . 3))))))

;;;; Basic minibuffer interactions

;;;###autoload
(defun prot-minibuffer-focus-minibuffer ()
  "Focus the active minibuffer."
  (interactive)
  (let ((mini (active-minibuffer-window)))
    (when mini
      (select-window mini))))

(defun prot-minibuffer--get-completion-window ()
  "Find a live window showing completion candidates."
  (get-window-with-predicate
   (lambda (window)
     (string-match-p
      prot-minibuffer-completion-windows-regexp
      (format "%s" window)))))

(defun prot-minibuffer-focus-mini-or-completions ()
  "Focus the active minibuffer or the completions' window.

If both the minibuffer and the Completions are present, this
command will first move per invocation to the former, then the
latter, and then continue to switch between the two.

The continuous switch is essentially the same as running
`prot-minibuffer-focus-minibuffer' and `switch-to-completions' in
succession.

What constitutes a completions' window is ultimately determined
by `prot-minibuffer-completion-windows-regexp'."
  (interactive)
  (let* ((mini (active-minibuffer-window))
         (completions (prot-minibuffer--get-completion-window)))
    (cond
     ((and mini (not (minibufferp)))
      (select-window mini nil))
     ((and completions (not (eq (selected-window) completions)))
      (select-window completions nil)))))

;; Adaptation of `icomplete-fido-backward-updir'.
;;;###autoload
(defun prot-minibuffer-backward-updir ()
  "Delete char before point or go up a directory.
Must be bound to `minibuffer-local-filename-completion-map'."
  (interactive)
  (if (and (eq (char-before) ?/)
           (eq (prot-minibuffer--completion-category) 'file))
      (save-excursion
        (goto-char (1- (point)))
        (when (search-backward "/" (point-min) t)
          (delete-region (1+ (point)) (point-max))))
    (call-interactively 'backward-delete-char)))

;;;; Minibuffer and Completions' buffer intersection
;; NOTE 2021-04-02: The bulk of this code resided in `prot-embark.el'
;; because I was using Embark's live-updating completions' collection
;; buffer.  However, Emacs28 provides a one-column layout for the
;; default Completions' buffer, so it is easy to bring this here and
;; adapt it to work without the otherwise minor Embark extras.

(defface prot-minibuffer-hl-line
  '((default :extend t)
    (((class color) (min-colors 88) (background light))
     :background "#b0d8ff" :foreground "#000000")
    (((class color) (min-colors 88) (background dark))
     :background "#103265" :foreground "#ffffff")
    (t :inherit (font-lock-string-face elfeed-search-title-face)))
  "Face for current line in the completions' buffer."
  :group 'prot-minibuffer)

(defface prot-minibuffer-line-number
  '((default :inherit default)
    (((class color) (min-colors 88) (background light))
     :background "#f2eff3" :foreground "#252525")
    (((class color) (min-colors 88) (background dark))
     :background "#151823" :foreground "#dddddd")
    (t :inverse-video t))
  "Face for line numbers in the completions' buffer."
  :group 'prot-minibuffer)

(defface prot-minibuffer-line-number-current-line
  '((default :inherit default)
    (((class color) (min-colors 88) (background light))
     :background "#8ac7ff" :foreground "#000000")
    (((class color) (min-colors 88) (background dark))
     :background "#142a79" :foreground "#ffffff")
    (t :inverse-video t))
  "Face for current line number in the completions' buffer."
  :group 'prot-minibuffer)

(autoload 'display-line-numbers-mode "display-line-numbers")
(autoload 'face-remap-remove-relative "face-remap")

;;;###autoload
(defun prot-minibuffer-display-line-numbers ()
  "Set up line numbers for the completions' buffer.
Add this to `completion-list-mode-hook'."
  (when (derived-mode-p 'completion-list-mode)
    (face-remap-add-relative 'line-number 'prot-minibuffer-line-number)
    (face-remap-add-relative 'line-number-current-line
                             'prot-minibuffer-line-number-current-line)
    (display-line-numbers-mode 1)))

;;;###autoload
(defun prot-minibuffer-hl-line ()
  "Set up line highlighting for the completions' buffer.
Add this to `completion-list-mode-hook'."
  (when (derived-mode-p 'completion-list-mode)
    (face-remap-add-relative 'hl-line 'prot-minibuffer-hl-line)
    (hl-line-mode 1)))

;; Thanks to Omar Antolín Camarena for recommending the use of
;; `cursor-sensor-functions' and the concomitant hook with
;; `cursor-censor-mode' instead of the dirty hacks I had before to
;; prevent the cursor from moving to that position where no completion
;; candidates could be found at point (e.g. it would break `embark-act'
;; as it could not read the topmost candidate when point was at the
;; beginning of the line, unless the point was moved forward).
(defun prot-minibuffer--clean-completions ()
  "Keep only completion candidates in the Completions."
  (with-current-buffer standard-output
    (let ((inhibit-read-only t))
      (goto-char (point-min))
      (delete-region (point-at-bol) (1+ (point-at-eol)))
      (insert (propertize " "
                          'cursor-sensor-functions
                          (list
                           (lambda (_win prev dir)
                             (when (eq dir 'entered)
                               (goto-char prev))))))
      (put-text-property (point-min) (point) 'invisible t))))

(add-hook 'completion-list-mode-hook #'cursor-sensor-mode)
(add-hook 'completion-setup-hook #'prot-minibuffer--clean-completions)

(defun prot-minibuffer--fit-completions-window ()
  "Fit Completions' buffer to its window."
  (fit-window-to-buffer (get-buffer-window "*Completions*")
                        (floor (frame-height) 2) 1))

(defun prot-minibuffer--input-string ()
  "Return the contents of the minibuffer as a string."
  (buffer-substring-no-properties (minibuffer-prompt-end) (point-max)))

(defun prot-minibuffer--minimum-input ()
  "Test for minimum requisite input for live completions."
  (>= (length (prot-minibuffer--input-string)) prot-minibuffer-minimum-input))

;; Adapted from Omar Antolín Camarena's live-completions library:
;; <https://github.com/oantolin/live-completions>.
(defun prot-minibuffer--live-completions (&rest _)
  "Update the *Completions* buffer.
Meant to be added to `after-change-functions'."
  (when (minibufferp) ; skip if we've exited already
    (let ((while-no-input-ignore-events '(selection-request)))
      (while-no-input
        (if (prot-minibuffer--minimum-input)
            (condition-case nil
                (save-match-data
                  (save-excursion
                    (goto-char (point-max))
                    (let ((inhibit-message t)
                          ;; don't ring the bell in `minibuffer-completion-help'
                          ;; when <= 1 completion exists.
                          (ring-bell-function #'ignore))
                      (minibuffer-completion-help)
                      (prot-minibuffer--fit-completions-window))))
              (quit (abort-recursive-edit)))
          (minibuffer-hide-completions))))))

(defun prot-minibuffer--live-completions-timer (&rest _)
  "Update Completions with `prot-minibuffer-live-update-delay'."
  (let ((delay prot-minibuffer-live-update-delay))
    (when (>= delay 0)
      (run-with-idle-timer delay nil #'prot-minibuffer--live-completions))))

(defun prot-minibuffer--setup-completions ()
  "Set up the completions buffer."
  (cond
   ((member this-command prot-minibuffer-completion-passlist)
    (minibuffer-completion-help)
    (add-hook 'after-change-functions #'prot-minibuffer--live-completions nil t))
   ((unless (member this-command prot-minibuffer-completion-blocklist)
    (add-hook 'after-change-functions #'prot-minibuffer--live-completions-timer nil t)))))

(add-hook 'minibuffer-setup-hook #'prot-minibuffer--setup-completions)

;;;###autoload
(defun prot-minibuffer-toggle-completions ()
  "Toggle the presentation of the completions' buffer."
  (interactive)
  (if (get-buffer-window "*Completions*" 0)
      (minibuffer-hide-completions)
    (minibuffer-completion-help)))

;;;###autoload
(defun prot-minibuffer-keyboard-quit-dwim ()
  "Control the exit behaviour for completions' buffers.

If in a completions' buffer and unless the region is active, run
`abort-recursive-edit'.  Otherwise run `keyboard-quit'.

If the region is active, deactivate it.  A second invocation of
this command is then required to abort the session."
  (interactive)
  (when (derived-mode-p 'completion-list-mode)
    (if (use-region-p)
        (keyboard-quit)
      (abort-recursive-edit))))

(defun prot-minibuffer--switch-to-completions ()
  "Subroutine for switching to the completions' buffer."
  (unless (get-buffer-window "*Completions*" 0)
    (minibuffer-completion-help))
  (switch-to-completions)
  (prot-minibuffer--fit-completions-window))

;;;###autoload
(defun prot-minibuffer-switch-to-completions-top ()
  "Switch to the top of the completions' buffer.
Meant to be bound in `minibuffer-local-completion-map'."
  (interactive)
  (prot-minibuffer--switch-to-completions)
  (goto-char (point-min))
  (next-completion 1))

;;;###autoload
(defun prot-minibuffer-switch-to-completions-bottom ()
  "Switch to the bottom of the completions' buffer.
Meant to be bound in `minibuffer-local-completion-map'."
  (interactive)
  (prot-minibuffer--switch-to-completions)
  (goto-char (point-max))
  (next-completion -1)
  (goto-char (point-at-bol))
  (recenter
   (- -1
      (min (max 0 scroll-margin)
           (truncate (/ (window-body-height) 4.0))))
      t))

;;;###autoload
(defun prot-minibuffer-next-completion-or-mini (&optional arg)
  "Move to the next completion or switch to the minibuffer.
This performs a regular motion for optional ARG lines, but when
point can no longer move in that direction it switches to the
minibuffer."
  (interactive "p")
  (if (or (eobp)
          (eq (point-max)
              (save-excursion (forward-line 1) (point))))
      (prot-minibuffer-focus-minibuffer)
    (next-completion (or arg 1)))
  (setq this-command 'next-line))

;;;###autoload
(defun prot-minibuffer-previous-completion-or-mini (&optional arg)
  "Move to the next completion or switch to the minibuffer.
This performs a regular motion for optional ARG lines, but when
point can no longer move in that direction it switches to the
minibuffer."
  (interactive "p")
  (let ((num (prot-common-number-negative arg)))
    (if (or (bobp)
            (eq (point) (1+ (point-min)))) ; see hack in `prot-minibuffer--clean-completions'
        (prot-minibuffer-focus-minibuffer)
      (next-completion (or num 1)))))

;; ;; NOTE 2021-04-07: This was written as a temporary solution to get a
;; ;; copy of the completions' buffer.  It is no longer needed in my
;; ;; setup because Embark's ability to capture a snapshot of the
;; ;; completion candidates works as intended.  It also captures
;; ;; annotations provided by Marginalia and retains the default action
;; ;; attached to each completion candidate.
;; ;;
;; ;; I am keeping this here for posterity.
;; ;; ------------------------------------------------------------------
;; ;; This design is adapted from Omar Antolín Camarena's Embark:
;; ;; <https://github.com/oantolin/embark>.  We need to call the
;; ;; function after aborting the minibuffer, otherwise we cannot get
;; ;; the new window.
;; (defun prot-minibuffer--run-after-abort (fn &rest args)
;;   "Call FN with rest ARGS while aborting recursive edit."
;;   (apply #'run-at-time 0 nil fn args)
;;   (abort-recursive-edit))
;; 
;; (defun prot-minibuffer--display-at-bottom (buf-name)
;;   "Display BUF-NAME in bottom window."
;;   (display-buffer-at-bottom
;;    (get-buffer buf-name)
;;    '((window-height . shrink-window-if-larger-than-buffer))))
;;
;;;###autoload
;; (defun prot-minibuffer-save-completions ()
;;   "Save completions in a bespoke buffer."
;;   (interactive)
;;   (let* ((completion (when (active-minibuffer-window)
;;                        (save-excursion
;;                          (prot-minibuffer-focus-minibuffer)
;;                          (prot-minibuffer--input-string))))
;;          (buf-name (format "*%s # Completions*" completion)))
;;     (when (get-buffer buf-name)
;;       (kill-buffer buf-name))
;;     (minibuffer-completion-help)
;;     (with-current-buffer "*Completions*"
;;       (clone-buffer buf-name))
;;     (prot-minibuffer--run-after-abort #'prot-minibuffer--display-at-bottom buf-name)))

;;;###autoload
(defun prot-minibuffer-choose-completion-exit ()
  "Run `choose-completion' in the Completions buffer and exit."
  (interactive)
  (when (and (derived-mode-p 'completion-list-mode)
             (active-minibuffer-window))
    (choose-completion)
    (minibuffer-force-complete-and-exit)))

(defun prot-minibuffer--goto-line (n &optional args)
  "Go to line N in the Completions' with optional ARGS."
  (let ((bounds (count-lines (point-min) (point-max))))
    (if (<= n bounds)
        (progn
          `(,@args)
          (goto-char (point-min))
          (forward-line (1- n))
          (choose-completion))
      (user-error "%d is not within Completions' buffer bounds (%d)" n bounds))))

;;;###autoload
(defun prot-minibuffer-choose-completion-number (n)
  "Select completion candidate on line number N with prefix arg.

The idea is to pass a prefix numeric argument that refers to a
line number in the Completions' buffer."
  (interactive "p")
  (if current-prefix-arg
      (cond
       ((and (derived-mode-p 'completion-list-mode)
             (active-minibuffer-window))
        (prot-minibuffer--goto-line n))
       ((and (minibufferp)
             (prot-minibuffer--get-completion-window))
        (prot-minibuffer--goto-line n (select-window (prot-minibuffer--get-completion-window))))
       (t
        (user-error "Only use this inside the minibuffer of the Completions")))
    (user-error "Pass a numeric argument first")))

(defvar crm-completion-table)

;;;###autoload
(defun prot-minibuffer-choose-completion-dwim ()
  "Append to minibuffer when at `completing-read-multiple' prompt.
Otherwise behave like `prot-minibuffer-choose-completion-exit'."
  (interactive)
  (when (and (derived-mode-p 'completion-list-mode)
             (active-minibuffer-window))
    (choose-completion)
    (with-current-buffer (window-buffer (active-minibuffer-window))
      (unless (eq (prot-minibuffer--completion-category) 'file)
        (minibuffer-force-complete))
      (when crm-completion-table
        ;; FIXME 2021-04-02: assumes the `crm-separator' as constant.
        ;; UPDATE 2021-04-22: actually `crm-default-separator' is a
        ;; defconst, so I am leaving this here just in case I ever need
        ;; it.  We will have a problem if some command let-binds its own
        ;; value, but it is not our fault here...
        (insert ",")
        (let ((inhibit-message t))
          (switch-to-completions))))))

;;;; Simple actions for the "*Completions*" buffer

;; DEPRECATED: I just use Embark for such tasks, but am keeping this
;; around in case I ever need it.

;; Adapted from `choose-completion'.
(defun prot-minibuffer--completion-at-point ()
  "Find completion candidate at point in the Completions buffer."
  (when (derived-mode-p 'completion-list-mode)
    (let (beg end)
      (cond
       ((and (not (eobp)) (get-text-property (point) 'mouse-face))
        (setq end (point) beg (1+ (point))))
       ((and (not (bobp))
             (get-text-property (1- (point)) 'mouse-face))
        (setq end (1- (point)) beg (point)))
       ;; ((and (bobp)   ; see hack in `prot-minibuffer--clean-completions'
       ;;       (get-text-property (point) 'invisible))
       ;;  (save-excursion
       ;;    (forward-char 1)
       ;;    (setq end (point) beg (1+ (point)))))
       (t (user-error "No completion here")))
      (setq beg (previous-single-property-change beg 'mouse-face))
      (setq end (or (next-single-property-change end 'mouse-face)
                    (point-max)))
      (buffer-substring-no-properties beg end))))

(defmacro prot-minibuffer-completions-buffer-act (name doc &rest body)
  "Produce NAME function with DOC and rest BODY.
This is meant to define some basic commands for use in the
Completions' buffer."
  `(defun ,name ()
     ,doc
     (interactive)
     (let ((completions-buffer (get-buffer "*Completions*"))
           (symbol (prot-minibuffer--completion-at-point)))
       (with-current-buffer completions-buffer
         ,@body))))

(prot-minibuffer-completions-buffer-act
 prot-minibuffer-completions-kill-symbol-at-point
 "Append `symbol-at-point' to the `kill-ring'.
Intended to be used from inside the Completions' buffer."
 (kill-new symbol)
 (message "Copied %s to kill-ring"
          (propertize symbol 'face 'success)))

(prot-minibuffer-completions-buffer-act
 prot-minibuffer-completions-insert-symbol-at-point
 "Add `symbol-at-point' to last active window.
Intended to be used from inside the Completions' buffer."
 (let ((window (window-buffer (get-mru-window))))
   (with-current-buffer window
     (insert symbol)
     (message "Inserted %s"
              (propertize symbol 'face 'success)))))

(prot-minibuffer-completions-buffer-act
 prot-minibuffer-completions-insert-symbol-at-point-exit
 "Add `symbol-at-point' to last window and exit all minibuffers.
Intended to be used from inside the Completions' buffer."
 (let ((window (window-buffer (get-mru-window))))
   (with-current-buffer window
     (insert symbol)
     (message "Inserted %s"
              (propertize symbol 'face 'success))))
 (top-level))

(provide 'prot-minibuffer)
;;; prot-minibuffer.el ends here

Re: [PATCH] `completing-read`: Add `group-function` support to completion metadata

[Stefan Monnier]

> So it's better if at least icomplete-mode is enabled, preferably with an
> option which shows the completions right away with no input. And the
> vertical style should be even better.

Maybe we could accommodate this in the default UI by adding an option to
eagerly popup the *Completions* buffer (and keep it updated as long as
it's displayed) and to keep it disabled by default but make it possible
to enable it via completion-category-(overrides|defaults).


        Stefan

Re: [PATCH] `completing-read`: Add `group-function` support to completion metadata

[Daniel Mendler]

On 4/26/21 1:33 AM, Stefan Monnier wrote:
>> So it's better if at least icomplete-mode is enabled, preferably with an
>> option which shows the completions right away with no input. And the
>> vertical style should be even better.
> 
> Maybe we could accommodate this in the default UI by adding an option to
> eagerly popup the *Completions* buffer (and keep it updated as long as
> it's displayed) and to keep it disabled by default but make it possible
> to enable it via completion-category-(overrides|defaults).

Yes, this sounds useful. It is similar to the configuration by
Protesilaos Stavrou, as he described in his other mail. However
Protesilaos' solution is more feature-rich and is always turned on.
Maybe it makes sense to integrate such enhancements directly in
minibuffer.el. An alternative is a small package providing a minor-mode
in the style of Icomplete. All in all, the default completion UI should
not be neglected when adding new metadata like a `group-function`.

Daniel

Re: [PATCH] `completing-read`: Add `group-function` support to completion metadata

[Stefan Monnier]

>>> So it's better if at least icomplete-mode is enabled, preferably with an
>>> option which shows the completions right away with no input. And the
>>> vertical style should be even better.
>> 
>> Maybe we could accommodate this in the default UI by adding an option to
>> eagerly popup the *Completions* buffer (and keep it updated as long as
>> it's displayed) and to keep it disabled by default but make it possible
>> to enable it via completion-category-(overrides|defaults).
>
> Yes, this sounds useful. It is similar to the configuration by
> Protesilaos Stavrou, as he described in his other mail.

Indeed.

> Maybe it makes sense to integrate such enhancements directly in
> minibuffer.el.

That's what I meant, yes.


        Stefan

Re: [PATCH] `completing-read`: Add `group-function` support to completion metadata

[Dmitry Gutov]

On 26.04.2021 02:33, Stefan Monnier wrote:
>> So it's better if at least icomplete-mode is enabled, preferably with an
>> option which shows the completions right away with no input. And the
>> vertical style should be even better.
> 
> Maybe we could accommodate this in the default UI by adding an option to
> eagerly popup the *Completions* buffer (and keep it updated as long as
> it's displayed) and to keep it disabled by default but make it possible
> to enable it via completion-category-(overrides|defaults).

I don't know if it's enough. And I have my doubts (expressed previously 
already) about a *Completions* buffer that is impossible to dismiss: it 
might hide a window showing a buffer you care about.

Ultimately, it can be a good change/feature, but it should be championed 
by somebody actually willing to use the resulting UI on a regular basis.

My ideal UI would probably be more like this: 
https://emacs-lsp.github.io/lsp-ui/images/lsp-xref.gif (though perhaps 
with a slightly different layout). Meaning, a posframe popup showing the 
list of all locations, vertically, and a preview popup by its side or 
below it, displaying the current selected location.

Ivy should be easy enough to extend to do that, I think. *Completions* - 
not so much.

Re:Re: [PATCH] `completing-read`: Add `group-function` support to completion metadata

[tumashu]

>My ideal UI would probably be more like this: 
>https://emacs-lsp.github.io/lsp-ui/images/lsp-xref.gif (though perhaps 
>with a slightly different layout). Meaning, a posframe popup showing the 

Wow, cool!!!
it seem to many packages use posframe at the moment, is is a good idea
to move posframe to emacs.git?  

>list of all locations, vertically, and a preview popup by its side or 
>below it, displaying the current selected location.
>
>Ivy should be easy enough to extend to do that, I think. *Completions* - 
>not so much.

Re: [PATCH] `completing-read`: Add `group-function` support to completion metadata

[Daniel Mendler]

On 4/27/21 3:59 AM, tumashu wrote:
>> My ideal UI would probably be more like this: 
>> https://emacs-lsp.github.io/lsp-ui/images/lsp-xref.gif (though perhaps 
>> with a slightly different layout). Meaning, a posframe popup showing the 
> 
> Wow, cool!!!
> it seem to many packages use posframe at the moment, is is a good idea
> to move posframe to emacs.git?  

I would like to see an easy to use API for popups in Emacs. However it
may be a bit early to add Posframe.

I recently made a small package, Corfu, which uses Company-like popups.
I considered using Posframe but went with overlays (which are are poor
substitute for real popups), since Posframe still has a few bugs.

For example the internal border is not drawn correctly
(https://github.com/tumashu/posframe/issues/74). Furthermore the child
frame creation is slow as has been discussed in the thread about hidden
frames. Are there Emacs bug reports addressing this?

Daniel

Re: [PATCH] `completing-read`: Add `group-function` support to completion metadata

[Dmitry Gutov]

On 27.04.2021 04:59, tumashu wrote:
> 
>> My ideal UI would probably be more like this:
>> https://emacs-lsp.github.io/lsp-ui/images/lsp-xref.gif (though perhaps
>> with a slightly different layout). Meaning, a posframe popup showing the
> 
> Wow, cool!!!
> it seem to many packages use posframe at the moment,

I use Ivy with posframe (because I like to have a reliably 
frame-centered popup, and by frame usually has 4 windows), but the 
package above actually implements its own rendering based on overlays. 
Probably because they wanted it to be functional in terminal as well.

> is is a good idea
> to move posframe to emacs.git?

My personal rule of thumb is, it should be in emacs.git only if it's 
going to be used by some code inside Emacs. At the moment it seems 
unlikely also because of the same factor: we don't have a similar 
feature/library for rendering popups in terminal Emacs. A few users ago 
Eli (I think?) said it could be created based on the same approach that 
renders menu in the terminal mode, but that still has not materialized.

It's also unfortunate that the core developers usually give GNU ELPA a 
wide berth instead of reviewing the code and making suggestions (in the 
most essential packages, at least). That could be another reason to add 
posframe to the core, but without at least someone among our windowing 
system experts paying attention to it, there would be no point.

And without a terminal mode counterpart/support, it's unlikely to be 
used in the core code.

Re: [PATCH] `completing-read`: Add `group-function` support to completion metadata

[Stefan Monnier]

>>> So it's better if at least icomplete-mode is enabled, preferably with an
>>> option which shows the completions right away with no input. And the
>>> vertical style should be even better.
>> Maybe we could accommodate this in the default UI by adding an option to
>> eagerly popup the *Completions* buffer (and keep it updated as long as
>> it's displayed) and to keep it disabled by default but make it possible
>> to enable it via completion-category-(overrides|defaults).
> I don't know if it's enough. And I have my doubts (expressed previously
> already) about a *Completions* buffer that is impossible to dismiss: it
> might hide a window showing a buffer you care about.

I haven't looked at it closely, but I assume it shouldn't be too hard
to tweak the current code such that we can refrain from popping down the
*Completions* automatically, while still allowing the user to pop it down.

> Ultimately, it can be a good change/feature, but it should be championed by
> somebody actually willing to use the resulting UI on a regular basis.

Of course.

> My ideal UI would probably be more like this:
> https://emacs-lsp.github.io/lsp-ui/images/lsp-xref.gif (though perhaps with
> a slightly different layout). Meaning, a posframe popup showing the list of
> all locations, vertically, and a preview popup by its side or below it,
> displaying the current selected location.

I was thinking only of tweaking the existing UI to better support the
case of "selection" compared to "completion".  What you suggest here is
nice and it goes much further but I don't think the two are competing.

If anything they work together: the idea behind my tweak would be to let
more callers of `completing-read` presume a "selection" kind of UI
(without having to impose a non-default UI), which in turn will make it
more often useful/beneficial to use a UI like the one you propose.


        Stefan

Re: [PATCH] `completing-read`: Add `group-function` support to completion metadata

[Dmitry Gutov]

On 27.04.2021 06:41, Stefan Monnier wrote:

> I was thinking only of tweaking the existing UI to better support the
> case of "selection" compared to "completion".  What you suggest here is
> nice and it goes much further but I don't think the two are competing.

Perhaps a "selection" tweak on the *Completions* interface could look 
like this:

When completing-read is called (or selecting-read, IDK), *Completions* 
buffer is popped up. The first element in the list is highlighted with 
some noticeable background, thus telling the user that if they press RET 
right away, that item will be selected. The user can now type some 
characters to narrow down the matches, or the can move the selection 
along the list with, say, arrow keys. Or C-n/C-p. Or press RET right 
away to choose the first completion. Not sure if iteration with TAB is a 
good idea, but it could be added as well.

That doesn't solve the issue of hiding a "useful" window with this 
buffer, but there's probably not much that can be done. When necessary, 
the user could switch to the previous buffer from that window in some 
other window.

Re: [PATCH] `completing-read`: Add `group-function` support to completion metadata

[Stefan Monnier]

>> I was thinking only of tweaking the existing UI to better support the
>> case of "selection" compared to "completion".  What you suggest here is
>> nice and it goes much further but I don't think the two are competing.
>
> Perhaps a "selection" tweak on the *Completions* interface could look like
> this:
>
> When completing-read is called (or selecting-read, IDK), *Completions*
> buffer is popped up. The first element in the list is highlighted with some
> noticeable background, thus telling the user that if they press RET right
> away, that item will be selected. The user can now type some characters to
> narrow down the matches, or the can move the selection along the list with,
> say, arrow keys. Or C-n/C-p. Or press RET right away to choose the first
> completion. Not sure if iteration with TAB is a good idea, but it could be
> added as well.

Yes, that's pretty much the UI behavior I imagine.

> That doesn't solve the issue of hiding a "useful" window with this buffer,
> but there's probably not much that can be done.

Normally we should already try and make efforts not to hide "obviously
useful" text when we pop up *Completions*, and as for the part that
aren't obviously useful (or that we can't not hide) the user can always
go and hide the *Completions* buffer manually (or do any other normal
window manipulation).


        Stefan

Re: [PATCH] `completing-read`: Add `group-function` support to completion metadata (REVISED PATCH)

[Daniel Mendler]

[-- Attachment #1: Type: text/plain, Size: 827 bytes --]

On 4/25/21 3:32 PM, Daniel Mendler wrote:
> I attached a patch which adds grouping support to the completions 
> buffer. The completion table can specify a `group-function` via its 
> completion metadata.

I attached a revised patch with the following changes over the previous 
version:

1. Add a `completions-group` guard variable, to turn the grouping off. 
The setting is off by default.
2. Ensure that the original completion string is used in 
`choose-completion`. Attach the untransformed completion string to each 
completion string displayed in the *Completions* buffer.

You can try the patch with the following settings and execute 
`xref-find-references` for example (M-?).

(setq xref-show-xrefs-function
   #'xref-show-definitions-completing-read
   completions-group t
   completions-format 'one-column)

Daniel

[-- Attachment #2: 0001-completing-read-Add-group-function-to-completion-met.patch --]
[-- Type: text/x-diff, Size: 17663 bytes --]

From baf8d180c41f0684bb15d87a637d36030e740665 Mon Sep 17 00:00:00 2001
From: Daniel Mendler <mail@daniel-mendler.de>
Date: Sun, 25 Apr 2021 13:07:29 +0200
Subject: [PATCH] (completing-read): Add `group-function` to completion
 metadata

A completion table can specify a `group-function` in its metadata.
The group function takes two arguments, a completion string and a
transform argument. The group function is used to group the candidates
after sorting.

If the transform argument is nil, the function should return the group
title of the group to which the completion belongs. Otherwise the
function should return the transformed candidate. The transformation
allows to remove parts of the candidate, which is then displayed in
the title.

This specific form of the `group-function` has been chosen in order to
allow allocation-free grouping. This is important for completion UIs,
which continously update the displayed set of candidates (Icomplete,
Vertico, Ivy, etc.). Only when the transform argument is non-nil the
candidate transformation is performed, which may involve a string
allocation as for example in `xref--completing-read-group`.

The function `xref-show-definitions-completing-read` makes use of the
`group-function`, by moving the file name prefix to the title. If
group titles are activated the *Completions* are displayed as "line
number:matching line" instead of "file name:line number:matching
line". This way the *Completions* buffer resembles the *Occur* buffer.

* doc/lispref/minibuf.texi: Add documentation.

* lisp/minibuffer.el: Add documentation for `group-function` as part
of completion metadata.
(completions-group): Add guard variable, by default off.
(completions-group-format): Add format string for group titles.
(completions-group-title): Add face for group titles.
(completions-group-separator): Add face for group separator.
(minibuffer--group-by): New grouping function.
(minibuffer-completion-help): Use it.
(display-completion-list): Add optional GROUP-FUN argument.
(completion--insert-strings): Add optional GROUP-FUN argument, insert
group titles if `completions-format` is `one-column`. Transform
candidates using the GROUP-FUN. Attach the untransformed completion
string at the property `completion--string`.

* lisp/simple.el (choose-completion): Retrieve the completion string
by accessing the property `completion--string`.

* lisp/progmodes/xref.el:
(xref--completing-read-group): New grouping function.
(xref-show-definitions-completing-read): Use it.
---
 doc/lispref/minibuf.texi |  10 ++++
 lisp/minibuffer.el       | 122 ++++++++++++++++++++++++++++++++-------
 lisp/progmodes/xref.el   |  18 ++++--
 lisp/simple.el           |   4 +-
 4 files changed, 126 insertions(+), 28 deletions(-)

diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi
index 72f0e5878b..855b2baaf4 100644
--- a/doc/lispref/minibuf.texi
+++ b/doc/lispref/minibuf.texi
@@ -1947,6 +1947,16 @@ Programmed Completion
 a completion and a suffix string like in @code{annotation-function}.
 This function takes priority over @code{annotation-function}.
 
+@item group-function
+The value should be a function for grouping the completion candidates.
+The function should take two arguments, @var{completion}, which is a
+completion candidate and @var{transform}, which is a boolean flag.  If
+@var{transform} is @code{nil}, the function should return a group
+title, to which the candidate belongs. Otherwise the function should
+return the transformed candidate. The transformation can for example
+remove a redundant prefix, which is displayed in the group title
+instead.
+
 @item display-sort-function
 The value should be a function for sorting completions.  The function
 should take one argument, a list of completion strings, and return a
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 98691c2ede..60411955e2 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -126,6 +126,13 @@ completion-metadata
    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.
+- `group-function': function for grouping the completion candidates.
+   Takes two arguments: a completion candidate (COMPLETION) and a
+   boolean flag (TRANSFORM).  If TRANSFORM is nil, the function
+   returns a group title, to which the candidate belongs.  Otherwise
+   the function returns the transformed candidate.  The transformation
+   can remove a redundant prefix, which is displayed in the group
+   title instead.
 - `display-sort-function': function to sort entries in *Completions*.
    Takes one argument (COMPLETIONS) and should return a new list
    of completions.  Can operate destructively.
@@ -1138,6 +1145,30 @@ completion-cycle-threshold
   :version "24.1"
   :type completion--cycling-threshold-type)
 
+(defcustom completions-group nil
+  "Enable grouping of completion candidates in the *Completions* buffer.
+See also `completions-group-format'."
+  :type 'boolean
+  :version "28.1")
+
+(defcustom completions-group-format
+  (concat
+   (propertize "    " 'face 'completions-group-separator)
+   (propertize " %s " 'face 'completions-group-title)
+   (propertize " " 'face 'completions-group-separator
+               'display '(space :align-to right)))
+  "Format string used for the group title."
+  :type 'string
+  :version "28.1")
+
+(defface completions-group-title '((t :inherit shadow :slant italic))
+  "Face used for the title text of the candidate group headlines."
+  :version "28.1")
+
+(defface completions-group-separator '((t :inherit shadow :strike-through t))
+  "Face used for the separator lines of the candidate groups."
+  :version "28.1")
+
 (defun completion--cycle-threshold (metadata)
   (let* ((cat (completion-metadata-get metadata 'category))
          (over (completion--category-override cat 'cycle)))
@@ -1401,6 +1432,17 @@ minibuffer--sort-preprocess-history
                      (substring c base-size)))
                  hist)))))
 
+(defun minibuffer--group-by (fun elems)
+  "Group ELEMS by FUN."
+  (let ((groups))
+    (dolist (cand elems)
+      (let* ((key (funcall fun cand nil))
+             (group (assoc key groups)))
+        (if group
+            (setcdr group (cons cand (cdr group)))
+          (push (list key cand) groups))))
+    (mapcan (lambda (x) (nreverse (cdr x))) (nreverse groups))))
+
 (defun completion-all-sorted-completions (&optional start end)
   (or completion-all-sorted-completions
       (let* ((start (or start (minibuffer-prompt-end)))
@@ -1747,11 +1789,17 @@ completions-detailed
   :type 'boolean
   :version "28.1")
 
-(defun completion--insert-strings (strings)
+;; TODO: Split up this function in one function per `completions-format'.
+;; TODO: Add group title support for horizontal and vertical format.
+(defun completion--insert-strings (strings &optional group-fun)
   "Insert a list of STRINGS into the current buffer.
-Uses columns to keep the listing readable but compact.
-It also eliminates runs of equal strings."
+Uses columns to keep the listing readable but compact.  It also
+eliminates runs of equal strings.  GROUP-FUN is a `group-function'
+used for grouping the completion."
   (when (consp strings)
+    ;; FIXME: Currently grouping is enabled only for 'one-column format
+    (unless (eq completions-format 'one-column)
+      (setq group-fun nil))
     (let* ((length (apply #'max
 			  (mapcar (lambda (s)
 				    (if (consp s)
@@ -1768,6 +1816,7 @@ completion--insert-strings
 		     (max 1 (/ (length strings) 2))))
 	   (colwidth (/ wwidth columns))
            (column 0)
+           (last-title nil)
 	   (rows (/ (length strings) columns))
 	   (row 0)
            (first t)
@@ -1780,6 +1829,12 @@ completion--insert-strings
       ;; The insertion should be "sensible" no matter what choices were made
       ;; for the parameters above.
       (dolist (str strings)
+        ;; Add group titles.
+        (when group-fun
+          (let ((title (funcall group-fun (if (consp str) (car str) str) nil)))
+            (unless (equal title last-title)
+              (insert (format completions-group-format title))
+              (setq last-title title))))
 	(unless (equal laststring str) ; Remove (consecutive) duplicates.
 	  (setq laststring str)
           ;; FIXME: `string-width' doesn't pay attention to
@@ -1825,8 +1880,15 @@ completion--insert-strings
 		  nil))))
             (setq first nil)
             (if (not (consp str))
-                (put-text-property (point) (progn (insert str) (point))
-                                   'mouse-face 'highlight)
+                (add-text-properties
+                 (point)
+                 (progn
+                   (insert
+                    (if group-fun
+                        (funcall group-fun str 'transform)
+                      str))
+                   (point))
+                 `(mouse-face highlight completion--string ,str))
               ;; If `str' is a list that has 2 elements,
               ;; then the second element is a suffix annotation.
               ;; If `str' has 3 elements, then the second element
@@ -1837,8 +1899,15 @@ completion--insert-strings
                   (let ((beg (point))
                         (end (progn (insert prefix) (point))))
                     (put-text-property beg end 'mouse-face nil)))
-                (put-text-property (point) (progn (insert (car str)) (point))
-                                   'mouse-face 'highlight)
+                (add-text-properties
+                 (point)
+                 (progn
+                   (insert
+                    (if group-fun
+                         (funcall group-fun (car str) 'transform)
+                      (car str)))
+                   (point))
+                 `(mouse-face highlight completion--string ,(car str)))
                 (let ((beg (point))
                       (end (progn (insert suffix) (point))))
                   (put-text-property beg end 'mouse-face nil)
@@ -1923,7 +1992,7 @@ completion-hilit-commonality
         completions)
        base-size))))
 
-(defun display-completion-list (completions &optional common-substring)
+(defun display-completion-list (completions &optional common-substring group-fun)
   "Display the list of completions, COMPLETIONS, using `standard-output'.
 Each element may be just a symbol or string
 or may be a list of two strings to be printed as if concatenated.
@@ -1933,7 +2002,8 @@ display-completion-list
 The actual completion alternatives, as inserted, are given `mouse-face'
 properties of `highlight'.
 At the end, this runs the normal hook `completion-setup-hook'.
-It can find the completion buffer in `standard-output'."
+It can find the completion buffer in `standard-output'.
+GROUP-FUN is a `group-function' used for grouping the completion."
   (declare (advertised-calling-convention (completions) "24.4"))
   (if common-substring
       (setq completions (completion-hilit-commonality
@@ -1946,7 +2016,7 @@ display-completion-list
 	(let ((standard-output (current-buffer))
 	      (completion-setup-hook nil))
           (with-suppressed-warnings ((callargs display-completion-list))
-	    (display-completion-list completions common-substring)))
+	    (display-completion-list completions common-substring group-fun)))
 	(princ (buffer-string)))
 
     (with-current-buffer standard-output
@@ -1954,7 +2024,7 @@ display-completion-list
       (if (null completions)
           (insert "There are no possible completions of what you have typed.")
         (insert "Possible completions are:\n")
-        (completion--insert-strings completions))))
+        (completion--insert-strings completions group-fun))))
 
   (run-hooks 'completion-setup-hook)
   nil)
@@ -2067,6 +2137,9 @@ minibuffer-completion-help
              (aff-fun (or (completion-metadata-get all-md 'affixation-function)
                           (plist-get completion-extra-properties
                                      :affixation-function)))
+             (sort-fun (completion-metadata-get all-md 'display-sort-function))
+             (group-fun (and completions-group
+                             (completion-metadata-get all-md 'group-function)))
              (mainbuf (current-buffer))
              ;; If the *Completions* buffer is shown in a new
              ;; window, mark it as softly-dedicated, so bury-buffer in
@@ -2098,15 +2171,22 @@ minibuffer-completion-help
                       ;; Remove the base-size tail because `sort' requires a properly
                       ;; nil-terminated list.
                       (when last (setcdr last nil))
-                      (setq completions
-                            ;; FIXME: This function is for the output of all-completions,
-                            ;; not completion-all-completions.  Often it's the same, but
-                            ;; not always.
-                            (let ((sort-fun (completion-metadata-get
-                                             all-md 'display-sort-function)))
-                              (if sort-fun
-                                  (funcall sort-fun completions)
-                                (sort completions 'string-lessp))))
+
+                      ;; Sort first using the `display-sort-function'.
+                      ;; FIXME: This function is for the output of
+                      ;; all-completions, not
+                      ;; completion-all-completions.  Often it's the
+                      ;; same, but not always.
+                      (setq completions (if sort-fun
+                                            (funcall sort-fun completions)
+                                          (sort completions 'string-lessp)))
+
+                      ;; After sorting, group the candidates using the
+                      ;; `group-function'.
+                      (when group-fun
+                        (setq completions
+                              (minibuffer--group-by group-fun completions)))
+
                       (cond
                        (aff-fun
                         (setq completions
@@ -2152,7 +2232,7 @@ minibuffer-completion-help
                                                      (if (eq (car bounds) (length result))
                                                          'exact 'finished)))))))
 
-                      (display-completion-list completions)))))
+                      (display-completion-list completions nil group-fun)))))
           nil)))
     nil))
 
diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el
index e80603f23e..40faf99f20 100644
--- a/lisp/progmodes/xref.el
+++ b/lisp/progmodes/xref.el
@@ -1044,6 +1044,12 @@ xref-show-definitions-buffer-at-bottom
 (define-obsolete-function-alias 'xref--show-defs-buffer-at-bottom
   #'xref-show-definitions-buffer-at-bottom "28.1")
 
+(defun xref--completing-read-group (cand transform)
+  "Return title of candidate CAND or TRANSFORM the candidate."
+  (if transform
+      (substring cand (1+ (next-single-property-change 0 'xref--group cand)))
+    (get-text-property 0 'xref--group cand)))
+
 (defun xref-show-definitions-completing-read (fetcher alist)
   "Let the user choose the target definition with completion.
 
@@ -1072,10 +1078,12 @@ xref-show-definitions-completing-read
                                     (format #("%d:" 0 2 (face xref-line-number))
                                             line)
                                   ""))
+                               (group-prefix
+                                (substring group group-prefix-length))
                                (group-fmt
-                                (propertize
-                                 (substring group group-prefix-length)
-                                 'face 'xref-file-header))
+                                (propertize group-prefix
+                                            'face 'xref-file-header
+                                            'xref--group group-prefix))
                                (candidate
                                 (format "%s:%s%s" group-fmt line-fmt summary)))
                           (push (cons candidate xref) xref-alist-with-line-info)))))
@@ -1087,7 +1095,9 @@ xref-show-definitions-completing-read
                          (lambda (string pred action)
                            (cond
                             ((eq action 'metadata)
-                             '(metadata . ((category . xref-location))))
+                             `(metadata
+                               . ((category . xref-location)
+                                  (group-function . ,#'xref--completing-read-group))))
                             (t
                              (complete-with-action action collection string pred)))))
                         (def (caar collection)))
diff --git a/lisp/simple.el b/lisp/simple.el
index 999755a642..e003af3fad 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -8873,9 +8873,7 @@ choose-completion
                  (setq end (1- (point)) beg (point)))
                 (t (error "No completion here")))
                (setq beg (previous-single-property-change beg 'mouse-face))
-               (setq end (or (next-single-property-change end 'mouse-face)
-                             (point-max)))
-               (buffer-substring-no-properties beg end)))))
+               (substring-no-properties (get-text-property beg 'completion--string))))))
 
       (unless (buffer-live-p buffer)
         (error "Destination buffer is dead"))
-- 
2.20.1

Re: [PATCH] `completing-read`: Add `group-function` support to completion metadata (REVISED PATCH)

[Juri Linkov]

> You can try the patch with the following settings and execute
> `xref-find-references` for example (M-?).

I tried and it looks really nice.  One question about performance:
there are 3 calls of the same function on every completion candidate:
twice it's called with the nil arg, and one call with the 'transform' arg:

> +(defun minibuffer--group-by (fun elems)
> +      (let* ((key (funcall fun cand nil))

> @@ -1780,6 +1829,12 @@ completion--insert-strings
> +          (let ((title (funcall group-fun (if (consp str) (car str) str) nil)))

> @@ -1825,8 +1880,15 @@ completion--insert-strings
> +                        (funcall group-fun str 'transform)

> @@ -2098,15 +2171,22 @@ minibuffer-completion-help
> +                              (minibuffer--group-by group-fun completions)))

My concern is how fast it will work on a large list of candidate strings?

Would it be possible to optimize it to call the group function only once
on every candidate?  This might require changing the data structure,
for example, to an alist like is returned by `seq-group-by`.

Another variant is to put additional text properties on candidate strings,
e.g. a text property on redundant prefix with the group title that
completion--insert-strings then could fetch from the input string.

Re: [PATCH] `completing-read`: Add `group-function` support to completion metadata (REVISED PATCH)

[Daniel Mendler]

On 4/25/21 10:45 PM, Juri Linkov wrote:> I tried and it looks really 
nice.  One question about performance:
 > there are 3 calls of the same function on every completion candidate:
 > twice it's called with the nil arg, and one call with the 'transform' 
arg:

Thanks, I am glad you like the UI.

 >> +(defun minibuffer--group-by (fun elems)
 >> +      (let* ((key (funcall fun cand nil))
 >
 >> @@ -1780,6 +1829,12 @@ completion--insert-strings
 >> +          (let ((title (funcall group-fun (if (consp str) (car str) 
str) nil)))
 >
 >> @@ -1825,8 +1880,15 @@ completion--insert-strings
 >> +                        (funcall group-fun str 'transform)
 >
 >> @@ -2098,15 +2171,22 @@ minibuffer-completion-help
 >> +                              (minibuffer--group-by group-fun 
completions)))
 >
 > My concern is how fast it will work on a large list of candidate strings?

The current implementation already focuses quite a bit on efficiency 
since I am using it in my continuously updating vertical UI (Vertico). 
The function `minibuffer--group-by` is linear time and significantly 
faster than the sorting which comes before it. It is crucial that the 
group function does not allocate when called with transform=nil, 
otherwise `minibuffer--group-by` would lead to a slowdown.

Then the calls to the group function with transform/=nil are allowed to 
be more costly, since they only occur for the candidates which are 
displayed by the UI. These calls will then not matter in comparison to 
the other costs of displaying the candidates.

 > Would it be possible to optimize it to call the group function only once
 > on every candidate?  This might require changing the data structure,
 > for example, to an alist like is returned by `seq-group-by`.

One could return a cons of the transformed candidate and the title, but 
this has the downside that you always compute/allocate the transformed 
candidate. It is better to perform the candidate transformation lazily 
only for the candidates which are actually displayed. This is similar to 
the computation of annotations/affixations, which are only computed 
lazily if the completion UI displays only a subset of the actual candidates.

Dmitry, Stefan and I discussed multiple possible incarnations of such a 
group-function functionality 
(https://github.com/minad/consult/issues/283). The current solution 
turned out to be an efficient and simple solution. We also discussed 
solutions which avoided multiple function calls for every candidate, but 
these were more complex. Note that I am using group functions heavily in 
my Consult package with the design proposed here.

 > Another variant is to put additional text properties on candidate 
strings,
 > e.g. a text property on redundant prefix with the group title that
 > completion--insert-strings then could fetch from the input string.
Yes, this would be possible, but it would be a less flexible design. I 
followed the design of the annotation/affixation-functions for this. I 
also like about the design that it is somehow "pluggable", you add the 
group-function and you can augment your completion table with grouping 
without having to do other adjustments to how the candidates are 
generated. (Note that you may still want to attach a title property to 
the candidates to ensure that the transform=nil call is fast and 
non-allocating, as I did in the xref modifications in this patch.)

Daniel

Re: [PATCH] `completing-read`: Add `group-function` support to completion metadata (REVISED PATCH)

[Juri Linkov]

[-- Attachment #1: Type: text/plain, Size: 633 bytes --]

> You can try the patch with the following settings and execute
> `xref-find-references` for example (M-?).

I tried to use your patch to implement grouping for read-char-by-name.
It helped to greatly reduce the size of mule--ucs-names-group
from 30 lines to just 3 lines that is a big win.

OTOH, it highlighted the shortcomings of amalgamating both
grouping and transforming in the same function:
mule--ucs-names-group doesn't need to provide transformation,
because the same affixation-function is used for both
grouping and non-grouping completions.  So for such cases
handling an additional arg `transform` is an extra burden:


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: read-char-by-name-group-function.patch --]
[-- Type: text/x-diff, Size: 3029 bytes --]

diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el
index b99db46e45..cb5770bdbe 100644
--- a/lisp/international/mule-cmds.el
+++ b/lisp/international/mule-cmds.el
@@ -3088,35 +3088,11 @@ mule--ucs-names-affixation
               (list name (concat (if char (list char) " ") "\t") "")))
           names))
 
-(defun mule--ucs-names-group (names)
-  (let* ((codes-and-names
-          (mapcar (lambda (name) (cons (gethash name ucs-names) name)) names))
-         (grouped
-          (seq-group-by
-           (lambda (code-name)
-             (let ((script (aref char-script-table (car code-name))))
-               (if script (symbol-name script) "ungrouped")))
-           codes-and-names))
-         names-with-header header)
-    (dolist (group (sort grouped (lambda (a b) (string< (car a) (car b)))))
-      (setq header t)
-      (dolist (code-name (cdr group))
-        (push (list
-               (cdr code-name)
-               (concat
-                (if header
-                    (progn
-                      (setq header nil)
-                      (concat "\n" (propertize
-                                    (format "* %s\n" (car group))
-                                    'face 'header-line)))
-                  "")
-                ;; prefix
-                (if (car code-name) (format "%c" (car code-name)) " ") "\t")
-               ;; suffix
-               "")
-              names-with-header)))
-    (nreverse names-with-header)))
+(defun mule--ucs-names-group (name transform)
+  (if transform
+      name
+    (let ((script (aref char-script-table (gethash name ucs-names))))
+      (if script (symbol-name script) "ungrouped"))))
 
 (defun char-from-name (string &optional ignore-case)
   "Return a character as a number from its Unicode name STRING.
@@ -3148,7 +3124,7 @@ read-char-by-name-sort
   :group 'mule
   :version "28.1")
 
-(defcustom read-char-by-name-group nil
+(defcustom read-char-by-name-group t
   "How to group characters for `read-char-by-name' completion.
 When t, split characters to sections of Unicode blocks
 sorted alphabetically."
@@ -3180,6 +3156,8 @@ read-char-by-name
   (let* ((enable-recursive-minibuffers t)
 	 (completion-ignore-case t)
 	 (completion-tab-width 4)
+	 (completions-group read-char-by-name-group)
+	 (completions-format (if read-char-by-name-group 'one-column completions-format))
 	 (input
 	  (completing-read
 	   prompt
@@ -3189,10 +3167,11 @@ read-char-by-name
 		   (display-sort-function
 		    . ,(when (eq read-char-by-name-sort 'code)
                          #'mule--ucs-names-sort-by-code))
+		   (group-function
+		    . ,(when read-char-by-name-group
+			 #'mule--ucs-names-group))
 		   (affixation-function
-		    . ,(if read-char-by-name-group
-                           #'mule--ucs-names-group
-                         #'mule--ucs-names-affixation))
+		    . ,#'mule--ucs-names-affixation)
 		   (category . unicode-name))
 	       (complete-with-action action (ucs-names) string pred)))))
 	 (char

Re: [PATCH] `completing-read`: Add `group-function` support to completion metadata (REVISED PATCH)

[Daniel Mendler]

On 4/29/21 6:20 PM, Juri Linkov wrote:
>> You can try the patch with the following settings and execute
>> `xref-find-references` for example (M-?).
> 
> I tried to use your patch to implement grouping for read-char-by-name.
> It helped to greatly reduce the size of mule--ucs-names-group
> from 30 lines to just 3 lines that is a big win.

That's a nice advantage!

> OTOH, it highlighted the shortcomings of amalgamating both
> grouping and transforming in the same function:
> mule--ucs-names-group doesn't need to provide transformation,
> because the same affixation-function is used for both
> grouping and non-grouping completions.  So for such cases
> handling an additional arg `transform` is an extra burden:

True, but the burden is fairly minor (2 lines). If we go with a separate
`group-transform-function`, the complexity of the code of the completion
UIs will be increased and it will take a tiny bit more code for the
completion tables which provide a transformation. I don't see a
convincing advantage in splitting the single feature into two functions
`group-sort/transform-function`. As I argued we cannot combine a
separate `group-function` and a generic `transform/format-function`,
since the group-specific transformation should only be applied when
grouping is used. Otherwise the transformation may remove/hide
information from the candidate which is supposed to be displayed in the
title.

Daniel

Re: [PATCH] `completing-read`: Add `group-function` support to completion metadata (REVISED PATCH)

[Stefan Monnier]

> OTOH, it highlighted the shortcomings of amalgamating both
> grouping and transforming in the same function:
> mule--ucs-names-group doesn't need to provide transformation,
> because the same affixation-function is used for both
> grouping and non-grouping completions.

The purpose of the `group-function` when called with a non-nil
`transform` arg is not to *add* text but on the contrary to make the
entries shorter (presumably by removing text shared by all elements of
the group and made redundant by the group name being printed as
a "section title").

So the purpose of `affixation/annotation-function` and `group-function`
seem orthogonal (tho we should be careful to make them work together:
the affixation/annotation function will usually need the "full name" in
order to decide what to add, but that the thing should be added to the
text as shortened by `group-function`).


        Stefan

Re: [PATCH] `completing-read`: Add `group-function` support to completion metadata (REVISED PATCH)

[Daniel Mendler]

On 4/29/21 7:07 PM, Stefan Monnier wrote:
> The purpose of the `group-function` when called with a non-nil
> `transform` arg is not to *add* text but on the contrary to make the
> entries shorter (presumably by removing text shared by all elements of
> the group and made redundant by the group name being printed as
> a "section title").
> 
> So the purpose of `affixation/annotation-function` and `group-function`
> seem orthogonal (tho we should be careful to make them work together:
> the affixation/annotation function will usually need the "full name" in
> order to decide what to add, but that the thing should be added to the
> text as shortened by `group-function`).

Exactly, the grouping and affixation transformation functions are
orthogonal and should not be conflated. The patch I provided ensures
that the two features work well together - in both cases, with grouping
enabled and disabled.

Daniel

Re: [PATCH] `completing-read`: Add `group-function` support to completion metadata (REVISED PATCH)

[Juri Linkov]

>> So the purpose of `affixation/annotation-function` and `group-function`
>> seem orthogonal (tho we should be careful to make them work together:
>> the affixation/annotation function will usually need the "full name" in
>> order to decide what to add, but that the thing should be added to the
>> text as shortened by `group-function`).
>
> Exactly, the grouping and affixation transformation functions are
> orthogonal and should not be conflated. The patch I provided ensures
> that the two features work well together - in both cases, with grouping
> enabled and disabled.

I agree.

Then there are only minor details remaining:

1. for read-char-by-name, the first candidate of a group
   is displayed at the end of the same line with the group title
   (perhaps easy to fix);

2. it would be nice to support vertical/horizontal formats
   inside every group, not only one-column.

Re: [PATCH] `completing-read`: Add `group-function` support to completion metadata (REVISED PATCH VERSION 2)

[Daniel Mendler]

[-- Attachment #1: Type: text/plain, Size: 1158 bytes --]

On 4/30/21 12:54 AM, Juri Linkov wrote:
> Then there are only minor details remaining:
> 
> 1. for read-char-by-name, the first candidate of a group
>    is displayed at the end of the same line with the group title
>    (perhaps easy to fix);

I fixed this. There was a missing "\n" after the group titles.

> 2. it would be nice to support vertical/horizontal formats
>    inside every group, not only one-column.

Yes, this should be added. The current patch contains a TODO above the
`completion--insert-strings` function. I intend to rework the
`completion--insert-strings` function, splitting it into three
functions, one for each format. This should make this code easier to
maintain. Then I will also add support for group titles. I will
implement a second patch, which implements these changes.

I attached the current version of the patch (REVISED PATCH VERSION 2).
In comparison to the previous "REVISED PATCH" I made minor
cleanups and changes and fixed the "\n" issue you noticed. There is the
question if the `completions-detailed` variable should be reused to also
guard the grouping (See the NOTE in the commit message of the patch).

Daniel

[-- Attachment #2: 0001-completing-read-Add-group-function-to-completion-met.patch --]
[-- Type: text/x-diff, Size: 18849 bytes --]

From 86caf835bf491660e3d29058b94a7fd52fbe91f4 Mon Sep 17 00:00:00 2001
From: Daniel Mendler <mail@daniel-mendler.de>
Date: Sun, 25 Apr 2021 13:07:29 +0200
Subject: [PATCH] (completing-read): Add `group-function` to completion
 metadata

(NOTE: There is also the guard variable `completions-detailed`. This
variable is used to guard a *single usage* of the
`affixation-function`. This variable could be generalized to guard
both affixations and grouping.  Instead of checking the variable
invidually in each completion table, the check could be performed in
minibuffer.el)

A completion table can specify a `group-function` in its metadata.
The group function takes two arguments, a completion candidate and a
transform argument. The group function is used to group the candidates
after sorting and to enhance the completion UI with group titles.

If the transform argument is nil, the function must return the title
of the group to which the completion candidate belongs. The function
may also return nil in case the candidate does not belong to a group.

Otherwise the function must return the transformed candidate. The
transformation allows for example to remove a part of the candidate,
which is then displayed in the title.

The grouping functionality guarded by the variable `completions-group`
and turned off by default for the *Completions* buffer.

The specific form of the `group-function` has been chosen in order to
allow allocation-free grouping. This is important for completion UIs,
which continously update the displayed set of candidates (Icomplete,
Vertico, Ivy, etc.). Only when the transform argument is non-nil the
candidate transformation is performed, which may involve a string
allocation as for example in `xref--completing-read-group`.

The function `xref-show-definitions-completing-read` makes use of the
`group-function`, by moving the file name prefix to the title. If
grouping is enabled, the *Completions* are displayed as
"linenum:summary" instead of "file:linenum:summary". This way the
*Completions* buffer resembles the *Occur* buffer.

* doc/lispref/minibuf.texi: Add documentation.

* lisp/minibuffer.el (completion-metadata): Describe `group-function`
in the docstring.
(completions-group): Add guard variable, by default off.
(completions-group-format): Add format string for group titles.
(completions-group-title): Add face for group titles.
(completions-group-separator): Add face for group separator.
(minibuffer--group-by): New grouping function.
(minibuffer-completion-help): Use it.
(display-completion-list): Add optional GROUP-FUN argument.
(completion--insert-strings): Add optional GROUP-FUN argument. Insert
group titles if `completions-format` is `one-column`. Transform each
candidate with the GROUP-FUN. Attach the untransformed candidate to
the property `completion--string`.

* lisp/simple.el (choose-completion): Retrieve the untransformed
completion candidate from the property `completion--string`.

* lisp/progmodes/xref.el:
(xref--completing-read-group): New grouping function.
(xref-show-definitions-completing-read): Use it.
---
 doc/lispref/minibuf.texi |  10 ++++
 lisp/minibuffer.el       | 123 ++++++++++++++++++++++++++++++++-------
 lisp/progmodes/xref.el   |  18 ++++--
 lisp/simple.el           |  11 ++--
 4 files changed, 131 insertions(+), 31 deletions(-)

diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi
index bc8868b58d..ca01c418ad 100644
--- a/doc/lispref/minibuf.texi
+++ b/doc/lispref/minibuf.texi
@@ -1943,6 +1943,16 @@ Programmed Completion
 a suffix displayed after the completion string.  This function
 takes priority over @code{annotation-function}.
 
+@item group-function
+The value should be a function for grouping the completion candidates.
+The function must take two arguments, @var{completion}, which is a
+completion candidate and @var{transform}, which is a boolean flag.  If
+@var{transform} is @code{nil}, the function must return a group title,
+to which the candidate belongs. The returned title can also
+@code{nil}.  Otherwise the function must return the transformed
+candidate. The transformation can for example remove a redundant
+prefix, which is displayed in the group title instead.
+
 @item display-sort-function
 The value should be a function for sorting completions.  The function
 should take one argument, a list of completion strings, and return a
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 2400624953..c1f6a7d64e 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -126,6 +126,13 @@ completion-metadata
    three-element lists: completion, its prefix and suffix.  This
    function takes priority over `annotation-function' when both are
    provided, so only this function is used.
+- `group-function': function for grouping the completion candidates.
+   Takes two arguments: a completion candidate (COMPLETION) and a
+   boolean flag (TRANSFORM).  If TRANSFORM is nil, the function
+   returns a group title, to which the candidate belongs.  The
+   returned title may be nil.  Otherwise the function returns the
+   transformed candidate.  The transformation can remove a redundant
+   prefix, which is displayed in the group title instead.
 - `display-sort-function': function to sort entries in *Completions*.
    Takes one argument (COMPLETIONS) and should return a new list
    of completions.  Can operate destructively.
@@ -1138,6 +1145,30 @@ completion-cycle-threshold
   :version "24.1"
   :type completion--cycling-threshold-type)
 
+(defcustom completions-group nil
+  "Enable grouping of completion candidates in the *Completions* buffer.
+See also `completions-group-format'."
+  :type 'boolean
+  :version "28.1")
+
+(defcustom completions-group-format
+  (concat
+   (propertize "    " 'face 'completions-group-separator)
+   (propertize " %s " 'face 'completions-group-title)
+   (propertize " " 'face 'completions-group-separator
+               'display '(space :align-to right)))
+  "Format string used for the group title."
+  :type 'string
+  :version "28.1")
+
+(defface completions-group-title '((t :inherit shadow :slant italic))
+  "Face used for the title text of the candidate group headlines."
+  :version "28.1")
+
+(defface completions-group-separator '((t :inherit shadow :strike-through t))
+  "Face used for the separator lines of the candidate groups."
+  :version "28.1")
+
 (defun completion--cycle-threshold (metadata)
   (let* ((cat (completion-metadata-get metadata 'category))
          (over (completion--category-override cat 'cycle)))
@@ -1401,6 +1432,17 @@ minibuffer--sort-preprocess-history
                      (substring c base-size)))
                  hist)))))
 
+(defun minibuffer--group-by (fun elems)
+  "Group ELEMS by FUN."
+  (let ((groups))
+    (dolist (cand elems)
+      (let* ((key (funcall fun cand nil))
+             (group (assoc key groups)))
+        (if group
+            (setcdr group (cons cand (cdr group)))
+          (push (list key cand) groups))))
+    (mapcan (lambda (x) (nreverse (cdr x))) (nreverse groups))))
+
 (defun completion-all-sorted-completions (&optional start end)
   (or completion-all-sorted-completions
       (let* ((start (or start (minibuffer-prompt-end)))
@@ -1747,11 +1789,17 @@ completions-detailed
   :type 'boolean
   :version "28.1")
 
-(defun completion--insert-strings (strings)
+;; TODO: Split up this function in one function per `completions-format'.
+;; TODO: Add group title support for horizontal and vertical format.
+(defun completion--insert-strings (strings &optional group-fun)
   "Insert a list of STRINGS into the current buffer.
-Uses columns to keep the listing readable but compact.
-It also eliminates runs of equal strings."
+Uses columns to keep the listing readable but compact.  It also
+eliminates runs of equal strings.  GROUP-FUN is a `group-function'
+used for grouping the completion."
   (when (consp strings)
+    ;; FIXME: Currently grouping is enabled only for the 'one-column format.
+    (unless (eq completions-format 'one-column)
+      (setq group-fun nil))
     (let* ((length (apply #'max
 			  (mapcar (lambda (s)
 				    (if (consp s)
@@ -1768,6 +1816,7 @@ completion--insert-strings
 		     (max 1 (/ (length strings) 2))))
 	   (colwidth (/ wwidth columns))
            (column 0)
+           (last-title nil)
 	   (rows (/ (length strings) columns))
 	   (row 0)
            (first t)
@@ -1780,6 +1829,13 @@ completion--insert-strings
       ;; The insertion should be "sensible" no matter what choices were made
       ;; for the parameters above.
       (dolist (str strings)
+        ;; Add group titles.
+        (when group-fun
+          (let ((title (funcall group-fun (if (consp str) (car str) str) nil)))
+            (unless (equal title last-title)
+              (when title
+                (insert (format completions-group-format title) "\n"))
+              (setq last-title title))))
 	(unless (equal laststring str) ; Remove (consecutive) duplicates.
 	  (setq laststring str)
           ;; FIXME: `string-width' doesn't pay attention to
@@ -1825,8 +1881,15 @@ completion--insert-strings
 		  nil))))
             (setq first nil)
             (if (not (consp str))
-                (put-text-property (point) (progn (insert str) (point))
-                                   'mouse-face 'highlight)
+                (add-text-properties
+                 (point)
+                 (progn
+                   (insert
+                    (if group-fun
+                        (funcall group-fun str 'transform)
+                      str))
+                   (point))
+                 `(mouse-face highlight completion--string ,str))
               ;; If `str' is a list that has 2 elements,
               ;; then the second element is a suffix annotation.
               ;; If `str' has 3 elements, then the second element
@@ -1837,8 +1900,15 @@ completion--insert-strings
                   (let ((beg (point))
                         (end (progn (insert prefix) (point))))
                     (put-text-property beg end 'mouse-face nil)))
-                (put-text-property (point) (progn (insert (car str)) (point))
-                                   'mouse-face 'highlight)
+                (add-text-properties
+                 (point)
+                 (progn
+                   (insert
+                    (if group-fun
+                         (funcall group-fun (car str) 'transform)
+                      (car str)))
+                   (point))
+                 `(mouse-face highlight completion--string ,(car str)))
                 (let ((beg (point))
                       (end (progn (insert suffix) (point))))
                   (put-text-property beg end 'mouse-face nil)
@@ -1923,7 +1993,7 @@ completion-hilit-commonality
         completions)
        base-size))))
 
-(defun display-completion-list (completions &optional common-substring)
+(defun display-completion-list (completions &optional common-substring group-fun)
   "Display the list of completions, COMPLETIONS, using `standard-output'.
 Each element may be just a symbol or string
 or may be a list of two strings to be printed as if concatenated.
@@ -1933,7 +2003,8 @@ display-completion-list
 The actual completion alternatives, as inserted, are given `mouse-face'
 properties of `highlight'.
 At the end, this runs the normal hook `completion-setup-hook'.
-It can find the completion buffer in `standard-output'."
+It can find the completion buffer in `standard-output'.
+GROUP-FUN is a `group-function' used for grouping the completion."
   (declare (advertised-calling-convention (completions) "24.4"))
   (if common-substring
       (setq completions (completion-hilit-commonality
@@ -1946,7 +2017,7 @@ display-completion-list
 	(let ((standard-output (current-buffer))
 	      (completion-setup-hook nil))
           (with-suppressed-warnings ((callargs display-completion-list))
-	    (display-completion-list completions common-substring)))
+	    (display-completion-list completions common-substring group-fun)))
 	(princ (buffer-string)))
 
     (with-current-buffer standard-output
@@ -1954,7 +2025,7 @@ display-completion-list
       (if (null completions)
           (insert "There are no possible completions of what you have typed.")
         (insert "Possible completions are:\n")
-        (completion--insert-strings completions))))
+        (completion--insert-strings completions group-fun))))
 
   (run-hooks 'completion-setup-hook)
   nil)
@@ -2067,6 +2138,9 @@ minibuffer-completion-help
              (aff-fun (or (completion-metadata-get all-md 'affixation-function)
                           (plist-get completion-extra-properties
                                      :affixation-function)))
+             (sort-fun (completion-metadata-get all-md 'display-sort-function))
+             (group-fun (and completions-group
+                             (completion-metadata-get all-md 'group-function)))
              (mainbuf (current-buffer))
              ;; If the *Completions* buffer is shown in a new
              ;; window, mark it as softly-dedicated, so bury-buffer in
@@ -2098,15 +2172,22 @@ minibuffer-completion-help
                       ;; Remove the base-size tail because `sort' requires a properly
                       ;; nil-terminated list.
                       (when last (setcdr last nil))
-                      (setq completions
-                            ;; FIXME: This function is for the output of all-completions,
-                            ;; not completion-all-completions.  Often it's the same, but
-                            ;; not always.
-                            (let ((sort-fun (completion-metadata-get
-                                             all-md 'display-sort-function)))
-                              (if sort-fun
-                                  (funcall sort-fun completions)
-                                (sort completions 'string-lessp))))
+
+                      ;; Sort first using the `display-sort-function'.
+                      ;; FIXME: This function is for the output of
+                      ;; all-completions, not
+                      ;; completion-all-completions.  Often it's the
+                      ;; same, but not always.
+                      (setq completions (if sort-fun
+                                            (funcall sort-fun completions)
+                                          (sort completions 'string-lessp)))
+
+                      ;; After sorting, group the candidates using the
+                      ;; `group-function'.
+                      (when group-fun
+                        (setq completions
+                              (minibuffer--group-by group-fun completions)))
+
                       (cond
                        (aff-fun
                         (setq completions
@@ -2152,7 +2233,7 @@ minibuffer-completion-help
                                                      (if (eq (car bounds) (length result))
                                                          'exact 'finished)))))))
 
-                      (display-completion-list completions)))))
+                      (display-completion-list completions nil group-fun)))))
           nil)))
     nil))
 
diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el
index 7fc7181acc..2a4fb2c417 100644
--- a/lisp/progmodes/xref.el
+++ b/lisp/progmodes/xref.el
@@ -1044,6 +1044,12 @@ xref-show-definitions-buffer-at-bottom
 (define-obsolete-function-alias 'xref--show-defs-buffer-at-bottom
   #'xref-show-definitions-buffer-at-bottom "28.1")
 
+(defun xref--completing-read-group (cand transform)
+  "Return group title of candidate CAND or TRANSFORM the candidate."
+  (if transform
+      (substring cand (1+ (next-single-property-change 0 'xref--group cand)))
+    (get-text-property 0 'xref--group cand)))
+
 (defun xref-show-definitions-completing-read (fetcher alist)
   "Let the user choose the target definition with completion.
 
@@ -1072,10 +1078,12 @@ xref-show-definitions-completing-read
                                     (format #("%d:" 0 2 (face xref-line-number))
                                             line)
                                   ""))
+                               (group-prefix
+                                (substring group group-prefix-length))
                                (group-fmt
-                                (propertize
-                                 (substring group group-prefix-length)
-                                 'face 'xref-file-header))
+                                (propertize group-prefix
+                                            'face 'xref-file-header
+                                            'xref--group group-prefix))
                                (candidate
                                 (format "%s:%s%s" group-fmt line-fmt summary)))
                           (push (cons candidate xref) xref-alist-with-line-info)))))
@@ -1087,7 +1095,9 @@ xref-show-definitions-completing-read
                          (lambda (string pred action)
                            (cond
                             ((eq action 'metadata)
-                             '(metadata . ((category . xref-location))))
+                             `(metadata
+                               . ((category . xref-location)
+                                  (group-function . ,#'xref--completing-read-group))))
                             (t
                              (complete-with-action action collection string pred)))))
                         (def (caar collection)))
diff --git a/lisp/simple.el b/lisp/simple.el
index 26eb8cad7f..ad36ad5a3e 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -8867,18 +8867,17 @@ choose-completion
           (choice
            (save-excursion
              (goto-char (posn-point (event-start event)))
-             (let (beg end)
+             (let (beg)
                (cond
                 ((and (not (eobp)) (get-text-property (point) 'mouse-face))
-                 (setq end (point) beg (1+ (point))))
+                 (setq beg (1+ (point))))
                 ((and (not (bobp))
                       (get-text-property (1- (point)) 'mouse-face))
-                 (setq end (1- (point)) beg (point)))
+                 (setq beg (point)))
                 (t (error "No completion here")))
                (setq beg (previous-single-property-change beg 'mouse-face))
-               (setq end (or (next-single-property-change end 'mouse-face)
-                             (point-max)))
-               (buffer-substring-no-properties beg end)))))
+               (substring-no-properties
+                (get-text-property beg 'completion--string))))))
 
       (unless (buffer-live-p buffer)
         (error "Destination buffer is dead"))
-- 
2.20.1

Re: [PATCH] `completing-read`: Add `group-function` support to completion metadata (REVISED PATCH VERSION 2)

[Daniel Mendler]

[-- Attachment #1: Type: text/plain, Size: 621 bytes --]

On 4/30/21 1:55 AM, Daniel Mendler wrote:
> Yes, this should be added. The current patch contains a TODO above the
> `completion--insert-strings` function. I intend to rework the
> `completion--insert-strings` function, splitting it into three
> functions, one for each format. This should make this code easier to
> maintain. Then I will also add support for group titles. I will
> implement a second patch, which implements these changes.

I attached the patch which splits `completion--insert-strings` into a
function per completions format and adds group title support for the
vertical and horizontal format.

Daniel

[-- Attachment #2: 0002-completion-insert-strings-Split-function-Full-group-.patch --]
[-- Type: text/x-diff, Size: 13454 bytes --]

From 48c8a45ced265812a8aa6bbaf23bc17b5c3b3da4 Mon Sep 17 00:00:00 2001
From: Daniel Mendler <mail@daniel-mendler.de>
Date: Fri, 30 Apr 2021 08:40:59 +0200
Subject: [PATCH] (completion--insert-strings): Split function; Full group
 title support

Split `completion--insert-strings` into a function per completions
format in order to increase readability and extensibility. This change
eases the addition of more formats. Add support for group titles to
the vertical and horizontal format.

* minibuffer.el (completion--insert): Add new function.
(completion--insert-vertical, completion--insert-horizontal,
completion--insert-one-column): Extract new function from
`completion--insert-strings`. Use `completion--insert`.
(completion--insert-strings): Use new insertion functions.
---
 lisp/minibuffer.el | 269 ++++++++++++++++++++++++++-------------------
 1 file changed, 154 insertions(+), 115 deletions(-)

diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index c1f6a7d64e..986657e7ad 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -1789,21 +1789,16 @@ completions-detailed
   :type 'boolean
   :version "28.1")
 
-;; TODO: Split up this function in one function per `completions-format'.
-;; TODO: Add group title support for horizontal and vertical format.
 (defun completion--insert-strings (strings &optional group-fun)
   "Insert a list of STRINGS into the current buffer.
 Uses columns to keep the listing readable but compact.  It also
 eliminates runs of equal strings.  GROUP-FUN is a `group-function'
 used for grouping the completion."
   (when (consp strings)
-    ;; FIXME: Currently grouping is enabled only for the 'one-column format.
-    (unless (eq completions-format 'one-column)
-      (setq group-fun nil))
     (let* ((length (apply #'max
 			  (mapcar (lambda (s)
 				    (if (consp s)
-					(apply #'+ (mapcar #'string-width s))
+				        (apply #'+ (mapcar #'string-width s))
 				      (string-width s)))
 				  strings)))
 	   (window (get-buffer-window (current-buffer) 0))
@@ -1814,126 +1809,170 @@ completion--insert-strings
 		     ;; Don't allocate more columns than we can fill.
 		     ;; Windows can't show less than 3 lines anyway.
 		     (max 1 (/ (length strings) 2))))
-	   (colwidth (/ wwidth columns))
-           (column 0)
-           (last-title nil)
-	   (rows (/ (length strings) columns))
-	   (row 0)
-           (first t)
-	   (laststring nil))
+	   (colwidth (/ wwidth columns)))
       (unless (or tab-stop-list (null completion-tab-width)
                   (zerop (mod colwidth completion-tab-width)))
         ;; Align to tab positions for the case
         ;; when the caller uses tabs inside prefix.
         (setq colwidth (- colwidth (mod colwidth completion-tab-width))))
-      ;; The insertion should be "sensible" no matter what choices were made
-      ;; for the parameters above.
-      (dolist (str strings)
-        ;; Add group titles.
+      (funcall (intern (format "completion--insert-%s" completions-format))
+               strings group-fun length wwidth colwidth columns))))
+
+(defun completion--insert-horizontal (strings group-fun
+                                              length wwidth
+                                              colwidth _columns)
+  (let ((column 0)
+        (first t)
+	(last-title nil)
+        (last-string nil))
+    (dolist (str strings)
+      (unless (equal last-string str) ; Remove (consecutive) duplicates.
+	(setq last-string str)
         (when group-fun
           (let ((title (funcall group-fun (if (consp str) (car str) str) nil)))
             (unless (equal title last-title)
+              (setq last-title title)
               (when title
-                (insert (format completions-group-format title) "\n"))
-              (setq last-title title))))
-	(unless (equal laststring str) ; Remove (consecutive) duplicates.
-	  (setq laststring str)
+                (insert (if first "" "\n") (format completions-group-format title) "\n")
+                (setq column 0
+                      first t)))))
+	(unless first
           ;; FIXME: `string-width' doesn't pay attention to
           ;; `display' properties.
-          (let ((length (if (consp str)
-                            (apply #'+ (mapcar #'string-width str))
-                          (string-width str))))
-            (cond
-             ((eq completions-format 'one-column)
-              ;; Nothing special
-              )
-	     ((eq completions-format 'vertical)
-	      ;; Vertical format
-	      (when (> row rows)
-		(forward-line (- -1 rows))
-		(setq row 0 column (+ column colwidth)))
-	      (when (> column 0)
-		(end-of-line)
-		(while (> (current-column) column)
-		  (if (eobp)
-		      (insert "\n")
-		    (forward-line 1)
-		    (end-of-line)))
-		(insert " \t")
-		(set-text-properties (1- (point)) (point)
-				     `(display (space :align-to ,column)))))
-	     (t
-	      ;; Horizontal format
-	      (unless first
-		(if (< wwidth (+ (max colwidth length) column))
-		    ;; No space for `str' at point, move to next line.
-		    (progn (insert "\n") (setq column 0))
-		  (insert " \t")
-		  ;; Leave the space unpropertized so that in the case we're
-		  ;; already past the goal column, there is still
-		  ;; a space displayed.
-		  (set-text-properties (1- (point)) (point)
-				       ;; We can set tab-width using
-				       ;; completion-tab-width, but
-				       ;; the caller can prefer using
-				       ;; \t to align prefixes.
-				       `(display (space :align-to ,column)))
-		  nil))))
-            (setq first nil)
-            (if (not (consp str))
-                (add-text-properties
-                 (point)
-                 (progn
-                   (insert
-                    (if group-fun
-                        (funcall group-fun str 'transform)
-                      str))
-                   (point))
-                 `(mouse-face highlight completion--string ,str))
-              ;; If `str' is a list that has 2 elements,
-              ;; then the second element is a suffix annotation.
-              ;; If `str' has 3 elements, then the second element
-              ;; is a prefix, and the third element is a suffix.
-              (let* ((prefix (when (nth 2 str) (nth 1 str)))
-                     (suffix (or (nth 2 str) (nth 1 str))))
-                (when prefix
-                  (let ((beg (point))
-                        (end (progn (insert prefix) (point))))
-                    (put-text-property beg end 'mouse-face nil)))
-                (add-text-properties
-                 (point)
-                 (progn
-                   (insert
-                    (if group-fun
-                         (funcall group-fun (car str) 'transform)
-                      (car str)))
-                   (point))
-                 `(mouse-face highlight completion--string ,(car str)))
-                (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 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
-             ((eq completions-format 'one-column)
-              (insert "\n"))
-	     ((eq completions-format 'vertical)
-	      ;; Vertical format
-	      (if (> column 0)
-		  (forward-line)
-		(insert "\n"))
-	      (setq row (1+ row)))
-	     (t
-	      ;; Horizontal format
-	      ;; Next column to align to.
-	      (setq column (+ column
-			      ;; Round up to a whole number of columns.
-			      (* colwidth (ceiling length colwidth))))))))))))
+	  (if (< wwidth (+ column (max colwidth
+                                       (if (consp str)
+                                           (apply #'+ (mapcar #'string-width str))
+                                         (string-width str)))))
+	      ;; No space for `str' at point, move to next line.
+	      (progn (insert "\n") (setq column 0))
+	    (insert " \t")
+	    ;; Leave the space unpropertized so that in the case we're
+	    ;; already past the goal column, there is still
+	    ;; a space displayed.
+	    (set-text-properties (1- (point)) (point)
+				 ;; We can set tab-width using
+				 ;; completion-tab-width, but
+				 ;; the caller can prefer using
+				 ;; \t to align prefixes.
+				 `(display (space :align-to ,column)))
+	    nil))
+        (setq first nil)
+        (completion--insert str group-fun)
+	;; Next column to align to.
+	(setq column (+ column
+			;; Round up to a whole number of columns.
+			(* colwidth (ceiling length colwidth))))))))
+
+(defun completion--insert-vertical (strings group-fun
+                                            _length _wwidth
+                                            colwidth columns)
+  (let ((column 0)
+        (rows (/ (length strings) columns))
+	(row 0)
+	(last-title nil)
+	(last-string nil)
+        (start-point (point))
+        (next 0) (pos 0))
+    (dolist (str strings)
+      (unless (equal last-string str) ; Remove (consecutive) duplicates.
+	(setq last-string str)
+	(when (> row rows)
+	  (goto-char start-point)
+	  (setq row 0 column (+ column colwidth)))
+        (when group-fun
+          (let ((title (funcall group-fun (if (consp str) (car str) str) nil)))
+            (unless (equal title last-title)
+              (setq last-title title)
+              (when title
+                ;; Align before title insertion
+	        (when (> column 0)
+	          (end-of-line)
+	          (while (> (current-column) column)
+	            (if (eobp)
+		        (insert "\n")
+	              (forward-line 1)
+	              (end-of-line)))
+	          (insert " \t")
+	          (set-text-properties (1- (point)) (point)
+			               `(display (space :align-to ,column))))
+                (let* ((fmt completions-group-format)
+                       (len (length fmt)))
+                  ;; Adjust display space for columns
+                  (when (equal (get-text-property (- len 1) 'display fmt) '(space :align-to right))
+                    (setq fmt (substring fmt))
+                    (put-text-property (- len 1) len
+                                       'display
+                                       `(space :align-to ,(+ colwidth column -1))
+                                       fmt))
+                  (insert (format fmt title)))
+                ;; Align after title insertion
+	        (if (> column 0)
+	            (forward-line)
+	          (insert "\n"))))))
+        ;; Align before candidate insertion
+	(when (> column 0)
+	  (end-of-line)
+	  (while (> (current-column) column)
+	    (if (eobp)
+		(insert "\n")
+	      (forward-line 1)
+	      (end-of-line)))
+	  (insert " \t")
+	  (set-text-properties (1- (point)) (point)
+			       `(display (space :align-to ,column))))
+        (completion--insert str group-fun)
+        ;; Align after candidate insertion
+	(if (> column 0)
+	    (forward-line)
+	  (insert "\n"))
+	(setq row (1+ row))))))
+
+(defun completion--insert-one-column (strings group-fun &rest _)
+  (let ((last-title nil) (last-string nil))
+    (dolist (str strings)
+      (unless (equal last-string str) ; Remove (consecutive) duplicates.
+	(setq last-string str)
+        (when group-fun
+          (let ((title (funcall group-fun (if (consp str) (car str) str) nil)))
+            (unless (equal title last-title)
+              (setq last-title title)
+              (when title
+                (insert (format completions-group-format title) "\n")))))
+        (completion--insert str group-fun)
+        (insert "\n")))))
+
+(defun completion--insert (str group-fun)
+  (if (not (consp str))
+      (add-text-properties
+       (point)
+       (progn
+         (insert
+          (if group-fun
+              (funcall group-fun str 'transform)
+            str))
+         (point))
+       `(mouse-face highlight completion--string ,str))
+    ;; If `str' is a list that has 2 elements,
+    ;; then the second element is a suffix annotation.
+    ;; If `str' has 3 elements, then the second element
+    ;; is a prefix, and the third element is a suffix.
+    (let* ((prefix (when (nth 2 str) (nth 1 str)))
+           (suffix (or (nth 2 str) (nth 1 str))))
+      (when prefix
+        (let ((beg (point))
+              (end (progn (insert prefix) (point))))
+          (put-text-property beg end 'mouse-face nil)))
+      (completion--insert (car str) group-fun)
+      (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 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))))))
 
 (defvar completion-setup-hook nil
   "Normal hook run at the end of setting up a completion list buffer.
-- 
2.20.1

Re: [PATCH] `completing-read`: Add `group-function` support to completion metadata (REVISED PATCH VERSION 2)

[Juri Linkov]

> I attached the patch which splits `completion--insert-strings` into a
> function per completions format and adds group title support for the
> vertical and horizontal format.

Thanks, I tested the vertical and horizontal format,
and the horizontal format is displayed nicely, but I expected
that in the vertical format completions inside every group
to be arranged the same way as in horizontal format, e.g.
everything is fine in the horizontal format:

--- group1 ---
1 2
3 4
--- group2 ---
5 6
7 8

whereas the vertical format is expected to be like:

--- group1 ---
1 3
2 4
--- group2 ---
5 7
6 8

But with the latest patch it's:

--- group1 ---   6
1                7
2                8
3                --- group3 ---
4                9
--- group2 ---   10
5                11
                 12

Re: [PATCH] `completing-read`: Add `group-function` support to completion metadata (REVISED PATCH VERSION 2)

[Daniel Mendler]

On 4/30/21 7:01 PM, Juri Linkov wrote:
> Thanks, I tested the vertical and horizontal format,
> and the horizontal format is displayed nicely, but I expected
> that in the vertical format completions inside every group
> to be arranged the same way as in horizontal format, e.g.
> everything is fine in the horizontal format:

Yes, this is intentional. I assume that one would want to have headers
per column as in a two column paper layout for example. We can also use
the different layout if that is preferred.

Daniel

Re: [PATCH] `completing-read`: Add `group-function` support to completion metadata (REVISED PATCH VERSION 2)

[Daniel Mendler]

On 4/30/21 8:11 PM, Daniel Mendler wrote:
> On 4/30/21 7:01 PM, Juri Linkov wrote:
>> Thanks, I tested the vertical and horizontal format,
>> and the horizontal format is displayed nicely, but I expected
>> that in the vertical format completions inside every group
>> to be arranged the same way as in horizontal format, e.g.
>> everything is fine in the horizontal format:
> 
> Yes, this is intentional. I assume that one would want to have headers
> per column as in a two column paper layout for example. We can also use
> the different layout if that is preferred.

I believe the arrangement I am using in the current patch is is the more
natural one.

For the horizontal layout we insert the candidates like this:

>>-----------\
             |
/------------/
|
\------------\
             |
/------------/
|
\----------->>

For the vertical layout we insert the candidates like this:

v  /--\  /--\
v  |  |  |  |
|  |  |  |  |
|  |  |  |  |
|  |  |  |  v
\--/  \--/  v

What you proposed for the vertical layout would look like this

v  /--\  /--\
v  |  |  |  |
|  |  |  |  v
\--/  \--/  v
=============
v  /--\  /--\
v  |  |  |  |
|  |  |  |  v
\--/  \--/  v
=============
v  /--\  /--\
v  |  |  |  |
|  |  |  |  v
\--/  \--/  v

This seems to me like a mix of vertical and horizontal layout.

Daniel

Re: [PATCH] `completing-read`: Add `group-function` support to completion metadata (REVISED PATCH VERSION 2)

[Juri Linkov]

>>> Thanks, I tested the vertical and horizontal format,
>>> and the horizontal format is displayed nicely, but I expected
>>> that in the vertical format completions inside every group
>>> to be arranged the same way as in horizontal format, e.g.
>>> everything is fine in the horizontal format:
>>
>> Yes, this is intentional. I assume that one would want to have headers
>> per column as in a two column paper layout for example. We can also use
>> the different layout if that is preferred.
>
> I believe the arrangement I am using in the current patch is is the more
> natural one.
>
> What you proposed for the vertical layout would look like this
>
> v  /--\  /--\
> v  |  |  |  |
> |  |  |  |  v
> \--/  \--/  v
> =============
> v  /--\  /--\
> v  |  |  |  |
> |  |  |  |  v
> \--/  \--/  v
> =============
> v  /--\  /--\
> v  |  |  |  |
> |  |  |  |  v
> \--/  \--/  v
>
> This seems to me like a mix of vertical and horizontal layout.

It's still the vertical layout but with grouping
similar to how you sort candidates in every group,
only here the per-group candidates are arranged vertically.

Maybe this choice could be handled by an option?

Re: [PATCH] `completing-read`: Add `group-function` support to completion metadata (REVISED PATCH VERSION 2)

[Daniel Mendler]

On 5/1/21 9:57 PM, Juri Linkov wrote:>> This seems to me like a mix of
vertical and horizontal layout.
> 
> It's still the vertical layout but with grouping
> similar to how you sort candidates in every group,
> only here the per-group candidates are arranged vertically.
> 
> Maybe this choice could be handled by an option?

Of course, we can add options to allow fine tuning of every behavior.
While I like the tuneability of Emacs I am not sure if it is advised to
make every tiny bit configurable. The way I wrote the current patch
allows the addition of custom `completions--insert-*` functions.
Furthermore there is always the advice mechanism, the possibility to
override functions etc, so I don't feel the need to add configurations
for every detail.

In my patch, I made this choice since it seemed more natural given the
distinction of horizontal and vertical insertion. By using a more
horizontal-like grouping, the distinction between the styles would be
less pronounced. However the arrangement you proposed is also
reasonable. I don't feel strongly about this and I am not against
offering this as configurable option or even as sole option.

In the patches are there more concrete issues which need to be addressed?

Daniel

Re: [PATCH] `completing-read`: Add `group-function` support to completion metadata (REVISED PATCH VERSION 2)

[Eli Zaretskii]

> From: Daniel Mendler <mail@daniel-mendler.de>
> Date: Sun, 2 May 2021 02:43:20 +0200
> Cc: Gregory Heytings <gregory@heytings.org>, Dmitry Gutov <dgutov@yandex.ru>,
>  Stefan Monnier <monnier@iro.umontreal.ca>,
>  "emacs-devel@gnu.org" <emacs-devel@gnu.org>
> 
> > Maybe this choice could be handled by an option?
> 
> Of course, we can add options to allow fine tuning of every behavior.
> While I like the tuneability of Emacs I am not sure if it is advised to
> make every tiny bit configurable. The way I wrote the current patch
> allows the addition of custom `completions--insert-*` functions.
> Furthermore there is always the advice mechanism, the possibility to
> override functions etc, so I don't feel the need to add configurations
> for every detail.

We don't provide knobs for every behavior, indeed.  But where the
"right" behavior is a matter of personal preferences, and there are
large enough groups of people who may want either of the possible
behaviors, offering an option is TRT.  Advice is not a valid
replacement for a user option, because writing an advice is orders of
magnitude harder than flipping an option, and requires the user to be
proficient in ELisp.

Re: [PATCH] `completing-read`: Add `group-function` support to completion metadata (REVISED PATCH VERSION 2)

[Daniel Mendler]

On 5/2/21 9:07 AM, Eli Zaretskii wrote:
> We don't provide knobs for every behavior, indeed.  But where the
> "right" behavior is a matter of personal preferences, and there are
> large enough groups of people who may want either of the possible
> behaviors, offering an option is TRT.  Advice is not a valid
> replacement for a user option, because writing an advice is orders of
> magnitude harder than flipping an option, and requires the user to be
> proficient in ELisp.

I agree generally regarding advices and options. But here the user
already has the option to use the 'horizontal or 'vertical completions
format. My argument is that in case the user prefers to read
horizontally, the horizontal layout can be used and in case the user
prefers to read from top to bottom the vertical layout can be used.

1) horizontal

=group1=
cand1  cand2  cand3
cand4  cand5  cand6
=group2=
cand7  cand8  cand9
cand10 cand11 cand12

2) vertical

=group1=  =group2
cand1     cand7
cand2     cand8
cand3     cand9
cand4     cand10
cand5     cand11
cand6     cand12

3) vertical with horizontal grouping

=group1=
cand1     cand4
cand2     cand5
cand3     cand6
=group2=
cand7     cand11
cand8     cand12
cand9     cand13

For now didn't see the need to add 3), the vertical format plus
horizontal grouping, as proposed by Juri. If most people agree that
option 3) should be provided we can either add this as a separate
formatting function or as an option. It may be easier to implement this
as a fully separate `completion-insert--vertical+horizontal-grouping`
function. If 3) is the preference of most people I guess we should even
make this the default, in order to avoid to unnecessarily add
configuration options which will be used rarely.

I think a wait and see strategy may be better until we got more
experience where the feature will be put to good use. Juri implemented a
patch which adds grouping to the read-char-by-name function. I hope
there will be more use cases.

In my Consult package I have quite a few use cases for the grouping, but
these commands almost always work best with the 'one-column layout due
their rich annotation functions. My preference is also influenced by my
usage of vertical minibuffer completion UIs (Vertico, Selectrum, Ivy).
However in case the annotations are turned off, the vertical and
horizontal layouts should also work well with the commands.

Daniel

Re: [PATCH] `completing-read`: Add `group-function` support to completion metadata (REVISED PATCH VERSION 2)

[Juri Linkov]

> There is the question if the `completions-detailed` variable should be
> reused to also guard the grouping (See the NOTE in the commit message
> of the patch).

> (NOTE: There is also the guard variable `completions-detailed`. This
> variable is used to guard a *single usage* of the
> `affixation-function`. This variable could be generalized to guard
> both affixations and grouping.  Instead of checking the variable
> invidually in each completion table, the check could be performed in
> minibuffer.el)

Aren't affixations guarded by completions-detailed
and grouping guarded by completions-group orthogonal?
Then it should be fine to have separate options.

Re: [PATCH] `completing-read`: Add `group-function` support to completion metadata (REVISED PATCH VERSION 2)

[Daniel Mendler]

On 4/30/21 6:51 PM, Juri Linkov wrote:
> Aren't affixations guarded by completions-detailed
> and grouping guarded by completions-group orthogonal?
> Then it should be fine to have separate options.

Yes, they are orthogonal. I agree we can keep it as is. I still wanted
to point it out. And note the difference - the completions-group guard
variable is checked in minibuffer.el, while the completions-detailed
variable is checked in the completion table in help-fns.el. Maybe
completions-detailed should also be checked in the minibuffer.el instead?

Daniel

Re: [PATCH] `completing-read`: Add `group-function` support to completion metadata (REVISED PATCH VERSION 2)

[Juri Linkov]

>> Aren't affixations guarded by completions-detailed
>> and grouping guarded by completions-group orthogonal?
>> Then it should be fine to have separate options.
>
> Yes, they are orthogonal. I agree we can keep it as is. I still wanted
> to point it out. And note the difference - the completions-group guard
> variable is checked in minibuffer.el, while the completions-detailed
> variable is checked in the completion table in help-fns.el. Maybe
> completions-detailed should also be checked in the minibuffer.el instead?

I think both completions-detailed and completions-group should be
checked only by the API user like in help-fns.el.  Otherwise,
there is duplication that you can see in my previous patch
for read-char-by-name:

  (let* ((enable-recursive-minibuffers t)
	 (completion-ignore-case t)
	 (completion-tab-width 4)
	 (completions-group read-char-by-name-group)
                            =======================
	 (input
	  (completing-read
	   prompt
	   (lambda (string pred action)
	     (if (eq action 'metadata)
		 `(metadata
		   (group-function
		    . ,(when read-char-by-name-group
                             =======================
			 #'mule--ucs-names-group))

The same user option read-char-by-name-group is checked twice.
It should suffice to leave only the latter.

Re: [PATCH] `completing-read`: Add `group-function` support to completion metadata (REVISED PATCH VERSION 2)

[Daniel Mendler]

On 5/1/21 9:54 PM, Juri Linkov wrote:
> I think both completions-detailed and completions-group should be
> checked only by the API user like in help-fns.el.  Otherwise,
> there is duplication that you can see in my previous patch
> for read-char-by-name:
> 
>   (let* ((enable-recursive-minibuffers t)
> 	 (completion-ignore-case t)
> 	 (completion-tab-width 4)
> 	 (completions-group read-char-by-name-group)
>                             =======================
> 	 (input
> 	  (completing-read
> 	   prompt
> 	   (lambda (string pred action)
> 	     (if (eq action 'metadata)
> 		 `(metadata
> 		   (group-function
> 		    . ,(when read-char-by-name-group
>                              =======================
> 			 #'mule--ucs-names-group))
> 
> The same user option read-char-by-name-group is checked twice.
> It should suffice to leave only the latter.

This is a matter of preference. In this case I think I would prefer to
have the settings checked only once centrally in order to avoid the code
duplicatication in every completion table. Furthermore it seems that the
style to check the setting locally in every completion table will lead
to an unnecessary proliferation of configuration variables, since you
introduced the variable `read-char-by-name-group` here. I don't think we
should introduce an extra configuration variable per completion table.

Daniel

Re: [PATCH] `completing-read`: Add `group-function` support to completion metadata (REVISED PATCH VERSION 2)

[Juri Linkov]

>>   (let* ((enable-recursive-minibuffers t)
>> 	 (completion-ignore-case t)
>> 	 (completion-tab-width 4)
>> 	 (completions-group read-char-by-name-group)
>>                             =======================
>> 	 (input
>> 	  (completing-read
>> 	   prompt
>> 	   (lambda (string pred action)
>> 	     (if (eq action 'metadata)
>> 		 `(metadata
>> 		   (group-function
>> 		    . ,(when read-char-by-name-group
>>                              =======================
>> 			 #'mule--ucs-names-group))
>>
>> The same user option read-char-by-name-group is checked twice.
>> It should suffice to leave only the latter.
>
> This is a matter of preference. In this case I think I would prefer to
> have the settings checked only once centrally in order to avoid the code
> duplicatication in every completion table. Furthermore it seems that the
> style to check the setting locally in every completion table will lead
> to an unnecessary proliferation of configuration variables, since you
> introduced the variable `read-char-by-name-group` here. I don't think we
> should introduce an extra configuration variable per completion table.

I agree, `read-char-by-name-group` is obsolete by your new option
`completions-group`.

Re: [PATCH] `completing-read`: Add `group-function` support to completion metadata (REVISED PATCH VERSION 2)

[Juri Linkov]

>>>   (let* ((enable-recursive-minibuffers t)
>>>      (completion-ignore-case t)
>>>      (completion-tab-width 4)
>>>      (completions-group read-char-by-name-group)
>>>                         =======================
>>>      (input
>>>       (completing-read
>>>        prompt
>>>        (lambda (string pred action)
>>>          (if (eq action 'metadata)
>>>              `(metadata
>>>                (group-function
>>>                 . ,(when read-char-by-name-group
>>>                          =======================
>>>                      #'mule--ucs-names-group))
>>>
>>> The same user option read-char-by-name-group is checked twice.
>>> It should suffice to leave only the latter.
>>
>> This is a matter of preference. In this case I think I would prefer to
>> have the settings checked only once centrally in order to avoid the code
>> duplicatication in every completion table. Furthermore it seems that the
>> style to check the setting locally in every completion table will lead
>> to an unnecessary proliferation of configuration variables, since you
>> introduced the variable `read-char-by-name-group` here. I don't think we
>> should introduce an extra configuration variable per completion table.
>
> I agree, `read-char-by-name-group` is obsolete by your new option
> `completions-group`.

I tried to remove `read-char-by-name-group`, but it has a feature
currently not supported by `group-function`:

  (defcustom read-char-by-name-group nil
    "How to group characters for `read-char-by-name' completion.
  When t, split characters to sections of Unicode blocks
  sorted alphabetically."
  =====================

It seems a new function is needed to sort groups, e.g. `group-sort-function`.

Maybe better to push your current patches, so it would be easier
to base the next patches on master?

Re: [PATCH] `completing-read`: Add `group-function` support to completion metadata (REVISED PATCH VERSION 2)

[Daniel Mendler]

On 5/7/21 7:03 PM, Juri Linkov wrote:
> I tried to remove `read-char-by-name-group`, but it has a feature
> currently not supported by `group-function`:
> 
>   (defcustom read-char-by-name-group nil
>     "How to group characters for `read-char-by-name' completion.
>   When t, split characters to sections of Unicode blocks
>   sorted alphabetically."
>   =====================
> 
> It seems a new function is needed to sort groups, e.g. `group-sort-function`.
> 
> Maybe better to push your current patches, so it would be easier
> to base the next patches on master?

My original thoughts for a `group-function` proposal were such that the
`group-function` had the capability to sort the groups. During the
previous discussion with Stefan and Dmitry we somehow agreed that it is
better to keep things simple and to not allow the `group-function` to
sort the groups. Instead, sorting should only be provided by the
`cycle/display-sort-functions`.

For context, you can find the previous discussion at
https://github.com/minad/consult/issues/283. See in particular comment
https://github.com/minad/consult/issues/283#issuecomment-825749551. (I
would have pinged you there if I would have known that you are
interested in that functionality. I was not aware that
`read-char-by-name-group` had recently been added to Emacs master.)

I suggest to add a special `cycle/display-sort-function` to the
completion table if `read-char-by-name-group` is non-nil, which sorts
the candidates such that you achieve the desired group order. I would
avoid adding a separate `group-sort-function`.

Alternatively one may consider to give up the sorting as is present in
the current `read-char-by-name-group` functionality. From my perspective
that would be okay. The behavior is more predictable if sorting is only
performed by the `cycle/display-sort-function` and not by some
additional sorting function.

I believe I've also read some critical comments on the mailing list
before regarding the existence of `cycle/display-sort-functions` in
completion tables. The argument was that sorting should be provided
mostly by the completion UI and the completion style as configured by
the user externally from the completion table. This reflects my
experience - I am often happy with the default sorting as provided by
the completion UI (for example by history position, length and
alphabetically) or by the sorting as provided by the flex completion style.

Daniel

Re: [PATCH] `completing-read`: Add `group-function` support to completion metadata (REVISED PATCH VERSION 2)

[Daniel Mendler]

On 5/7/21 7:55 PM, Daniel Mendler wrote:
> On 5/7/21 7:03 PM, Juri Linkov wrote:
>> I tried to remove `read-char-by-name-group`, but it has a feature
>> currently not supported by `group-function`:
>>
>>   (defcustom read-char-by-name-group nil
>>     "How to group characters for `read-char-by-name' completion.
>>   When t, split characters to sections of Unicode blocks
>>   sorted alphabetically."
>>   =====================
>>
>> It seems a new function is needed to sort groups, e.g. `group-sort-function`.
>>
>> Maybe better to push your current patches, so it would be easier
>> to base the next patches on master?
> 
> My original thoughts for a `group-function` proposal were such that the
> `group-function` had the capability to sort the groups. During the
> previous discussion with Stefan and Dmitry we somehow agreed that it is
> better to keep things simple and to not allow the `group-function` to
> sort the groups. Instead, sorting should only be provided by the
> `cycle/display-sort-functions`.

I should add to my last mail: Dmitry also proposed adding an additional
`group-sort-function`, which allows sorting the groups, on top of the
`group-function` as provided by my patches (See comment
https://github.com/minad/consult/issues/283#issuecomment-825891569). I
had hoped that the complication of such a function can be avoided. But
if you want to have it in any case I think it is better to reconsider
the whole design and in particular look at my original implementation of
the group function (point 4 below).

In my patches we have a single `group-function : string -> bool ->
string`, where the second argument determines if the group title should
be returned (nil) or the candidate should be transformed (non-nil). If
we add the `group-sort-function` we have this:

1. Current patch + group-sort-function
   1.1 group-function: string -> bool -> string (title/transform)
   1.2 group-sort-function: list string -> list string

This does not look particularly coherent to me. I would not use a single
function for transformation/title and another function only for sorting.
There are the following alternatives to consider, if one takes a step back:

2. Use separate functions
   2.1 group-title-function : string -> string
   2.2 group-transform-function : string -> string
   2.3 group-sort-function : list string -> list string

For 2.3, Dmitry proposed a more complicated sorting function which
allows weighting the candidates. I am not in favor of that, I prefer a
simpler design, see
https://github.com/minad/consult/issues/283#issuecomment-825891569.

3. Use a single function with an action argument
   3.1 group-function : (action=title) -> string -> string
   3.2 group-function : (action=transform) -> string -> string
   3.3 group-function : (action=sort) -> list string -> list string

With this single action argument a minimal group-function implementation
can still pass through the second argument when action/=title.

4. Use a single function with a type-based operation
   4.1 group-function : string -> string (return transformed candidate)
   4.2 group-function : list string -> list (list string) (return
grouped candidates, group function determines the order of the groups)

This was my original implementation, see
https://github.com/minad/consult/issues/283#issuecomment-825749551.

Daniel

Re: [PATCH] `completing-read`: Add `group-function` support to completion metadata (REVISED PATCH VERSION 4)

[Daniel Mendler]

[-- Attachment #1: Type: text/plain, Size: 1659 bytes --]

On 5/8/21 8:24 AM, Daniel Mendler wrote:
> On 5/7/21 7:55 PM, Daniel Mendler wrote:
>> On 5/7/21 7:03 PM, Juri Linkov wrote:
>>> I tried to remove `read-char-by-name-group`, but it has a feature
>>> currently not supported by `group-function`:
>>>
>>>   (defcustom read-char-by-name-group nil
>>>     "How to group characters for `read-char-by-name' completion.
>>>   When t, split characters to sections of Unicode blocks
>>>   sorted alphabetically."
>>>   =====================
>>>
>>> It seems a new function is needed to sort groups, e.g. `group-sort-function`.
>
> 3. Use a single function with an action argument
>    3.1 group-function : (action=title) -> string -> string
>    3.2 group-function : (action=transform) -> string -> string
>    3.3 group-function : (action=sort) -> list string -> list string
I attached the current set of patches. The last patch
"0005-group-function-Implement-generalized-action-argument.patch"
implements the generalized action argument. The other patches (1-4) do
not differ from the previously sent patches. I send them for completeness.

Given the lastest patch, the `group-function` works as follows:

(group-function 'title cand) --> returns group title
(group-function 'transform cand) --> returns transformed candidate
(group-function 'sort groups) --> returns sorted alist of groups

The modification is quite minimal over the previous version with the
boolean transform argument. For completion tables which only want to
provide group titles, the group function definition is equally simple as
before:

(defun some-group-function (action arg)
  (if (eq action 'title)
      (get-title arg)
    arg))

Daniel

[-- Attachment #2: 0001-completing-read-Add-group-function-to-completion-met.patch --]
[-- Type: text/x-diff, Size: 18517 bytes --]

From 0f3ca048761cfee5717858dcceba03ca6709c37f Mon Sep 17 00:00:00 2001
From: Daniel Mendler <mail@daniel-mendler.de>
Date: Sun, 25 Apr 2021 13:07:29 +0200
Subject: [PATCH 1/5] (completing-read): Add `group-function` to completion
 metadata

A completion table can specify a `group-function` in its metadata.
The group function takes two arguments, a completion candidate and a
transform argument. The group function is used to group the candidates
after sorting and to enhance the completion UI with group titles.

If the transform argument is nil, the function must return the title
of the group to which the completion candidate belongs. The function
may also return nil in case the candidate does not belong to a group.

Otherwise the function must return the transformed candidate. The
transformation allows for example to remove a part of the candidate,
which is then displayed in the title.

The grouping functionality guarded by the variable `completions-group`
and turned off by default for the *Completions* buffer.

The specific form of the `group-function` has been chosen in order to
allow allocation-free grouping. This is important for completion UIs,
which continously update the displayed set of candidates (Icomplete,
Vertico, Ivy, etc.). Only when the transform argument is non-nil the
candidate transformation is performed, which may involve a string
allocation as for example in `xref--completing-read-group`.

The function `xref-show-definitions-completing-read` makes use of the
`group-function`, by moving the file name prefix to the title. If
grouping is enabled, the *Completions* are displayed as
"linenum:summary" instead of "file:linenum:summary". This way the
*Completions* buffer resembles the *Occur* buffer.

* doc/lispref/minibuf.texi: Add documentation.

* lisp/minibuffer.el (completion-metadata): Describe `group-function`
in the docstring.
(completions-group): Add guard variable, by default off.
(completions-group-format): Add format string for group titles.
(completions-group-title): Add face for group titles.
(completions-group-separator): Add face for group separator.
(minibuffer--group-by): New grouping function.
(minibuffer-completion-help): Use it.
(display-completion-list): Add optional GROUP-FUN argument.
(completion--insert-strings): Add optional GROUP-FUN argument. Insert
group titles if `completions-format` is `one-column`. Transform each
candidate with the GROUP-FUN. Attach the untransformed candidate to
the property `completion--string`.

* lisp/simple.el (choose-completion): Retrieve the untransformed
completion candidate from the property `completion--string`.

* lisp/progmodes/xref.el:
(xref--completing-read-group): New grouping function.
(xref-show-definitions-completing-read): Use it.
---
 doc/lispref/minibuf.texi |  10 ++++
 lisp/minibuffer.el       | 123 ++++++++++++++++++++++++++++++++-------
 lisp/progmodes/xref.el   |  18 ++++--
 lisp/simple.el           |  11 ++--
 4 files changed, 131 insertions(+), 31 deletions(-)

diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi
index 145eee8f06..aa57c2bda0 100644
--- a/doc/lispref/minibuf.texi
+++ b/doc/lispref/minibuf.texi
@@ -1943,6 +1943,16 @@ Programmed Completion
 a suffix displayed after the completion string.  This function
 takes priority over @code{annotation-function}.
 
+@item group-function
+The value should be a function for grouping the completion candidates.
+The function must take two arguments, @var{completion}, which is a
+completion candidate and @var{transform}, which is a boolean flag.  If
+@var{transform} is @code{nil}, the function must return a group title,
+to which the candidate belongs. The returned title can also
+@code{nil}.  Otherwise the function must return the transformed
+candidate. The transformation can for example remove a redundant
+prefix, which is displayed in the group title instead.
+
 @item display-sort-function
 The value should be a function for sorting completions.  The function
 should take one argument, a list of completion strings, and return a
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index caf06ec710..e21a699dae 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -126,6 +126,13 @@ completion-metadata
    three-element lists: completion, its prefix and suffix.  This
    function takes priority over `annotation-function' when both are
    provided, so only this function is used.
+- `group-function': function for grouping the completion candidates.
+   Takes two arguments: a completion candidate (COMPLETION) and a
+   boolean flag (TRANSFORM).  If TRANSFORM is nil, the function
+   returns a group title, to which the candidate belongs.  The
+   returned title may be nil.  Otherwise the function returns the
+   transformed candidate.  The transformation can remove a redundant
+   prefix, which is displayed in the group title instead.
 - `display-sort-function': function to sort entries in *Completions*.
    Takes one argument (COMPLETIONS) and should return a new list
    of completions.  Can operate destructively.
@@ -1138,6 +1145,30 @@ completion-cycle-threshold
   :version "24.1"
   :type completion--cycling-threshold-type)
 
+(defcustom completions-group nil
+  "Enable grouping of completion candidates in the *Completions* buffer.
+See also `completions-group-format'."
+  :type 'boolean
+  :version "28.1")
+
+(defcustom completions-group-format
+  (concat
+   (propertize "    " 'face 'completions-group-separator)
+   (propertize " %s " 'face 'completions-group-title)
+   (propertize " " 'face 'completions-group-separator
+               'display '(space :align-to right)))
+  "Format string used for the group title."
+  :type 'string
+  :version "28.1")
+
+(defface completions-group-title '((t :inherit shadow :slant italic))
+  "Face used for the title text of the candidate group headlines."
+  :version "28.1")
+
+(defface completions-group-separator '((t :inherit shadow :strike-through t))
+  "Face used for the separator lines of the candidate groups."
+  :version "28.1")
+
 (defun completion--cycle-threshold (metadata)
   (let* ((cat (completion-metadata-get metadata 'category))
          (over (completion--category-override cat 'cycle)))
@@ -1401,6 +1432,17 @@ minibuffer--sort-preprocess-history
                      (substring c base-size)))
                  hist)))))
 
+(defun minibuffer--group-by (fun elems)
+  "Group ELEMS by FUN."
+  (let ((groups))
+    (dolist (cand elems)
+      (let* ((key (funcall fun cand nil))
+             (group (assoc key groups)))
+        (if group
+            (setcdr group (cons cand (cdr group)))
+          (push (list key cand) groups))))
+    (mapcan (lambda (x) (nreverse (cdr x))) (nreverse groups))))
+
 (defun completion-all-sorted-completions (&optional start end)
   (or completion-all-sorted-completions
       (let* ((start (or start (minibuffer-prompt-end)))
@@ -1747,11 +1789,17 @@ completions-detailed
   :type 'boolean
   :version "28.1")
 
-(defun completion--insert-strings (strings)
+;; TODO: Split up this function in one function per `completions-format'.
+;; TODO: Add group title support for horizontal and vertical format.
+(defun completion--insert-strings (strings &optional group-fun)
   "Insert a list of STRINGS into the current buffer.
-Uses columns to keep the listing readable but compact.
-It also eliminates runs of equal strings."
+Uses columns to keep the listing readable but compact.  It also
+eliminates runs of equal strings.  GROUP-FUN is a `group-function'
+used for grouping the completion."
   (when (consp strings)
+    ;; FIXME: Currently grouping is enabled only for the 'one-column format.
+    (unless (eq completions-format 'one-column)
+      (setq group-fun nil))
     (let* ((length (apply #'max
 			  (mapcar (lambda (s)
 				    (if (consp s)
@@ -1768,6 +1816,7 @@ completion--insert-strings
 		     (max 1 (/ (length strings) 2))))
 	   (colwidth (/ wwidth columns))
            (column 0)
+           (last-title nil)
 	   (rows (/ (length strings) columns))
 	   (row 0)
            (first t)
@@ -1780,6 +1829,13 @@ completion--insert-strings
       ;; The insertion should be "sensible" no matter what choices were made
       ;; for the parameters above.
       (dolist (str strings)
+        ;; Add group titles.
+        (when group-fun
+          (let ((title (funcall group-fun (if (consp str) (car str) str) nil)))
+            (unless (equal title last-title)
+              (when title
+                (insert (format completions-group-format title) "\n"))
+              (setq last-title title))))
 	(unless (equal laststring str) ; Remove (consecutive) duplicates.
 	  (setq laststring str)
           ;; FIXME: `string-width' doesn't pay attention to
@@ -1825,8 +1881,15 @@ completion--insert-strings
 		  nil))))
             (setq first nil)
             (if (not (consp str))
-                (put-text-property (point) (progn (insert str) (point))
-                                   'mouse-face 'highlight)
+                (add-text-properties
+                 (point)
+                 (progn
+                   (insert
+                    (if group-fun
+                        (funcall group-fun str 'transform)
+                      str))
+                   (point))
+                 `(mouse-face highlight completion--string ,str))
               ;; If `str' is a list that has 2 elements,
               ;; then the second element is a suffix annotation.
               ;; If `str' has 3 elements, then the second element
@@ -1837,8 +1900,15 @@ completion--insert-strings
                   (let ((beg (point))
                         (end (progn (insert prefix) (point))))
                     (put-text-property beg end 'mouse-face nil)))
-                (put-text-property (point) (progn (insert (car str)) (point))
-                                   'mouse-face 'highlight)
+                (add-text-properties
+                 (point)
+                 (progn
+                   (insert
+                    (if group-fun
+                         (funcall group-fun (car str) 'transform)
+                      (car str)))
+                   (point))
+                 `(mouse-face highlight completion--string ,(car str)))
                 (let ((beg (point))
                       (end (progn (insert suffix) (point))))
                   (put-text-property beg end 'mouse-face nil)
@@ -1923,7 +1993,7 @@ completion-hilit-commonality
         completions)
        base-size))))
 
-(defun display-completion-list (completions &optional common-substring)
+(defun display-completion-list (completions &optional common-substring group-fun)
   "Display the list of completions, COMPLETIONS, using `standard-output'.
 Each element may be just a symbol or string
 or may be a list of two strings to be printed as if concatenated.
@@ -1933,7 +2003,8 @@ display-completion-list
 The actual completion alternatives, as inserted, are given `mouse-face'
 properties of `highlight'.
 At the end, this runs the normal hook `completion-setup-hook'.
-It can find the completion buffer in `standard-output'."
+It can find the completion buffer in `standard-output'.
+GROUP-FUN is a `group-function' used for grouping the completion."
   (declare (advertised-calling-convention (completions) "24.4"))
   (if common-substring
       (setq completions (completion-hilit-commonality
@@ -1946,7 +2017,7 @@ display-completion-list
 	(let ((standard-output (current-buffer))
 	      (completion-setup-hook nil))
           (with-suppressed-warnings ((callargs display-completion-list))
-	    (display-completion-list completions common-substring)))
+	    (display-completion-list completions common-substring group-fun)))
 	(princ (buffer-string)))
 
     (with-current-buffer standard-output
@@ -1954,7 +2025,7 @@ display-completion-list
       (if (null completions)
           (insert "There are no possible completions of what you have typed.")
         (insert "Possible completions are:\n")
-        (completion--insert-strings completions))))
+        (completion--insert-strings completions group-fun))))
 
   (run-hooks 'completion-setup-hook)
   nil)
@@ -2067,6 +2138,9 @@ minibuffer-completion-help
              (aff-fun (or (completion-metadata-get all-md 'affixation-function)
                           (plist-get completion-extra-properties
                                      :affixation-function)))
+             (sort-fun (completion-metadata-get all-md 'display-sort-function))
+             (group-fun (and completions-group
+                             (completion-metadata-get all-md 'group-function)))
              (mainbuf (current-buffer))
              ;; If the *Completions* buffer is shown in a new
              ;; window, mark it as softly-dedicated, so bury-buffer in
@@ -2098,15 +2172,22 @@ minibuffer-completion-help
                       ;; Remove the base-size tail because `sort' requires a properly
                       ;; nil-terminated list.
                       (when last (setcdr last nil))
-                      (setq completions
-                            ;; FIXME: This function is for the output of all-completions,
-                            ;; not completion-all-completions.  Often it's the same, but
-                            ;; not always.
-                            (let ((sort-fun (completion-metadata-get
-                                             all-md 'display-sort-function)))
-                              (if sort-fun
-                                  (funcall sort-fun completions)
-                                (sort completions 'string-lessp))))
+
+                      ;; Sort first using the `display-sort-function'.
+                      ;; FIXME: This function is for the output of
+                      ;; all-completions, not
+                      ;; completion-all-completions.  Often it's the
+                      ;; same, but not always.
+                      (setq completions (if sort-fun
+                                            (funcall sort-fun completions)
+                                          (sort completions 'string-lessp)))
+
+                      ;; After sorting, group the candidates using the
+                      ;; `group-function'.
+                      (when group-fun
+                        (setq completions
+                              (minibuffer--group-by group-fun completions)))
+
                       (cond
                        (aff-fun
                         (setq completions
@@ -2152,7 +2233,7 @@ minibuffer-completion-help
                                                      (if (eq (car bounds) (length result))
                                                          'exact 'finished)))))))
 
-                      (display-completion-list completions)))))
+                      (display-completion-list completions nil group-fun)))))
           nil)))
     nil))
 
diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el
index 7fc7181acc..2a4fb2c417 100644
--- a/lisp/progmodes/xref.el
+++ b/lisp/progmodes/xref.el
@@ -1044,6 +1044,12 @@ xref-show-definitions-buffer-at-bottom
 (define-obsolete-function-alias 'xref--show-defs-buffer-at-bottom
   #'xref-show-definitions-buffer-at-bottom "28.1")
 
+(defun xref--completing-read-group (cand transform)
+  "Return group title of candidate CAND or TRANSFORM the candidate."
+  (if transform
+      (substring cand (1+ (next-single-property-change 0 'xref--group cand)))
+    (get-text-property 0 'xref--group cand)))
+
 (defun xref-show-definitions-completing-read (fetcher alist)
   "Let the user choose the target definition with completion.
 
@@ -1072,10 +1078,12 @@ xref-show-definitions-completing-read
                                     (format #("%d:" 0 2 (face xref-line-number))
                                             line)
                                   ""))
+                               (group-prefix
+                                (substring group group-prefix-length))
                                (group-fmt
-                                (propertize
-                                 (substring group group-prefix-length)
-                                 'face 'xref-file-header))
+                                (propertize group-prefix
+                                            'face 'xref-file-header
+                                            'xref--group group-prefix))
                                (candidate
                                 (format "%s:%s%s" group-fmt line-fmt summary)))
                           (push (cons candidate xref) xref-alist-with-line-info)))))
@@ -1087,7 +1095,9 @@ xref-show-definitions-completing-read
                          (lambda (string pred action)
                            (cond
                             ((eq action 'metadata)
-                             '(metadata . ((category . xref-location))))
+                             `(metadata
+                               . ((category . xref-location)
+                                  (group-function . ,#'xref--completing-read-group))))
                             (t
                              (complete-with-action action collection string pred)))))
                         (def (caar collection)))
diff --git a/lisp/simple.el b/lisp/simple.el
index b4e34f1e4c..fe7ff0333f 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -8876,18 +8876,17 @@ choose-completion
           (choice
            (save-excursion
              (goto-char (posn-point (event-start event)))
-             (let (beg end)
+             (let (beg)
                (cond
                 ((and (not (eobp)) (get-text-property (point) 'mouse-face))
-                 (setq end (point) beg (1+ (point))))
+                 (setq beg (1+ (point))))
                 ((and (not (bobp))
                       (get-text-property (1- (point)) 'mouse-face))
-                 (setq end (1- (point)) beg (point)))
+                 (setq beg (point)))
                 (t (error "No completion here")))
                (setq beg (previous-single-property-change beg 'mouse-face))
-               (setq end (or (next-single-property-change end 'mouse-face)
-                             (point-max)))
-               (buffer-substring-no-properties beg end)))))
+               (substring-no-properties
+                (get-text-property beg 'completion--string))))))
 
       (unless (buffer-live-p buffer)
         (error "Destination buffer is dead"))
-- 
2.20.1


[-- Attachment #3: 0002-completion-insert-strings-Split-function-Full-group-.patch --]
[-- Type: text/x-diff, Size: 13458 bytes --]

From fa81e97590384cb97e24ef5a9a91301d030f2736 Mon Sep 17 00:00:00 2001
From: Daniel Mendler <mail@daniel-mendler.de>
Date: Fri, 30 Apr 2021 08:40:59 +0200
Subject: [PATCH 2/5] (completion--insert-strings): Split function; Full group
 title support

Split `completion--insert-strings` into a function per completions
format in order to increase readability and extensibility. This change
eases the addition of more formats. Add support for group titles to
the vertical and horizontal format.

* minibuffer.el (completion--insert): Add new function.
(completion--insert-vertical, completion--insert-horizontal,
completion--insert-one-column): Extract new function from
`completion--insert-strings`. Use `completion--insert`.
(completion--insert-strings): Use new insertion functions.
---
 lisp/minibuffer.el | 269 ++++++++++++++++++++++++++-------------------
 1 file changed, 154 insertions(+), 115 deletions(-)

diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index e21a699dae..cf1a4350bd 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -1789,21 +1789,16 @@ completions-detailed
   :type 'boolean
   :version "28.1")
 
-;; TODO: Split up this function in one function per `completions-format'.
-;; TODO: Add group title support for horizontal and vertical format.
 (defun completion--insert-strings (strings &optional group-fun)
   "Insert a list of STRINGS into the current buffer.
 Uses columns to keep the listing readable but compact.  It also
 eliminates runs of equal strings.  GROUP-FUN is a `group-function'
 used for grouping the completion."
   (when (consp strings)
-    ;; FIXME: Currently grouping is enabled only for the 'one-column format.
-    (unless (eq completions-format 'one-column)
-      (setq group-fun nil))
     (let* ((length (apply #'max
 			  (mapcar (lambda (s)
 				    (if (consp s)
-					(apply #'+ (mapcar #'string-width s))
+				        (apply #'+ (mapcar #'string-width s))
 				      (string-width s)))
 				  strings)))
 	   (window (get-buffer-window (current-buffer) 0))
@@ -1814,126 +1809,170 @@ completion--insert-strings
 		     ;; Don't allocate more columns than we can fill.
 		     ;; Windows can't show less than 3 lines anyway.
 		     (max 1 (/ (length strings) 2))))
-	   (colwidth (/ wwidth columns))
-           (column 0)
-           (last-title nil)
-	   (rows (/ (length strings) columns))
-	   (row 0)
-           (first t)
-	   (laststring nil))
+	   (colwidth (/ wwidth columns)))
       (unless (or tab-stop-list (null completion-tab-width)
                   (zerop (mod colwidth completion-tab-width)))
         ;; Align to tab positions for the case
         ;; when the caller uses tabs inside prefix.
         (setq colwidth (- colwidth (mod colwidth completion-tab-width))))
-      ;; The insertion should be "sensible" no matter what choices were made
-      ;; for the parameters above.
-      (dolist (str strings)
-        ;; Add group titles.
+      (funcall (intern (format "completion--insert-%s" completions-format))
+               strings group-fun length wwidth colwidth columns))))
+
+(defun completion--insert-horizontal (strings group-fun
+                                              length wwidth
+                                              colwidth _columns)
+  (let ((column 0)
+        (first t)
+	(last-title nil)
+        (last-string nil))
+    (dolist (str strings)
+      (unless (equal last-string str) ; Remove (consecutive) duplicates.
+	(setq last-string str)
         (when group-fun
           (let ((title (funcall group-fun (if (consp str) (car str) str) nil)))
             (unless (equal title last-title)
+              (setq last-title title)
               (when title
-                (insert (format completions-group-format title) "\n"))
-              (setq last-title title))))
-	(unless (equal laststring str) ; Remove (consecutive) duplicates.
-	  (setq laststring str)
+                (insert (if first "" "\n") (format completions-group-format title) "\n")
+                (setq column 0
+                      first t)))))
+	(unless first
           ;; FIXME: `string-width' doesn't pay attention to
           ;; `display' properties.
-          (let ((length (if (consp str)
-                            (apply #'+ (mapcar #'string-width str))
-                          (string-width str))))
-            (cond
-             ((eq completions-format 'one-column)
-              ;; Nothing special
-              )
-	     ((eq completions-format 'vertical)
-	      ;; Vertical format
-	      (when (> row rows)
-		(forward-line (- -1 rows))
-		(setq row 0 column (+ column colwidth)))
-	      (when (> column 0)
-		(end-of-line)
-		(while (> (current-column) column)
-		  (if (eobp)
-		      (insert "\n")
-		    (forward-line 1)
-		    (end-of-line)))
-		(insert " \t")
-		(set-text-properties (1- (point)) (point)
-				     `(display (space :align-to ,column)))))
-	     (t
-	      ;; Horizontal format
-	      (unless first
-		(if (< wwidth (+ (max colwidth length) column))
-		    ;; No space for `str' at point, move to next line.
-		    (progn (insert "\n") (setq column 0))
-		  (insert " \t")
-		  ;; Leave the space unpropertized so that in the case we're
-		  ;; already past the goal column, there is still
-		  ;; a space displayed.
-		  (set-text-properties (1- (point)) (point)
-				       ;; We can set tab-width using
-				       ;; completion-tab-width, but
-				       ;; the caller can prefer using
-				       ;; \t to align prefixes.
-				       `(display (space :align-to ,column)))
-		  nil))))
-            (setq first nil)
-            (if (not (consp str))
-                (add-text-properties
-                 (point)
-                 (progn
-                   (insert
-                    (if group-fun
-                        (funcall group-fun str 'transform)
-                      str))
-                   (point))
-                 `(mouse-face highlight completion--string ,str))
-              ;; If `str' is a list that has 2 elements,
-              ;; then the second element is a suffix annotation.
-              ;; If `str' has 3 elements, then the second element
-              ;; is a prefix, and the third element is a suffix.
-              (let* ((prefix (when (nth 2 str) (nth 1 str)))
-                     (suffix (or (nth 2 str) (nth 1 str))))
-                (when prefix
-                  (let ((beg (point))
-                        (end (progn (insert prefix) (point))))
-                    (put-text-property beg end 'mouse-face nil)))
-                (add-text-properties
-                 (point)
-                 (progn
-                   (insert
-                    (if group-fun
-                         (funcall group-fun (car str) 'transform)
-                      (car str)))
-                   (point))
-                 `(mouse-face highlight completion--string ,(car str)))
-                (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 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
-             ((eq completions-format 'one-column)
-              (insert "\n"))
-	     ((eq completions-format 'vertical)
-	      ;; Vertical format
-	      (if (> column 0)
-		  (forward-line)
-		(insert "\n"))
-	      (setq row (1+ row)))
-	     (t
-	      ;; Horizontal format
-	      ;; Next column to align to.
-	      (setq column (+ column
-			      ;; Round up to a whole number of columns.
-			      (* colwidth (ceiling length colwidth))))))))))))
+	  (if (< wwidth (+ column (max colwidth
+                                       (if (consp str)
+                                           (apply #'+ (mapcar #'string-width str))
+                                         (string-width str)))))
+	      ;; No space for `str' at point, move to next line.
+	      (progn (insert "\n") (setq column 0))
+	    (insert " \t")
+	    ;; Leave the space unpropertized so that in the case we're
+	    ;; already past the goal column, there is still
+	    ;; a space displayed.
+	    (set-text-properties (1- (point)) (point)
+				 ;; We can set tab-width using
+				 ;; completion-tab-width, but
+				 ;; the caller can prefer using
+				 ;; \t to align prefixes.
+				 `(display (space :align-to ,column)))
+	    nil))
+        (setq first nil)
+        (completion--insert str group-fun)
+	;; Next column to align to.
+	(setq column (+ column
+			;; Round up to a whole number of columns.
+			(* colwidth (ceiling length colwidth))))))))
+
+(defun completion--insert-vertical (strings group-fun
+                                            _length _wwidth
+                                            colwidth columns)
+  (let ((column 0)
+        (rows (/ (length strings) columns))
+	(row 0)
+	(last-title nil)
+	(last-string nil)
+        (start-point (point))
+        (next 0) (pos 0))
+    (dolist (str strings)
+      (unless (equal last-string str) ; Remove (consecutive) duplicates.
+	(setq last-string str)
+	(when (> row rows)
+	  (goto-char start-point)
+	  (setq row 0 column (+ column colwidth)))
+        (when group-fun
+          (let ((title (funcall group-fun (if (consp str) (car str) str) nil)))
+            (unless (equal title last-title)
+              (setq last-title title)
+              (when title
+                ;; Align before title insertion
+	        (when (> column 0)
+	          (end-of-line)
+	          (while (> (current-column) column)
+	            (if (eobp)
+		        (insert "\n")
+	              (forward-line 1)
+	              (end-of-line)))
+	          (insert " \t")
+	          (set-text-properties (1- (point)) (point)
+			               `(display (space :align-to ,column))))
+                (let* ((fmt completions-group-format)
+                       (len (length fmt)))
+                  ;; Adjust display space for columns
+                  (when (equal (get-text-property (- len 1) 'display fmt) '(space :align-to right))
+                    (setq fmt (substring fmt))
+                    (put-text-property (- len 1) len
+                                       'display
+                                       `(space :align-to ,(+ colwidth column -1))
+                                       fmt))
+                  (insert (format fmt title)))
+                ;; Align after title insertion
+	        (if (> column 0)
+	            (forward-line)
+	          (insert "\n"))))))
+        ;; Align before candidate insertion
+	(when (> column 0)
+	  (end-of-line)
+	  (while (> (current-column) column)
+	    (if (eobp)
+		(insert "\n")
+	      (forward-line 1)
+	      (end-of-line)))
+	  (insert " \t")
+	  (set-text-properties (1- (point)) (point)
+			       `(display (space :align-to ,column))))
+        (completion--insert str group-fun)
+        ;; Align after candidate insertion
+	(if (> column 0)
+	    (forward-line)
+	  (insert "\n"))
+	(setq row (1+ row))))))
+
+(defun completion--insert-one-column (strings group-fun &rest _)
+  (let ((last-title nil) (last-string nil))
+    (dolist (str strings)
+      (unless (equal last-string str) ; Remove (consecutive) duplicates.
+	(setq last-string str)
+        (when group-fun
+          (let ((title (funcall group-fun (if (consp str) (car str) str) nil)))
+            (unless (equal title last-title)
+              (setq last-title title)
+              (when title
+                (insert (format completions-group-format title) "\n")))))
+        (completion--insert str group-fun)
+        (insert "\n")))))
+
+(defun completion--insert (str group-fun)
+  (if (not (consp str))
+      (add-text-properties
+       (point)
+       (progn
+         (insert
+          (if group-fun
+              (funcall group-fun str 'transform)
+            str))
+         (point))
+       `(mouse-face highlight completion--string ,str))
+    ;; If `str' is a list that has 2 elements,
+    ;; then the second element is a suffix annotation.
+    ;; If `str' has 3 elements, then the second element
+    ;; is a prefix, and the third element is a suffix.
+    (let* ((prefix (when (nth 2 str) (nth 1 str)))
+           (suffix (or (nth 2 str) (nth 1 str))))
+      (when prefix
+        (let ((beg (point))
+              (end (progn (insert prefix) (point))))
+          (put-text-property beg end 'mouse-face nil)))
+      (completion--insert (car str) group-fun)
+      (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 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))))))
 
 (defvar completion-setup-hook nil
   "Normal hook run at the end of setting up a completion list buffer.
-- 
2.20.1


[-- Attachment #4: 0003-minibuffer-completion-help-Do-not-check-completions-.patch --]
[-- Type: text/x-diff, Size: 1378 bytes --]

From 287e77be79783e056053319477efc1f5a2e5e525 Mon Sep 17 00:00:00 2001
From: Daniel Mendler <mail@daniel-mendler.de>
Date: Sun, 2 May 2021 15:50:08 +0200
Subject: [PATCH 3/5] (minibuffer-completion-help): Do not check
 `completions-group` centrally

The guard variable `completions-group` should be checked in each
completion table individually. The guard variable
`completions-detailed` variable is used in the same way.

* minibuffer.el (minibuffer-completion-help): Remove check of
  `completions-group`.
---
 lisp/minibuffer.el | 3 +--
 1 file changed, 1 insertion(+), 2 deletions(-)

diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index cf1a4350bd..b743b2bd40 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -2178,8 +2178,7 @@ minibuffer-completion-help
                           (plist-get completion-extra-properties
                                      :affixation-function)))
              (sort-fun (completion-metadata-get all-md 'display-sort-function))
-             (group-fun (and completions-group
-                             (completion-metadata-get all-md 'group-function)))
+             (group-fun (completion-metadata-get all-md 'group-function))
              (mainbuf (current-buffer))
              ;; If the *Completions* buffer is shown in a new
              ;; window, mark it as softly-dedicated, so bury-buffer in
-- 
2.20.1


[-- Attachment #5: 0004-completion-insert-vertical-Separate-groups-completel.patch --]
[-- Type: text/x-diff, Size: 5061 bytes --]

From 4e34bce8db0cb68ac47d4c6a42a8d37361a4dfa7 Mon Sep 17 00:00:00 2001
From: Daniel Mendler <mail@daniel-mendler.de>
Date: Sun, 2 May 2021 16:19:42 +0200
Subject: [PATCH 4/5] (completion--insert-vertical): Separate groups completely

Insert the candidates vertically within the groups, but keep the
groups completely separate using the full width group separators.

* minibuffer.el (completion--insert-vertical): Adjust grouping.
---
 lisp/minibuffer.el | 108 ++++++++++++++++++++-------------------------
 1 file changed, 48 insertions(+), 60 deletions(-)

diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index b743b2bd40..73a38a8137 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -1866,66 +1866,54 @@ completion--insert-horizontal
 (defun completion--insert-vertical (strings group-fun
                                             _length _wwidth
                                             colwidth columns)
-  (let ((column 0)
-        (rows (/ (length strings) columns))
-	(row 0)
-	(last-title nil)
-	(last-string nil)
-        (start-point (point))
-        (next 0) (pos 0))
-    (dolist (str strings)
-      (unless (equal last-string str) ; Remove (consecutive) duplicates.
-	(setq last-string str)
-	(when (> row rows)
-	  (goto-char start-point)
-	  (setq row 0 column (+ column colwidth)))
-        (when group-fun
-          (let ((title (funcall group-fun (if (consp str) (car str) str) nil)))
-            (unless (equal title last-title)
-              (setq last-title title)
-              (when title
-                ;; Align before title insertion
-	        (when (> column 0)
-	          (end-of-line)
-	          (while (> (current-column) column)
-	            (if (eobp)
-		        (insert "\n")
-	              (forward-line 1)
-	              (end-of-line)))
-	          (insert " \t")
-	          (set-text-properties (1- (point)) (point)
-			               `(display (space :align-to ,column))))
-                (let* ((fmt completions-group-format)
-                       (len (length fmt)))
-                  ;; Adjust display space for columns
-                  (when (equal (get-text-property (- len 1) 'display fmt) '(space :align-to right))
-                    (setq fmt (substring fmt))
-                    (put-text-property (- len 1) len
-                                       'display
-                                       `(space :align-to ,(+ colwidth column -1))
-                                       fmt))
-                  (insert (format fmt title)))
-                ;; Align after title insertion
-	        (if (> column 0)
-	            (forward-line)
-	          (insert "\n"))))))
-        ;; Align before candidate insertion
-	(when (> column 0)
-	  (end-of-line)
-	  (while (> (current-column) column)
-	    (if (eobp)
-		(insert "\n")
-	      (forward-line 1)
-	      (end-of-line)))
-	  (insert " \t")
-	  (set-text-properties (1- (point)) (point)
-			       `(display (space :align-to ,column))))
-        (completion--insert str group-fun)
-        ;; Align after candidate insertion
-	(if (> column 0)
-	    (forward-line)
-	  (insert "\n"))
-	(setq row (1+ row))))))
+  (while strings
+    (let ((group nil)
+          (column 0)
+	  (row 0)
+          (rows)
+          (last-string nil))
+      (if group-fun
+          (let* ((str (car strings))
+                 (title (funcall group-fun (if (consp str) (car str) str) nil)))
+            (while (and strings
+                        (equal title (funcall group-fun
+                                              (if (consp (car strings))
+                                                  (car (car strings))
+                                                (car strings))
+                                              nil)))
+              (push (car strings) group)
+              (pop strings))
+            (setq group (nreverse group)))
+        (setq group strings
+              strings nil))
+      (setq rows (/ (length group) columns))
+      (when group-fun
+        (let* ((str (car group))
+               (title (funcall group-fun (if (consp str) (car str) str) nil)))
+          (when title
+            (goto-char (point-max))
+            (insert (format completions-group-format title) "\n"))))
+      (dolist (str group)
+        (unless (equal last-string str) ; Remove (consecutive) duplicates.
+	  (setq last-string str)
+	  (when (> row rows)
+            (forward-line (- -1 rows))
+	    (setq row 0 column (+ column colwidth)))
+	  (when (> column 0)
+	    (end-of-line)
+	    (while (> (current-column) column)
+	      (if (eobp)
+		  (insert "\n")
+	        (forward-line 1)
+	        (end-of-line)))
+	    (insert " \t")
+	    (set-text-properties (1- (point)) (point)
+			         `(display (space :align-to ,column))))
+          (completion--insert str group-fun)
+	  (if (> column 0)
+	      (forward-line)
+	    (insert "\n"))
+	  (setq row (1+ row)))))))
 
 (defun completion--insert-one-column (strings group-fun &rest _)
   (let ((last-title nil) (last-string nil))
-- 
2.20.1


[-- Attachment #6: 0005-group-function-Implement-generalized-action-argument.patch --]
[-- Type: text/x-diff, Size: 8547 bytes --]

From 4f66c9d60573f221ead94a052ef65b699c530741 Mon Sep 17 00:00:00 2001
From: Daniel Mendler <mail@daniel-mendler.de>
Date: Sat, 8 May 2021 10:17:56 +0200
Subject: [PATCH 5/5] (group-function): Implement generalized action argument

The group function takes two arguments, a first action argument and a
second argument, which is either a candidate string or an alist of
groups. The action argument is a symbol which can take the values:

- sort: Sort groups given alist of groups.
- title: Return group title given candidate.
- transform: Return transformed candidate given candidate.

* lisp/minibuffer.el: Use generalized group function with action
argument.  Update documentation.
* lisp/progmodes/xref.el: Implement generalized group function.
* doc/lispref/minibuf.texi: Update documentation.
---
 doc/lispref/minibuf.texi | 17 ++++++++++-------
 lisp/minibuffer.el       | 40 ++++++++++++++++++++++------------------
 lisp/progmodes/xref.el   | 10 +++++-----
 3 files changed, 37 insertions(+), 30 deletions(-)

diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi
index aa57c2bda0..bcbd24a02a 100644
--- a/doc/lispref/minibuf.texi
+++ b/doc/lispref/minibuf.texi
@@ -1945,13 +1945,16 @@ Programmed Completion
 
 @item group-function
 The value should be a function for grouping the completion candidates.
-The function must take two arguments, @var{completion}, which is a
-completion candidate and @var{transform}, which is a boolean flag.  If
-@var{transform} is @code{nil}, the function must return a group title,
-to which the candidate belongs. The returned title can also
-@code{nil}.  Otherwise the function must return the transformed
-candidate. The transformation can for example remove a redundant
-prefix, which is displayed in the group title instead.
+The function must take two arguments. The first argument @var{action}
+is a symbol which specifies the action to be performed. The second
+argument @var{arg} is either a candidate string or an alist of
+groups. If the @var{action} is @code{title}, the function must return
+the group title of the candidate passed as second argument.  If the
+@var{action} is @code{transform}, the function must return the
+transformed candidate string. The transformation can remove a
+redundant prefix, which is displayed in the group title instead. If
+the @var{action} is @code{sort}, the function takes an alist of groups
+and must return the sorted list of groups.
 
 @item display-sort-function
 The value should be a function for sorting completions.  The function
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 73a38a8137..41a79d6ebe 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -127,12 +127,15 @@ completion-metadata
    function takes priority over `annotation-function' when both are
    provided, so only this function is used.
 - `group-function': function for grouping the completion candidates.
-   Takes two arguments: a completion candidate (COMPLETION) and a
-   boolean flag (TRANSFORM).  If TRANSFORM is nil, the function
-   returns a group title, to which the candidate belongs.  The
-   returned title may be nil.  Otherwise the function returns the
-   transformed candidate.  The transformation can remove a redundant
-   prefix, which is displayed in the group title instead.
+   Takes two arguments. The first argument (ACTION) is a symbol which
+   specifies the action to be performed. The second argument is either
+   a candidate string or an alist of groups. If the action is `title',
+   the function must return the group title of the candidate passed as
+   second argument.  If the action is `transform', the function must
+   return the transformed candidate string. The transformation can
+   remove a redundant prefix, which is displayed in the group title
+   instead. If the action is `sort', the function takes an alist of
+   groups and must return the sorted list of groups.
 - `display-sort-function': function to sort entries in *Completions*.
    Takes one argument (COMPLETIONS) and should return a new list
    of completions.  Can operate destructively.
@@ -1432,16 +1435,18 @@ minibuffer--sort-preprocess-history
                      (substring c base-size)))
                  hist)))))
 
-(defun minibuffer--group-by (fun elems)
-  "Group ELEMS by FUN."
+(defun minibuffer--group-by (group-fun elems)
+  "Group ELEMS by GROUP-FUN."
   (let ((groups))
     (dolist (cand elems)
-      (let* ((key (funcall fun cand nil))
+      (let* ((key (funcall group-fun 'title cand))
              (group (assoc key groups)))
         (if group
             (setcdr group (cons cand (cdr group)))
           (push (list key cand) groups))))
-    (mapcan (lambda (x) (nreverse (cdr x))) (nreverse groups))))
+    (apply #'nconc (funcall group-fun 'sort
+                            (mapcar (lambda (x) (nreverse (cdr x)))
+                                    (nreverse groups))))))
 
 (defun completion-all-sorted-completions (&optional start end)
   (or completion-all-sorted-completions
@@ -1829,7 +1834,7 @@ completion--insert-horizontal
       (unless (equal last-string str) ; Remove (consecutive) duplicates.
 	(setq last-string str)
         (when group-fun
-          (let ((title (funcall group-fun (if (consp str) (car str) str) nil)))
+          (let ((title (funcall group-fun 'title (if (consp str) (car str) str))))
             (unless (equal title last-title)
               (setq last-title title)
               (when title
@@ -1874,13 +1879,12 @@ completion--insert-vertical
           (last-string nil))
       (if group-fun
           (let* ((str (car strings))
-                 (title (funcall group-fun (if (consp str) (car str) str) nil)))
+                 (title (funcall group-fun 'title (if (consp str) (car str) str))))
             (while (and strings
-                        (equal title (funcall group-fun
+                        (equal title (funcall group-fun 'title
                                               (if (consp (car strings))
                                                   (car (car strings))
-                                                (car strings))
-                                              nil)))
+                                                (car strings)))))
               (push (car strings) group)
               (pop strings))
             (setq group (nreverse group)))
@@ -1889,7 +1893,7 @@ completion--insert-vertical
       (setq rows (/ (length group) columns))
       (when group-fun
         (let* ((str (car group))
-               (title (funcall group-fun (if (consp str) (car str) str) nil)))
+               (title (funcall group-fun 'title (if (consp str) (car str) str))))
           (when title
             (goto-char (point-max))
             (insert (format completions-group-format title) "\n"))))
@@ -1921,7 +1925,7 @@ completion--insert-one-column
       (unless (equal last-string str) ; Remove (consecutive) duplicates.
 	(setq last-string str)
         (when group-fun
-          (let ((title (funcall group-fun (if (consp str) (car str) str) nil)))
+          (let ((title (funcall group-fun 'title (if (consp str) (car str) str))))
             (unless (equal title last-title)
               (setq last-title title)
               (when title
@@ -1936,7 +1940,7 @@ completion--insert
        (progn
          (insert
           (if group-fun
-              (funcall group-fun str 'transform)
+              (funcall group-fun 'transform str)
             str))
          (point))
        `(mouse-face highlight completion--string ,str))
diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el
index 2a4fb2c417..813e6a8b4f 100644
--- a/lisp/progmodes/xref.el
+++ b/lisp/progmodes/xref.el
@@ -1044,11 +1044,11 @@ xref-show-definitions-buffer-at-bottom
 (define-obsolete-function-alias 'xref--show-defs-buffer-at-bottom
   #'xref-show-definitions-buffer-at-bottom "28.1")
 
-(defun xref--completing-read-group (cand transform)
-  "Return group title of candidate CAND or TRANSFORM the candidate."
-  (if transform
-      (substring cand (1+ (next-single-property-change 0 'xref--group cand)))
-    (get-text-property 0 'xref--group cand)))
+(defun xref--completing-read-group (action arg)
+  (pcase action
+    ('title (get-text-property 0 'xref--group arg))
+    ('transform (substring arg (1+ (next-single-property-change 0 'xref--group arg))))
+    ('sort arg)))
 
 (defun xref-show-definitions-completing-read (fetcher alist)
   "Let the user choose the target definition with completion.
-- 
2.20.1

Re: [PATCH] `completing-read`: Add `group-function` support to completion metadata (REVISED PATCH VERSION 4)

[Daniel Mendler]

On 5/8/21 10:45 AM, Daniel Mendler wrote:
> On 5/8/21 8:24 AM, Daniel Mendler wrote:
>> On 5/7/21 7:55 PM, Daniel Mendler wrote:
>>> On 5/7/21 7:03 PM, Juri Linkov wrote:
>>>> I tried to remove `read-char-by-name-group`, but it has a feature
>>>> currently not supported by `group-function`:
>>>>
>>>>   (defcustom read-char-by-name-group nil
>>>>     "How to group characters for `read-char-by-name' completion.
>>>>   When t, split characters to sections of Unicode blocks
>>>>   sorted alphabetically."
>>>>   =====================
>>>>
>>>> It seems a new function is needed to sort groups, e.g. `group-sort-function`.
>>
>> 3. Use a single function with an action argument
>>    3.1 group-function : (action=title) -> string -> string
>>    3.2 group-function : (action=transform) -> string -> string
>>    3.3 group-function : (action=sort) -> list string -> list string
> I attached the current set of patches. The last patch
> "0005-group-function-Implement-generalized-action-argument.patch"
> implements the generalized action argument. The other patches (1-4) do
> not differ from the previously sent patches. I send them for completeness.

Correction to the lastest patch. The `minibuffer--group-by` function
should actually be written as follows:

(defun minibuffer--group-by (group-fun elems)
  "Group ELEMS by GROUP-FUN."
  (let ((groups))
    (dolist (cand elems)
      (let* ((key (funcall group-fun 'title cand))
             (group (assoc key groups)))
        (if group
            (setcdr group (cons cand (cdr group)))
          (push (list key cand) groups))))
    ;; FIXME: Is thread-last allowed in minibuffer.el?
    (setq groups (nreverse groups)
          groups (mapc (lambda (x)
                         (setcdr x (nreverse (cdr x))))
                       groups)
          groups (funcall group-fun 'sort groups)
          groups (mapcar #'cdr groups))
    (apply #'nconc groups)))

Daniel

Re: [PATCH] `completing-read`: Add `group-function` support to completion metadata (REVISED PATCH VERSION 4)

[Juri Linkov]

>> I attached the current set of patches. The last patch
>> "0005-group-function-Implement-generalized-action-argument.patch"
>> implements the generalized action argument. The other patches (1-4) do
>> not differ from the previously sent patches. I send them for completeness.

Thanks, I tested it with mule--ucs-names-group, and everything works well.

> Correction to the lastest patch. The `minibuffer--group-by` function
> should actually be written as follows:
>
> (defun minibuffer--group-by (group-fun elems)
>   "Group ELEMS by GROUP-FUN."
>   (let ((groups))
>     (dolist (cand elems)
>       (let* ((key (funcall group-fun 'title cand))
>              (group (assoc key groups)))
>         (if group
>             (setcdr group (cons cand (cdr group)))
>           (push (list key cand) groups))))
>     ;; FIXME: Is thread-last allowed in minibuffer.el?

subr-x is not preloaded, but since thread-last is a macro maybe it's possible
to expand it during compilation: (eval-when-compile (require 'subr-x))

>     (setq groups (nreverse groups)
>           groups (mapc (lambda (x)
>                          (setcdr x (nreverse (cdr x))))
>                        groups)
>           groups (funcall group-fun 'sort groups)
>           groups (mapcar #'cdr groups))
>     (apply #'nconc groups)))

Or maybe simply `mapcan`.

Re: [PATCH] `completing-read`: Add `group-function` support to completion metadata (REVISED PATCH VERSION 4)

[Daniel Mendler]

On 5/9/21 7:59 PM, Juri Linkov wrote:
>>> I attached the current set of patches. The last patch
>>> "0005-group-function-Implement-generalized-action-argument.patch"
>>> implements the generalized action argument. The other patches (1-4) do
>>> not differ from the previously sent patches. I send them for completeness.
> > Thanks, I tested it with mule--ucs-names-group, and everything works well.

So what is the plan regarding the patch? Use the variant which has the
action argument (title, transform, sort) or use the variant with the
boolean transform argument, which does not allow sorting of the groups?

Stefan stated in his mail that letting the UI decide if the groups
should be sorted alphabetically is also a possibility. We can implement
this proposal by adding a `completions-sort` variable to minibuffer.el,
which is respected by the *Completions* buffer. If the variable is
non-nil, the groups are sorted alphabetically, otherwise the candidate
order determines the order of the groups.

Daniel

Re: [PATCH] `completing-read`: Add `group-function` support to completion metadata (REVISED PATCH VERSION 4)

[Stefan Monnier]

> Stefan stated in his mail that letting the UI decide if the groups
> should be sorted alphabetically is also a possibility.

I think in the case of the ucs-char-names completion-table, the group
sorting option we propose (alphabetical) is not really specific to the
completion table, so I don't see the point of putting the control (and
work) in the hands of the completion-table.


        Stefan

Re: [PATCH] `completing-read`: Add `group-function` support to completion metadata (REVISED PATCH VERSION 4)

[Daniel Mendler]

On 5/9/21 8:56 PM, Stefan Monnier wrote:
> I think in the case of the ucs-char-names completion-table, the group
> sorting option we propose (alphabetical) is not really specific to the
> completion table, so I don't see the point of putting the control (and
> work) in the hands of the completion-table.

Yes, and I don't think there many sensible options on how you want to
sort the groups after all. Therefore it is questionable if the
generalization of the `group-function` is needed. Either one uses the
natural candidate order to determine the group order or one sorts the
groups alphabetically.

In the case of vertical UIs like Ivy, Selectrum and Vertico I prefer to
have the candidate order determine the group order, since this ensures
that the most likely candidate occurs first.

In the case of the default completion UI it may be more reasonable to
always sort the groups alphabetically, such that the overall view is
more predictable.

However if it turns out that we need the generality in the end it may be
better to include the possibility right away as I proposed in my last patch.

Daniel

Re: [PATCH] `completing-read`: Add `group-function` support to completion metadata (REVISED PATCH VERSION 4)

[Juri Linkov]

> So what is the plan regarding the patch? Use the variant which has the
> action argument (title, transform, sort) or use the variant with the
> boolean transform argument, which does not allow sorting of the groups?
>
> Stefan stated in his mail that letting the UI decide if the groups
> should be sorted alphabetically is also a possibility. We can implement
> this proposal by adding a `completions-sort` variable to minibuffer.el,

Probably you meant to name it `completions-group-sort`
since the name `completions-sort` is too ambiguous?

Then such an option could support any function to perform sorting,
and when necessary the API user could let-bind it around
the API call, e.g. in the case of the ucs-char-names:

diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el
index 5a7e417b8e..e7b56dd8e0 100644
--- a/lisp/international/mule-cmds.el
+++ b/lisp/international/mule-cmds.el
@@ -3161,6 +3161,10 @@ read-char-by-name
   (let* ((enable-recursive-minibuffers t)
 	 (completion-ignore-case t)
 	 (completion-tab-width 4)
+	 (completions-group-sort
+	  (if read-char-by-name-group-sort
+	      (lambda (a b) (string< (car a) (car b)))
+	    completions-group-sort))
 	 (input
 	  (completing-read
 	   prompt

This is just an example, I'm not sure if read-char-by-name-group-sort is
really needed, but this example demonstrates that it's up to the user to
define options more specific to the completion table.

Re: [PATCH] `completing-read`: Add `group-function` support to completion metadata (REVISED PATCH VERSION 5)

[Daniel Mendler]

[-- Attachment #1: Type: text/plain, Size: 1401 bytes --]

On 5/10/21 10:47 PM, Juri Linkov wrote:
> Probably you meant to name it `completions-group-sort`
> since the name `completions-sort` is too ambiguous?

Yes, I meant to add a `completions-group-sort(-function)` customizable
variable.

I attached the updated patch set, where the last patch
"0005-minibuffer-completion-help-Add-group-sorting.patch" adds the
`completions-group-sort-function` variable. (The behavior is equivalent
to the previous patch set where the `group-function` has a generalized
action argument.)

> Then such an option could support any function to perform sorting,
> and when necessary the API user could let-bind it around
> the API call, e.g. in the case of the ucs-char-names:> ...
> This is just an example, I'm not sure if read-char-by-name-group-sort is
> really needed, but this example demonstrates that it's up to the user to
> define options more specific to the completion table.

Of course, a completion command can let-bind/override certain
dynamically bound variables which influence the behavior of the
completion UI. However there are two downsides to be noted:

1. By doing such an override the ability of the user to configure the
completion UI is subverted.
2. Since the variables are let-bound, they influence the behavior of
nested recursive completion sessions. It is better to override the
variables with `setq-local` in a `minibuffer-setup-hook`.

Daniel

[-- Attachment #2: 0001-completing-read-Add-group-function-to-completion-met.patch --]
[-- Type: text/x-diff, Size: 18517 bytes --]

From 7363482bf15ac321704aa0e912fa2727d3ea38ed Mon Sep 17 00:00:00 2001
From: Daniel Mendler <mail@daniel-mendler.de>
Date: Sun, 25 Apr 2021 13:07:29 +0200
Subject: [PATCH 1/5] (completing-read): Add `group-function` to completion
 metadata

A completion table can specify a `group-function` in its metadata.
The group function takes two arguments, a completion candidate and a
transform argument. The group function is used to group the candidates
after sorting and to enhance the completion UI with group titles.

If the transform argument is nil, the function must return the title
of the group to which the completion candidate belongs. The function
may also return nil in case the candidate does not belong to a group.

Otherwise the function must return the transformed candidate. The
transformation allows for example to remove a part of the candidate,
which is then displayed in the title.

The grouping functionality guarded by the variable `completions-group`
and turned off by default for the *Completions* buffer.

The specific form of the `group-function` has been chosen in order to
allow allocation-free grouping. This is important for completion UIs,
which continously update the displayed set of candidates (Icomplete,
Vertico, Ivy, etc.). Only when the transform argument is non-nil the
candidate transformation is performed, which may involve a string
allocation as for example in `xref--completing-read-group`.

The function `xref-show-definitions-completing-read` makes use of the
`group-function`, by moving the file name prefix to the title. If
grouping is enabled, the *Completions* are displayed as
"linenum:summary" instead of "file:linenum:summary". This way the
*Completions* buffer resembles the *Occur* buffer.

* doc/lispref/minibuf.texi: Add documentation.

* lisp/minibuffer.el (completion-metadata): Describe `group-function`
in the docstring.
(completions-group): Add guard variable, by default off.
(completions-group-format): Add format string for group titles.
(completions-group-title): Add face for group titles.
(completions-group-separator): Add face for group separator.
(minibuffer--group-by): New grouping function.
(minibuffer-completion-help): Use it.
(display-completion-list): Add optional GROUP-FUN argument.
(completion--insert-strings): Add optional GROUP-FUN argument. Insert
group titles if `completions-format` is `one-column`. Transform each
candidate with the GROUP-FUN. Attach the untransformed candidate to
the property `completion--string`.

* lisp/simple.el (choose-completion): Retrieve the untransformed
completion candidate from the property `completion--string`.

* lisp/progmodes/xref.el:
(xref--completing-read-group): New grouping function.
(xref-show-definitions-completing-read): Use it.
---
 doc/lispref/minibuf.texi |  10 ++++
 lisp/minibuffer.el       | 123 ++++++++++++++++++++++++++++++++-------
 lisp/progmodes/xref.el   |  18 ++++--
 lisp/simple.el           |  11 ++--
 4 files changed, 131 insertions(+), 31 deletions(-)

diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi
index 145eee8f06..aa57c2bda0 100644
--- a/doc/lispref/minibuf.texi
+++ b/doc/lispref/minibuf.texi
@@ -1943,6 +1943,16 @@ Programmed Completion
 a suffix displayed after the completion string.  This function
 takes priority over @code{annotation-function}.
 
+@item group-function
+The value should be a function for grouping the completion candidates.
+The function must take two arguments, @var{completion}, which is a
+completion candidate and @var{transform}, which is a boolean flag.  If
+@var{transform} is @code{nil}, the function must return a group title,
+to which the candidate belongs. The returned title can also
+@code{nil}.  Otherwise the function must return the transformed
+candidate. The transformation can for example remove a redundant
+prefix, which is displayed in the group title instead.
+
 @item display-sort-function
 The value should be a function for sorting completions.  The function
 should take one argument, a list of completion strings, and return a
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index caf06ec710..e21a699dae 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -126,6 +126,13 @@ completion-metadata
    three-element lists: completion, its prefix and suffix.  This
    function takes priority over `annotation-function' when both are
    provided, so only this function is used.
+- `group-function': function for grouping the completion candidates.
+   Takes two arguments: a completion candidate (COMPLETION) and a
+   boolean flag (TRANSFORM).  If TRANSFORM is nil, the function
+   returns a group title, to which the candidate belongs.  The
+   returned title may be nil.  Otherwise the function returns the
+   transformed candidate.  The transformation can remove a redundant
+   prefix, which is displayed in the group title instead.
 - `display-sort-function': function to sort entries in *Completions*.
    Takes one argument (COMPLETIONS) and should return a new list
    of completions.  Can operate destructively.
@@ -1138,6 +1145,30 @@ completion-cycle-threshold
   :version "24.1"
   :type completion--cycling-threshold-type)
 
+(defcustom completions-group nil
+  "Enable grouping of completion candidates in the *Completions* buffer.
+See also `completions-group-format'."
+  :type 'boolean
+  :version "28.1")
+
+(defcustom completions-group-format
+  (concat
+   (propertize "    " 'face 'completions-group-separator)
+   (propertize " %s " 'face 'completions-group-title)
+   (propertize " " 'face 'completions-group-separator
+               'display '(space :align-to right)))
+  "Format string used for the group title."
+  :type 'string
+  :version "28.1")
+
+(defface completions-group-title '((t :inherit shadow :slant italic))
+  "Face used for the title text of the candidate group headlines."
+  :version "28.1")
+
+(defface completions-group-separator '((t :inherit shadow :strike-through t))
+  "Face used for the separator lines of the candidate groups."
+  :version "28.1")
+
 (defun completion--cycle-threshold (metadata)
   (let* ((cat (completion-metadata-get metadata 'category))
          (over (completion--category-override cat 'cycle)))
@@ -1401,6 +1432,17 @@ minibuffer--sort-preprocess-history
                      (substring c base-size)))
                  hist)))))
 
+(defun minibuffer--group-by (fun elems)
+  "Group ELEMS by FUN."
+  (let ((groups))
+    (dolist (cand elems)
+      (let* ((key (funcall fun cand nil))
+             (group (assoc key groups)))
+        (if group
+            (setcdr group (cons cand (cdr group)))
+          (push (list key cand) groups))))
+    (mapcan (lambda (x) (nreverse (cdr x))) (nreverse groups))))
+
 (defun completion-all-sorted-completions (&optional start end)
   (or completion-all-sorted-completions
       (let* ((start (or start (minibuffer-prompt-end)))
@@ -1747,11 +1789,17 @@ completions-detailed
   :type 'boolean
   :version "28.1")
 
-(defun completion--insert-strings (strings)
+;; TODO: Split up this function in one function per `completions-format'.
+;; TODO: Add group title support for horizontal and vertical format.
+(defun completion--insert-strings (strings &optional group-fun)
   "Insert a list of STRINGS into the current buffer.
-Uses columns to keep the listing readable but compact.
-It also eliminates runs of equal strings."
+Uses columns to keep the listing readable but compact.  It also
+eliminates runs of equal strings.  GROUP-FUN is a `group-function'
+used for grouping the completion."
   (when (consp strings)
+    ;; FIXME: Currently grouping is enabled only for the 'one-column format.
+    (unless (eq completions-format 'one-column)
+      (setq group-fun nil))
     (let* ((length (apply #'max
 			  (mapcar (lambda (s)
 				    (if (consp s)
@@ -1768,6 +1816,7 @@ completion--insert-strings
 		     (max 1 (/ (length strings) 2))))
 	   (colwidth (/ wwidth columns))
            (column 0)
+           (last-title nil)
 	   (rows (/ (length strings) columns))
 	   (row 0)
            (first t)
@@ -1780,6 +1829,13 @@ completion--insert-strings
       ;; The insertion should be "sensible" no matter what choices were made
       ;; for the parameters above.
       (dolist (str strings)
+        ;; Add group titles.
+        (when group-fun
+          (let ((title (funcall group-fun (if (consp str) (car str) str) nil)))
+            (unless (equal title last-title)
+              (when title
+                (insert (format completions-group-format title) "\n"))
+              (setq last-title title))))
 	(unless (equal laststring str) ; Remove (consecutive) duplicates.
 	  (setq laststring str)
           ;; FIXME: `string-width' doesn't pay attention to
@@ -1825,8 +1881,15 @@ completion--insert-strings
 		  nil))))
             (setq first nil)
             (if (not (consp str))
-                (put-text-property (point) (progn (insert str) (point))
-                                   'mouse-face 'highlight)
+                (add-text-properties
+                 (point)
+                 (progn
+                   (insert
+                    (if group-fun
+                        (funcall group-fun str 'transform)
+                      str))
+                   (point))
+                 `(mouse-face highlight completion--string ,str))
               ;; If `str' is a list that has 2 elements,
               ;; then the second element is a suffix annotation.
               ;; If `str' has 3 elements, then the second element
@@ -1837,8 +1900,15 @@ completion--insert-strings
                   (let ((beg (point))
                         (end (progn (insert prefix) (point))))
                     (put-text-property beg end 'mouse-face nil)))
-                (put-text-property (point) (progn (insert (car str)) (point))
-                                   'mouse-face 'highlight)
+                (add-text-properties
+                 (point)
+                 (progn
+                   (insert
+                    (if group-fun
+                         (funcall group-fun (car str) 'transform)
+                      (car str)))
+                   (point))
+                 `(mouse-face highlight completion--string ,(car str)))
                 (let ((beg (point))
                       (end (progn (insert suffix) (point))))
                   (put-text-property beg end 'mouse-face nil)
@@ -1923,7 +1993,7 @@ completion-hilit-commonality
         completions)
        base-size))))
 
-(defun display-completion-list (completions &optional common-substring)
+(defun display-completion-list (completions &optional common-substring group-fun)
   "Display the list of completions, COMPLETIONS, using `standard-output'.
 Each element may be just a symbol or string
 or may be a list of two strings to be printed as if concatenated.
@@ -1933,7 +2003,8 @@ display-completion-list
 The actual completion alternatives, as inserted, are given `mouse-face'
 properties of `highlight'.
 At the end, this runs the normal hook `completion-setup-hook'.
-It can find the completion buffer in `standard-output'."
+It can find the completion buffer in `standard-output'.
+GROUP-FUN is a `group-function' used for grouping the completion."
   (declare (advertised-calling-convention (completions) "24.4"))
   (if common-substring
       (setq completions (completion-hilit-commonality
@@ -1946,7 +2017,7 @@ display-completion-list
 	(let ((standard-output (current-buffer))
 	      (completion-setup-hook nil))
           (with-suppressed-warnings ((callargs display-completion-list))
-	    (display-completion-list completions common-substring)))
+	    (display-completion-list completions common-substring group-fun)))
 	(princ (buffer-string)))
 
     (with-current-buffer standard-output
@@ -1954,7 +2025,7 @@ display-completion-list
       (if (null completions)
           (insert "There are no possible completions of what you have typed.")
         (insert "Possible completions are:\n")
-        (completion--insert-strings completions))))
+        (completion--insert-strings completions group-fun))))
 
   (run-hooks 'completion-setup-hook)
   nil)
@@ -2067,6 +2138,9 @@ minibuffer-completion-help
              (aff-fun (or (completion-metadata-get all-md 'affixation-function)
                           (plist-get completion-extra-properties
                                      :affixation-function)))
+             (sort-fun (completion-metadata-get all-md 'display-sort-function))
+             (group-fun (and completions-group
+                             (completion-metadata-get all-md 'group-function)))
              (mainbuf (current-buffer))
              ;; If the *Completions* buffer is shown in a new
              ;; window, mark it as softly-dedicated, so bury-buffer in
@@ -2098,15 +2172,22 @@ minibuffer-completion-help
                       ;; Remove the base-size tail because `sort' requires a properly
                       ;; nil-terminated list.
                       (when last (setcdr last nil))
-                      (setq completions
-                            ;; FIXME: This function is for the output of all-completions,
-                            ;; not completion-all-completions.  Often it's the same, but
-                            ;; not always.
-                            (let ((sort-fun (completion-metadata-get
-                                             all-md 'display-sort-function)))
-                              (if sort-fun
-                                  (funcall sort-fun completions)
-                                (sort completions 'string-lessp))))
+
+                      ;; Sort first using the `display-sort-function'.
+                      ;; FIXME: This function is for the output of
+                      ;; all-completions, not
+                      ;; completion-all-completions.  Often it's the
+                      ;; same, but not always.
+                      (setq completions (if sort-fun
+                                            (funcall sort-fun completions)
+                                          (sort completions 'string-lessp)))
+
+                      ;; After sorting, group the candidates using the
+                      ;; `group-function'.
+                      (when group-fun
+                        (setq completions
+                              (minibuffer--group-by group-fun completions)))
+
                       (cond
                        (aff-fun
                         (setq completions
@@ -2152,7 +2233,7 @@ minibuffer-completion-help
                                                      (if (eq (car bounds) (length result))
                                                          'exact 'finished)))))))
 
-                      (display-completion-list completions)))))
+                      (display-completion-list completions nil group-fun)))))
           nil)))
     nil))
 
diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el
index 7fc7181acc..2a4fb2c417 100644
--- a/lisp/progmodes/xref.el
+++ b/lisp/progmodes/xref.el
@@ -1044,6 +1044,12 @@ xref-show-definitions-buffer-at-bottom
 (define-obsolete-function-alias 'xref--show-defs-buffer-at-bottom
   #'xref-show-definitions-buffer-at-bottom "28.1")
 
+(defun xref--completing-read-group (cand transform)
+  "Return group title of candidate CAND or TRANSFORM the candidate."
+  (if transform
+      (substring cand (1+ (next-single-property-change 0 'xref--group cand)))
+    (get-text-property 0 'xref--group cand)))
+
 (defun xref-show-definitions-completing-read (fetcher alist)
   "Let the user choose the target definition with completion.
 
@@ -1072,10 +1078,12 @@ xref-show-definitions-completing-read
                                     (format #("%d:" 0 2 (face xref-line-number))
                                             line)
                                   ""))
+                               (group-prefix
+                                (substring group group-prefix-length))
                                (group-fmt
-                                (propertize
-                                 (substring group group-prefix-length)
-                                 'face 'xref-file-header))
+                                (propertize group-prefix
+                                            'face 'xref-file-header
+                                            'xref--group group-prefix))
                                (candidate
                                 (format "%s:%s%s" group-fmt line-fmt summary)))
                           (push (cons candidate xref) xref-alist-with-line-info)))))
@@ -1087,7 +1095,9 @@ xref-show-definitions-completing-read
                          (lambda (string pred action)
                            (cond
                             ((eq action 'metadata)
-                             '(metadata . ((category . xref-location))))
+                             `(metadata
+                               . ((category . xref-location)
+                                  (group-function . ,#'xref--completing-read-group))))
                             (t
                              (complete-with-action action collection string pred)))))
                         (def (caar collection)))
diff --git a/lisp/simple.el b/lisp/simple.el
index b4e34f1e4c..fe7ff0333f 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -8876,18 +8876,17 @@ choose-completion
           (choice
            (save-excursion
              (goto-char (posn-point (event-start event)))
-             (let (beg end)
+             (let (beg)
                (cond
                 ((and (not (eobp)) (get-text-property (point) 'mouse-face))
-                 (setq end (point) beg (1+ (point))))
+                 (setq beg (1+ (point))))
                 ((and (not (bobp))
                       (get-text-property (1- (point)) 'mouse-face))
-                 (setq end (1- (point)) beg (point)))
+                 (setq beg (point)))
                 (t (error "No completion here")))
                (setq beg (previous-single-property-change beg 'mouse-face))
-               (setq end (or (next-single-property-change end 'mouse-face)
-                             (point-max)))
-               (buffer-substring-no-properties beg end)))))
+               (substring-no-properties
+                (get-text-property beg 'completion--string))))))
 
       (unless (buffer-live-p buffer)
         (error "Destination buffer is dead"))
-- 
2.20.1


[-- Attachment #3: 0002-completion-insert-strings-Split-function-Full-group-.patch --]
[-- Type: text/x-diff, Size: 13458 bytes --]

From f9d777401620c7001ec29f517cdf0ffd6945e275 Mon Sep 17 00:00:00 2001
From: Daniel Mendler <mail@daniel-mendler.de>
Date: Fri, 30 Apr 2021 08:40:59 +0200
Subject: [PATCH 2/5] (completion--insert-strings): Split function; Full group
 title support

Split `completion--insert-strings` into a function per completions
format in order to increase readability and extensibility. This change
eases the addition of more formats. Add support for group titles to
the vertical and horizontal format.

* minibuffer.el (completion--insert): Add new function.
(completion--insert-vertical, completion--insert-horizontal,
completion--insert-one-column): Extract new function from
`completion--insert-strings`. Use `completion--insert`.
(completion--insert-strings): Use new insertion functions.
---
 lisp/minibuffer.el | 269 ++++++++++++++++++++++++++-------------------
 1 file changed, 154 insertions(+), 115 deletions(-)

diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index e21a699dae..cf1a4350bd 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -1789,21 +1789,16 @@ completions-detailed
   :type 'boolean
   :version "28.1")
 
-;; TODO: Split up this function in one function per `completions-format'.
-;; TODO: Add group title support for horizontal and vertical format.
 (defun completion--insert-strings (strings &optional group-fun)
   "Insert a list of STRINGS into the current buffer.
 Uses columns to keep the listing readable but compact.  It also
 eliminates runs of equal strings.  GROUP-FUN is a `group-function'
 used for grouping the completion."
   (when (consp strings)
-    ;; FIXME: Currently grouping is enabled only for the 'one-column format.
-    (unless (eq completions-format 'one-column)
-      (setq group-fun nil))
     (let* ((length (apply #'max
 			  (mapcar (lambda (s)
 				    (if (consp s)
-					(apply #'+ (mapcar #'string-width s))
+				        (apply #'+ (mapcar #'string-width s))
 				      (string-width s)))
 				  strings)))
 	   (window (get-buffer-window (current-buffer) 0))
@@ -1814,126 +1809,170 @@ completion--insert-strings
 		     ;; Don't allocate more columns than we can fill.
 		     ;; Windows can't show less than 3 lines anyway.
 		     (max 1 (/ (length strings) 2))))
-	   (colwidth (/ wwidth columns))
-           (column 0)
-           (last-title nil)
-	   (rows (/ (length strings) columns))
-	   (row 0)
-           (first t)
-	   (laststring nil))
+	   (colwidth (/ wwidth columns)))
       (unless (or tab-stop-list (null completion-tab-width)
                   (zerop (mod colwidth completion-tab-width)))
         ;; Align to tab positions for the case
         ;; when the caller uses tabs inside prefix.
         (setq colwidth (- colwidth (mod colwidth completion-tab-width))))
-      ;; The insertion should be "sensible" no matter what choices were made
-      ;; for the parameters above.
-      (dolist (str strings)
-        ;; Add group titles.
+      (funcall (intern (format "completion--insert-%s" completions-format))
+               strings group-fun length wwidth colwidth columns))))
+
+(defun completion--insert-horizontal (strings group-fun
+                                              length wwidth
+                                              colwidth _columns)
+  (let ((column 0)
+        (first t)
+	(last-title nil)
+        (last-string nil))
+    (dolist (str strings)
+      (unless (equal last-string str) ; Remove (consecutive) duplicates.
+	(setq last-string str)
         (when group-fun
           (let ((title (funcall group-fun (if (consp str) (car str) str) nil)))
             (unless (equal title last-title)
+              (setq last-title title)
               (when title
-                (insert (format completions-group-format title) "\n"))
-              (setq last-title title))))
-	(unless (equal laststring str) ; Remove (consecutive) duplicates.
-	  (setq laststring str)
+                (insert (if first "" "\n") (format completions-group-format title) "\n")
+                (setq column 0
+                      first t)))))
+	(unless first
           ;; FIXME: `string-width' doesn't pay attention to
           ;; `display' properties.
-          (let ((length (if (consp str)
-                            (apply #'+ (mapcar #'string-width str))
-                          (string-width str))))
-            (cond
-             ((eq completions-format 'one-column)
-              ;; Nothing special
-              )
-	     ((eq completions-format 'vertical)
-	      ;; Vertical format
-	      (when (> row rows)
-		(forward-line (- -1 rows))
-		(setq row 0 column (+ column colwidth)))
-	      (when (> column 0)
-		(end-of-line)
-		(while (> (current-column) column)
-		  (if (eobp)
-		      (insert "\n")
-		    (forward-line 1)
-		    (end-of-line)))
-		(insert " \t")
-		(set-text-properties (1- (point)) (point)
-				     `(display (space :align-to ,column)))))
-	     (t
-	      ;; Horizontal format
-	      (unless first
-		(if (< wwidth (+ (max colwidth length) column))
-		    ;; No space for `str' at point, move to next line.
-		    (progn (insert "\n") (setq column 0))
-		  (insert " \t")
-		  ;; Leave the space unpropertized so that in the case we're
-		  ;; already past the goal column, there is still
-		  ;; a space displayed.
-		  (set-text-properties (1- (point)) (point)
-				       ;; We can set tab-width using
-				       ;; completion-tab-width, but
-				       ;; the caller can prefer using
-				       ;; \t to align prefixes.
-				       `(display (space :align-to ,column)))
-		  nil))))
-            (setq first nil)
-            (if (not (consp str))
-                (add-text-properties
-                 (point)
-                 (progn
-                   (insert
-                    (if group-fun
-                        (funcall group-fun str 'transform)
-                      str))
-                   (point))
-                 `(mouse-face highlight completion--string ,str))
-              ;; If `str' is a list that has 2 elements,
-              ;; then the second element is a suffix annotation.
-              ;; If `str' has 3 elements, then the second element
-              ;; is a prefix, and the third element is a suffix.
-              (let* ((prefix (when (nth 2 str) (nth 1 str)))
-                     (suffix (or (nth 2 str) (nth 1 str))))
-                (when prefix
-                  (let ((beg (point))
-                        (end (progn (insert prefix) (point))))
-                    (put-text-property beg end 'mouse-face nil)))
-                (add-text-properties
-                 (point)
-                 (progn
-                   (insert
-                    (if group-fun
-                         (funcall group-fun (car str) 'transform)
-                      (car str)))
-                   (point))
-                 `(mouse-face highlight completion--string ,(car str)))
-                (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 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
-             ((eq completions-format 'one-column)
-              (insert "\n"))
-	     ((eq completions-format 'vertical)
-	      ;; Vertical format
-	      (if (> column 0)
-		  (forward-line)
-		(insert "\n"))
-	      (setq row (1+ row)))
-	     (t
-	      ;; Horizontal format
-	      ;; Next column to align to.
-	      (setq column (+ column
-			      ;; Round up to a whole number of columns.
-			      (* colwidth (ceiling length colwidth))))))))))))
+	  (if (< wwidth (+ column (max colwidth
+                                       (if (consp str)
+                                           (apply #'+ (mapcar #'string-width str))
+                                         (string-width str)))))
+	      ;; No space for `str' at point, move to next line.
+	      (progn (insert "\n") (setq column 0))
+	    (insert " \t")
+	    ;; Leave the space unpropertized so that in the case we're
+	    ;; already past the goal column, there is still
+	    ;; a space displayed.
+	    (set-text-properties (1- (point)) (point)
+				 ;; We can set tab-width using
+				 ;; completion-tab-width, but
+				 ;; the caller can prefer using
+				 ;; \t to align prefixes.
+				 `(display (space :align-to ,column)))
+	    nil))
+        (setq first nil)
+        (completion--insert str group-fun)
+	;; Next column to align to.
+	(setq column (+ column
+			;; Round up to a whole number of columns.
+			(* colwidth (ceiling length colwidth))))))))
+
+(defun completion--insert-vertical (strings group-fun
+                                            _length _wwidth
+                                            colwidth columns)
+  (let ((column 0)
+        (rows (/ (length strings) columns))
+	(row 0)
+	(last-title nil)
+	(last-string nil)
+        (start-point (point))
+        (next 0) (pos 0))
+    (dolist (str strings)
+      (unless (equal last-string str) ; Remove (consecutive) duplicates.
+	(setq last-string str)
+	(when (> row rows)
+	  (goto-char start-point)
+	  (setq row 0 column (+ column colwidth)))
+        (when group-fun
+          (let ((title (funcall group-fun (if (consp str) (car str) str) nil)))
+            (unless (equal title last-title)
+              (setq last-title title)
+              (when title
+                ;; Align before title insertion
+	        (when (> column 0)
+	          (end-of-line)
+	          (while (> (current-column) column)
+	            (if (eobp)
+		        (insert "\n")
+	              (forward-line 1)
+	              (end-of-line)))
+	          (insert " \t")
+	          (set-text-properties (1- (point)) (point)
+			               `(display (space :align-to ,column))))
+                (let* ((fmt completions-group-format)
+                       (len (length fmt)))
+                  ;; Adjust display space for columns
+                  (when (equal (get-text-property (- len 1) 'display fmt) '(space :align-to right))
+                    (setq fmt (substring fmt))
+                    (put-text-property (- len 1) len
+                                       'display
+                                       `(space :align-to ,(+ colwidth column -1))
+                                       fmt))
+                  (insert (format fmt title)))
+                ;; Align after title insertion
+	        (if (> column 0)
+	            (forward-line)
+	          (insert "\n"))))))
+        ;; Align before candidate insertion
+	(when (> column 0)
+	  (end-of-line)
+	  (while (> (current-column) column)
+	    (if (eobp)
+		(insert "\n")
+	      (forward-line 1)
+	      (end-of-line)))
+	  (insert " \t")
+	  (set-text-properties (1- (point)) (point)
+			       `(display (space :align-to ,column))))
+        (completion--insert str group-fun)
+        ;; Align after candidate insertion
+	(if (> column 0)
+	    (forward-line)
+	  (insert "\n"))
+	(setq row (1+ row))))))
+
+(defun completion--insert-one-column (strings group-fun &rest _)
+  (let ((last-title nil) (last-string nil))
+    (dolist (str strings)
+      (unless (equal last-string str) ; Remove (consecutive) duplicates.
+	(setq last-string str)
+        (when group-fun
+          (let ((title (funcall group-fun (if (consp str) (car str) str) nil)))
+            (unless (equal title last-title)
+              (setq last-title title)
+              (when title
+                (insert (format completions-group-format title) "\n")))))
+        (completion--insert str group-fun)
+        (insert "\n")))))
+
+(defun completion--insert (str group-fun)
+  (if (not (consp str))
+      (add-text-properties
+       (point)
+       (progn
+         (insert
+          (if group-fun
+              (funcall group-fun str 'transform)
+            str))
+         (point))
+       `(mouse-face highlight completion--string ,str))
+    ;; If `str' is a list that has 2 elements,
+    ;; then the second element is a suffix annotation.
+    ;; If `str' has 3 elements, then the second element
+    ;; is a prefix, and the third element is a suffix.
+    (let* ((prefix (when (nth 2 str) (nth 1 str)))
+           (suffix (or (nth 2 str) (nth 1 str))))
+      (when prefix
+        (let ((beg (point))
+              (end (progn (insert prefix) (point))))
+          (put-text-property beg end 'mouse-face nil)))
+      (completion--insert (car str) group-fun)
+      (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 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))))))
 
 (defvar completion-setup-hook nil
   "Normal hook run at the end of setting up a completion list buffer.
-- 
2.20.1


[-- Attachment #4: 0003-minibuffer-completion-help-Do-not-check-completions-.patch --]
[-- Type: text/x-diff, Size: 1378 bytes --]

From 3d516529c5439cba8cdd0508d382126827e77c9a Mon Sep 17 00:00:00 2001
From: Daniel Mendler <mail@daniel-mendler.de>
Date: Sun, 2 May 2021 15:50:08 +0200
Subject: [PATCH 3/5] (minibuffer-completion-help): Do not check
 `completions-group` centrally

The guard variable `completions-group` should be checked in each
completion table individually. The guard variable
`completions-detailed` variable is used in the same way.

* minibuffer.el (minibuffer-completion-help): Remove check of
  `completions-group`.
---
 lisp/minibuffer.el | 3 +--
 1 file changed, 1 insertion(+), 2 deletions(-)

diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index cf1a4350bd..b743b2bd40 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -2178,8 +2178,7 @@ minibuffer-completion-help
                           (plist-get completion-extra-properties
                                      :affixation-function)))
              (sort-fun (completion-metadata-get all-md 'display-sort-function))
-             (group-fun (and completions-group
-                             (completion-metadata-get all-md 'group-function)))
+             (group-fun (completion-metadata-get all-md 'group-function))
              (mainbuf (current-buffer))
              ;; If the *Completions* buffer is shown in a new
              ;; window, mark it as softly-dedicated, so bury-buffer in
-- 
2.20.1


[-- Attachment #5: 0004-completion-insert-vertical-Separate-groups-completel.patch --]
[-- Type: text/x-diff, Size: 5061 bytes --]

From 1c54509e1084099b6d3a6ef773e97812dbb5182d Mon Sep 17 00:00:00 2001
From: Daniel Mendler <mail@daniel-mendler.de>
Date: Sun, 2 May 2021 16:19:42 +0200
Subject: [PATCH 4/5] (completion--insert-vertical): Separate groups completely

Insert the candidates vertically within the groups, but keep the
groups completely separate using the full width group separators.

* minibuffer.el (completion--insert-vertical): Adjust grouping.
---
 lisp/minibuffer.el | 108 ++++++++++++++++++++-------------------------
 1 file changed, 48 insertions(+), 60 deletions(-)

diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index b743b2bd40..73a38a8137 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -1866,66 +1866,54 @@ completion--insert-horizontal
 (defun completion--insert-vertical (strings group-fun
                                             _length _wwidth
                                             colwidth columns)
-  (let ((column 0)
-        (rows (/ (length strings) columns))
-	(row 0)
-	(last-title nil)
-	(last-string nil)
-        (start-point (point))
-        (next 0) (pos 0))
-    (dolist (str strings)
-      (unless (equal last-string str) ; Remove (consecutive) duplicates.
-	(setq last-string str)
-	(when (> row rows)
-	  (goto-char start-point)
-	  (setq row 0 column (+ column colwidth)))
-        (when group-fun
-          (let ((title (funcall group-fun (if (consp str) (car str) str) nil)))
-            (unless (equal title last-title)
-              (setq last-title title)
-              (when title
-                ;; Align before title insertion
-	        (when (> column 0)
-	          (end-of-line)
-	          (while (> (current-column) column)
-	            (if (eobp)
-		        (insert "\n")
-	              (forward-line 1)
-	              (end-of-line)))
-	          (insert " \t")
-	          (set-text-properties (1- (point)) (point)
-			               `(display (space :align-to ,column))))
-                (let* ((fmt completions-group-format)
-                       (len (length fmt)))
-                  ;; Adjust display space for columns
-                  (when (equal (get-text-property (- len 1) 'display fmt) '(space :align-to right))
-                    (setq fmt (substring fmt))
-                    (put-text-property (- len 1) len
-                                       'display
-                                       `(space :align-to ,(+ colwidth column -1))
-                                       fmt))
-                  (insert (format fmt title)))
-                ;; Align after title insertion
-	        (if (> column 0)
-	            (forward-line)
-	          (insert "\n"))))))
-        ;; Align before candidate insertion
-	(when (> column 0)
-	  (end-of-line)
-	  (while (> (current-column) column)
-	    (if (eobp)
-		(insert "\n")
-	      (forward-line 1)
-	      (end-of-line)))
-	  (insert " \t")
-	  (set-text-properties (1- (point)) (point)
-			       `(display (space :align-to ,column))))
-        (completion--insert str group-fun)
-        ;; Align after candidate insertion
-	(if (> column 0)
-	    (forward-line)
-	  (insert "\n"))
-	(setq row (1+ row))))))
+  (while strings
+    (let ((group nil)
+          (column 0)
+	  (row 0)
+          (rows)
+          (last-string nil))
+      (if group-fun
+          (let* ((str (car strings))
+                 (title (funcall group-fun (if (consp str) (car str) str) nil)))
+            (while (and strings
+                        (equal title (funcall group-fun
+                                              (if (consp (car strings))
+                                                  (car (car strings))
+                                                (car strings))
+                                              nil)))
+              (push (car strings) group)
+              (pop strings))
+            (setq group (nreverse group)))
+        (setq group strings
+              strings nil))
+      (setq rows (/ (length group) columns))
+      (when group-fun
+        (let* ((str (car group))
+               (title (funcall group-fun (if (consp str) (car str) str) nil)))
+          (when title
+            (goto-char (point-max))
+            (insert (format completions-group-format title) "\n"))))
+      (dolist (str group)
+        (unless (equal last-string str) ; Remove (consecutive) duplicates.
+	  (setq last-string str)
+	  (when (> row rows)
+            (forward-line (- -1 rows))
+	    (setq row 0 column (+ column colwidth)))
+	  (when (> column 0)
+	    (end-of-line)
+	    (while (> (current-column) column)
+	      (if (eobp)
+		  (insert "\n")
+	        (forward-line 1)
+	        (end-of-line)))
+	    (insert " \t")
+	    (set-text-properties (1- (point)) (point)
+			         `(display (space :align-to ,column))))
+          (completion--insert str group-fun)
+	  (if (> column 0)
+	      (forward-line)
+	    (insert "\n"))
+	  (setq row (1+ row)))))))
 
 (defun completion--insert-one-column (strings group-fun &rest _)
   (let ((last-title nil) (last-string nil))
-- 
2.20.1


[-- Attachment #6: 0005-minibuffer-completion-help-Add-group-sorting.patch --]
[-- Type: text/x-diff, Size: 2850 bytes --]

From 070d8b972e5638ce90e7c2bb1608d16e53d516a4 Mon Sep 17 00:00:00 2001
From: Daniel Mendler <mail@daniel-mendler.de>
Date: Tue, 11 May 2021 09:08:05 +0200
Subject: [PATCH 5/5] (minibuffer-completion-help): Add group sorting

Allow sorting the groups as returned by the `group-function` of the
completion table with the `completions-group-sort-function`.

* lisp/minibuffer.el (completions-group-sort-function): New variable.
(minibuffer--group-by): Add SORT-FUN argument.
(minibuffer-completion-help): Pass `completions-group-sort-function`
to `minibuffer--group-by`.
---
 lisp/minibuffer.el | 26 +++++++++++++++++++++-----
 1 file changed, 21 insertions(+), 5 deletions(-)

diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 73a38a8137..3399a02014 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -1151,6 +1151,14 @@ completions-group
   :type 'boolean
   :version "28.1")
 
+(defcustom completions-group-sort-function #'identity
+  "Sorting function for the groups.
+The function takes and returns an alist of groups, where the each
+element is a pair of a group title string and the candidate strings
+belonging to the group."
+  :type 'function
+  :version "28.1")
+
 (defcustom completions-group-format
   (concat
    (propertize "    " 'face 'completions-group-separator)
@@ -1432,16 +1440,21 @@ minibuffer--sort-preprocess-history
                      (substring c base-size)))
                  hist)))))
 
-(defun minibuffer--group-by (fun elems)
-  "Group ELEMS by FUN."
+(defun minibuffer--group-by (group-fun sort-fun elems)
+  "Group ELEMS by GROUP-FUN and sort using SORT-FUN."
   (let ((groups))
     (dolist (cand elems)
-      (let* ((key (funcall fun cand nil))
+      (let* ((key (funcall group-fun cand nil))
              (group (assoc key groups)))
         (if group
             (setcdr group (cons cand (cdr group)))
           (push (list key cand) groups))))
-    (mapcan (lambda (x) (nreverse (cdr x))) (nreverse groups))))
+    (setq groups (nreverse groups)
+          groups (mapc (lambda (x)
+                         (setcdr x (nreverse (cdr x))))
+                       groups)
+          groups (funcall sort-fun groups))
+    (mapcan #'cdr groups)))
 
 (defun completion-all-sorted-completions (&optional start end)
   (or completion-all-sorted-completions
@@ -2212,7 +2225,10 @@ minibuffer-completion-help
                       ;; `group-function'.
                       (when group-fun
                         (setq completions
-                              (minibuffer--group-by group-fun completions)))
+                              (minibuffer--group-by
+                               group-fun
+                               completions-group-sort-function
+                               completions)))
 
                       (cond
                        (aff-fun
-- 
2.20.1

Re: [PATCH] `completing-read`: Add `group-function` support to completion metadata (REVISED PATCH VERSION 5)

[Juri Linkov]

> 1. By doing such an override the ability of the user to configure the
> completion UI is subverted.

Such an override could be advisable only when the API user provides
an equivalent user option with more choices when necessary.

> 2. Since the variables are let-bound, they influence the behavior of
> nested recursive completion sessions. It is better to override the
> variables with `setq-local` in a `minibuffer-setup-hook`.

Agreed.

> +(defcustom completions-group-sort-function #'identity
> +  "Sorting function for the groups.
> +The function takes and returns an alist of groups, where the each
> +element is a pair of a group title string and the candidate strings
> +belonging to the group."
> +  :type 'function
> +  :version "28.1")

As the most useful non-default choice, it could also include a function
to sort alphabetically.

Re: [PATCH] `completing-read`: Add `group-function` support to completion metadata (REVISED PATCH VERSION 2)

[Stefan Monnier]

> I tried to remove `read-char-by-name-group`, but it has a feature
> currently not supported by `group-function`:
>
>   (defcustom read-char-by-name-group nil
>     "How to group characters for `read-char-by-name' completion.
>   When t, split characters to sections of Unicode blocks
>   sorted alphabetically."
>   =====================
>
> It seems a new function is needed to sort groups, e.g. `group-sort-function`.

I think whether the groups should be sorted alphabetically or "by order
of appearance" can be a choice made by the UI rather than by the
completion-table.


        Stefan

Re: [PATCH] `completing-read`: Add `group-function` support to completion metadata (REVISED PATCH VERSION 2)

[Juri Linkov]

[-- Attachment #1: Type: text/plain, Size: 611 bytes --]

>>   (defcustom read-char-by-name-group nil
>>     "How to group characters for `read-char-by-name' completion.
>>   When t, split characters to sections of Unicode blocks
>>   sorted alphabetically."
>>   =====================
>>
>> It seems a new function is needed to sort groups, e.g. `group-sort-function`.
>
> I think whether the groups should be sorted alphabetically or "by order
> of appearance" can be a choice made by the UI rather than by the
> completion-table.

Then this patch adds a new option read-char-by-name-group-sort,
instead of read-char-by-name-group now replaced by completions-group:


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: read-char-by-name-group-sort.patch --]
[-- Type: text/x-diff, Size: 3786 bytes --]

diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el
index b99db46e45..5a7e417b8e 100644
--- a/lisp/international/mule-cmds.el
+++ b/lisp/international/mule-cmds.el
@@ -3088,35 +3088,14 @@ mule--ucs-names-affixation
               (list name (concat (if char (list char) " ") "\t") "")))
           names))
 
-(defun mule--ucs-names-group (names)
-  (let* ((codes-and-names
-          (mapcar (lambda (name) (cons (gethash name ucs-names) name)) names))
-         (grouped
-          (seq-group-by
-           (lambda (code-name)
-             (let ((script (aref char-script-table (car code-name))))
-               (if script (symbol-name script) "ungrouped")))
-           codes-and-names))
-         names-with-header header)
-    (dolist (group (sort grouped (lambda (a b) (string< (car a) (car b)))))
-      (setq header t)
-      (dolist (code-name (cdr group))
-        (push (list
-               (cdr code-name)
-               (concat
-                (if header
-                    (progn
-                      (setq header nil)
-                      (concat "\n" (propertize
-                                    (format "* %s\n" (car group))
-                                    'face 'header-line)))
-                  "")
-                ;; prefix
-                (if (car code-name) (format "%c" (car code-name)) " ") "\t")
-               ;; suffix
-               "")
-              names-with-header)))
-    (nreverse names-with-header)))
+(defun mule--ucs-names-group (action arg)
+  (pcase action
+    ('title (let ((script (aref char-script-table (gethash arg ucs-names))))
+              (if script (symbol-name script) "ungrouped")))
+    ('transform arg)
+    ('sort (if read-char-by-name-group-sort
+               (sort arg (lambda (a b) (string< (car a) (car b))))
+             arg))))
 
 (defun char-from-name (string &optional ignore-case)
   "Return a character as a number from its Unicode name STRING.
@@ -3148,11 +3127,12 @@ read-char-by-name-sort
   :group 'mule
   :version "28.1")
 
-(defcustom read-char-by-name-group nil
-  "How to group characters for `read-char-by-name' completion.
-When t, split characters to sections of Unicode blocks
-sorted alphabetically."
-  :type 'boolean
+(defcustom read-char-by-name-group-sort nil
+  "How to sort groups of characters for `read-char-by-name' completion.
+When t, sort sections of Unicode blocks alphabetically."
+  :type '(choice
+          (const :tag "Unsorted group names" nil)
+          (const :tag "Group names sorted alphabetically" t))
   :group 'mule
   :version "28.1")
 
@@ -3169,8 +3149,9 @@ read-char-by-name
 the characters whose names include that substring, not necessarily
 at the beginning of the name.
 
-The options `read-char-by-name-sort' and `read-char-by-name-group'
-define the sorting order of completion characters and how to group them.
+The options `read-char-by-name-sort', `completions-group', and
+`read-char-by-name-group-sort' define the sorting order of completion
+characters, how to group them, and how to sort groups.
 
 Accept a name like \"CIRCULATION FUNCTION\", a hexadecimal
 number like \"2A10\", or a number in hash notation (e.g.,
@@ -3189,10 +3170,11 @@ read-char-by-name
 		   (display-sort-function
 		    . ,(when (eq read-char-by-name-sort 'code)
                          #'mule--ucs-names-sort-by-code))
+		   (group-function
+		    . ,(when completions-group
+			 #'mule--ucs-names-group))
 		   (affixation-function
-		    . ,(if read-char-by-name-group
-                           #'mule--ucs-names-group
-                         #'mule--ucs-names-affixation))
+		    . ,#'mule--ucs-names-affixation)
 		   (category . unicode-name))
 	       (complete-with-action action (ucs-names) string pred)))))
 	 (char

Re: [PATCH] `completing-read`: Add `group-function` support to completion metadata (REVISED PATCH VERSION 2)

[Eli Zaretskii]

> From: Juri Linkov <juri@linkov.net>
> Date: Sun, 09 May 2021 21:05:15 +0300
> Cc: Daniel Mendler <mail@daniel-mendler.de>,
>  Gregory Heytings <gregory@heytings.org>,
>  "emacs-devel@gnu.org" <emacs-devel@gnu.org>, Dmitry Gutov <dgutov@yandex.ru>
> 
> +(defcustom read-char-by-name-group-sort nil
> +  "How to sort groups of characters for `read-char-by-name' completion.
> +When t, sort sections of Unicode blocks alphabetically."

This doesn't say what happens if the value is not t.  And since the
first sentence says "How to sort...", the idea that the result is
unsorted group names doesn't come to mind naturally.

Re: [PATCH] `completing-read`: Add `group-function` support to completion metadata (REVISED PATCH VERSION 2)

[Juri Linkov]

[-- Attachment #1: Type: text/plain, Size: 492 bytes --]

>> +(defcustom read-char-by-name-group-sort nil
>> +  "How to sort groups of characters for `read-char-by-name' completion.
>> +When t, sort sections of Unicode blocks alphabetically."
>
> This doesn't say what happens if the value is not t.  And since the
> first sentence says "How to sort...", the idea that the result is
> unsorted group names doesn't come to mind naturally.

Now read-char-by-name-group-sort is removed, since this can be
customized by completions-group-sort-function.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: read-char-by-name-group.patch --]
[-- Type: text/x-diff, Size: 3496 bytes --]

diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el
index 7f8d98b7ce..f7f8384e01 100644
--- a/lisp/international/mule-cmds.el
+++ b/lisp/international/mule-cmds.el
@@ -3104,35 +3104,11 @@ mule--ucs-names-affixation
               (list name (concat (if char (list char) " ") "\t") "")))
           names))
 
-(defun mule--ucs-names-group (names)
-  (let* ((codes-and-names
-          (mapcar (lambda (name) (cons (gethash name ucs-names) name)) names))
-         (grouped
-          (seq-group-by
-           (lambda (code-name)
-             (let ((script (aref char-script-table (car code-name))))
-               (if script (symbol-name script) "ungrouped")))
-           codes-and-names))
-         names-with-header header)
-    (dolist (group (sort grouped (lambda (a b) (string< (car a) (car b)))))
-      (setq header t)
-      (dolist (code-name (cdr group))
-        (push (list
-               (cdr code-name)
-               (concat
-                (if header
-                    (progn
-                      (setq header nil)
-                      (concat "\n" (propertize
-                                    (format "* %s\n" (car group))
-                                    'face 'header-line)))
-                  "")
-                ;; prefix
-                (if (car code-name) (format "%c" (car code-name)) " ") "\t")
-               ;; suffix
-               "")
-              names-with-header)))
-    (nreverse names-with-header)))
+(defun mule--ucs-names-group (name transform)
+  (if transform
+      name
+    (let ((script (aref char-script-table (gethash name ucs-names))))
+      (if script (symbol-name script) "ungrouped"))))
 
 (defun char-from-name (string &optional ignore-case)
   "Return a character as a number from its Unicode name STRING.
@@ -3164,14 +3140,6 @@ read-char-by-name-sort
   :group 'mule
   :version "28.1")
 
-(defcustom read-char-by-name-group nil
-  "How to group characters for `read-char-by-name' completion.
-When t, split characters to sections of Unicode blocks
-sorted alphabetically."
-  :type 'boolean
-  :group 'mule
-  :version "28.1")
-
 (defun read-char-by-name (prompt)
   "Read a character by its Unicode name or hex number string.
 Display PROMPT and read a string that represents a character by its
@@ -3185,8 +3153,9 @@ read-char-by-name
 the characters whose names include that substring, not necessarily
 at the beginning of the name.
 
-The options `read-char-by-name-sort' and `read-char-by-name-group'
-define the sorting order of completion characters and how to group them.
+The options `read-char-by-name-sort', `completions-group', and
+`completions-group-sort-function' define the sorting order of
+completion characters, whether to group them, and how to sort groups.
 
 Accept a name like \"CIRCULATION FUNCTION\", a hexadecimal
 number like \"2A10\", or a number in hash notation (e.g.,
@@ -3205,10 +3174,11 @@ read-char-by-name
 		   (display-sort-function
 		    . ,(when (eq read-char-by-name-sort 'code)
                          #'mule--ucs-names-sort-by-code))
+		   (group-function
+		    . ,(when completions-group
+			 #'mule--ucs-names-group))
 		   (affixation-function
-		    . ,(if read-char-by-name-group
-                           #'mule--ucs-names-group
-                         #'mule--ucs-names-affixation))
+		    . ,#'mule--ucs-names-affixation)
 		   (category . unicode-name))
 	       (complete-with-action action (ucs-names) string pred)))))
 	 (char

Re: [PATCH] `completing-read`: Add `group-function` support to completion metadata (REVISED PATCH VERSION 2)

[Eli Zaretskii]

> From: Juri Linkov <juri@linkov.net>
> Date: Tue, 11 May 2021 21:06:53 +0300
> Cc: mail@daniel-mendler.de, gregory@heytings.org, dgutov@yandex.ru,
>  monnier@iro.umontreal.ca, emacs-devel@gnu.org
> 
> >> +(defcustom read-char-by-name-group-sort nil
> >> +  "How to sort groups of characters for `read-char-by-name' completion.
> >> +When t, sort sections of Unicode blocks alphabetically."
> >
> > This doesn't say what happens if the value is not t.  And since the
> > first sentence says "How to sort...", the idea that the result is
> > unsorted group names doesn't come to mind naturally.
> 
> Now read-char-by-name-group-sort is removed, since this can be
> customized by completions-group-sort-function.

And this is supposed to be progress? to force users to customize
sorting by providing their own functions?  IMO, it is a step backward,
not forward: we are making Emacs harder to use for everyone who isn't
a Lisp programmer.

Btw, I don't see the variable you mention anywhere in the current
master.  What am I missing?

Re: [PATCH] `completing-read`: Add `group-function` support to completion metadata (REVISED PATCH VERSION 2)

[Daniel Mendler]

On 5/11/21 8:44 PM, Eli Zaretskii wrote:
> And this is supposed to be progress? to force users to customize
> sorting by providing their own functions?  IMO, it is a step backward,
> not forward: we are making Emacs harder to use for everyone who isn't
> a Lisp programmer.

What about providing a group sort function which sorts alphabetically as
Juri already proposed? Alphabetical sorting can be offered as choice for
in the defcustom.

(defcustom completions-group-sort-function #'identity
  "Sorting function for the groups.
The function takes and returns an alist of groups, where the each
element is a pair of a group title string and the candidate strings
belonging to the group."
  :type '(choice
          (const :tag "No sorting"
                 identity)
          (const :tag "Alphabetical sorting"
                 completions-group-sort-alphabeticaly)
          function)
  :version "28.1")

> Btw, I don't see the variable you mention anywhere in the current
> master.  What am I missing?

The group function patch has not been merged yet.

Daniel

Re: [PATCH] `completing-read`: Add `group-function` support to completion metadata (REVISED PATCH VERSION 2)

[Eli Zaretskii]

> Cc: gregory@heytings.org, dgutov@yandex.ru, monnier@iro.umontreal.ca,
>  emacs-devel@gnu.org
> From: Daniel Mendler <mail@daniel-mendler.de>
> Date: Tue, 11 May 2021 20:58:33 +0200
> 
> On 5/11/21 8:44 PM, Eli Zaretskii wrote:
> > And this is supposed to be progress? to force users to customize
> > sorting by providing their own functions?  IMO, it is a step backward,
> > not forward: we are making Emacs harder to use for everyone who isn't
> > a Lisp programmer.
> 
> What about providing a group sort function which sorts alphabetically as
> Juri already proposed? Alphabetical sorting can be offered as choice for
> in the defcustom.

That's slightly better, but only slightly: you still expect users to
manipulate functions, something that they don't necessarily understand
well enough.

Why not provide a defcustom that can accept both simple value, for the
most popular sort methods, and also allow function values for advanced
users?

> (defcustom completions-group-sort-function #'identity
>   "Sorting function for the groups.
> The function takes and returns an alist of groups, where the each
> element is a pair of a group title string and the candidate strings
> belonging to the group."

Thanks.  Now try putting yourself into the shoes of a newbie and try
imagining what can he/she make out of this doc string.  "Function
taking and returning an alist"? really?

Re: [PATCH] `completing-read`: Add `group-function` support to completion metadata (REVISED PATCH VERSION 2)

[Daniel Mendler]

On 5/11/21 9:22 PM, Eli Zaretskii wrote:
> Why not provide a defcustom that can accept both simple value, for the
> most popular sort methods, and also allow function values for advanced
> users?

This is exactly what I did. If the user selects "No sorting" the value
identity is taken and if the value "Sort alphabetically" is selected,
the value completions-group-sort-alphabetically is taken. There is no
point in introducing another symbolic indirection. We could add more
options in case some more reasonable group sortings come up. There is no
need for a newbie to directly manipulate functions.

> Thanks.  Now try putting yourself into the shoes of a newbie and try
> imagining what can he/she make out of this doc string.  "Function
> taking and returning an alist"? really?

The snippet which I just sent is a proposal. Up to now there has been a
bit of back and forth of how the grouping feature is best implemented.
Under these circumstances it does not make sense to send a fully
polished patch each time. But by now the discussion seems to have
somehow concluded, or at least I interpret that there is some agreement
between the participants of the discussion which was mostly Juri,
Stefan, Dmitry and myself.

Daniel

Re: [PATCH] `completing-read`: Add `group-function` support to completion metadata (REVISED PATCH VERSION 2)

[Eli Zaretskii]

> From: Daniel Mendler <mail@daniel-mendler.de>
> Date: Tue, 11 May 2021 21:46:17 +0200
> Cc: gregory@heytings.org, dgutov@yandex.ru, emacs-devel@gnu.org,
>  monnier@iro.umontreal.ca, juri@linkov.net
> 
> On 5/11/21 9:22 PM, Eli Zaretskii wrote:
> > Why not provide a defcustom that can accept both simple value, for the
> > most popular sort methods, and also allow function values for advanced
> > users?
> 
> This is exactly what I did. If the user selects "No sorting" the value
> identity is taken and if the value "Sort alphabetically" is selected,
> the value completions-group-sort-alphabetically is taken. There is no
> point in introducing another symbolic indirection. We could add more
> options in case some more reasonable group sortings come up. There is no
> need for a newbie to directly manipulate functions.
> 
> > Thanks.  Now try putting yourself into the shoes of a newbie and try
> > imagining what can he/she make out of this doc string.  "Function
> > taking and returning an alist"? really?
> 
> The snippet which I just sent is a proposal. Up to now there has been a
> bit of back and forth of how the grouping feature is best implemented.
> Under these circumstances it does not make sense to send a fully
> polished patch each time. But by now the discussion seems to have
> somehow concluded, or at least I interpret that there is some agreement
> between the participants of the discussion which was mostly Juri,
> Stefan, Dmitry and myself.

Then please consider my humble request to make this user-friendlier by
offering simple Lisp values, not just functions.  You and me can grasp
'identity or 'ignore with no trouble, but I'm not talking about you or
me, or anyone else of the respected group mentioned above.  This
feature is not just for us.

Re: [PATCH] `completing-read`: Add `group-function` support to completion metadata (REVISED PATCH VERSION 6)

[Daniel Mendler]

[-- Attachment #1: Type: text/plain, Size: 1002 bytes --]

On 5/11/21 9:59 PM, Eli Zaretskii wrote:
>> The snippet which I just sent is a proposal. Up to now there has been a
>> bit of back and forth of how the grouping feature is best implemented.
>> Under these circumstances it does not make sense to send a fully
>> polished patch each time. But by now the discussion seems to have
>> somehow concluded, or at least I interpret that there is some agreement
>> between the participants of the discussion which was mostly Juri,
>> Stefan, Dmitry and myself.
> 
> Then please consider my humble request to make this user-friendlier by
> offering simple Lisp values, not just functions.  You and me can grasp
> 'identity or 'ignore with no trouble, but I'm not talking about you or
> me, or anyone else of the respected group mentioned above.  This
> feature is not just for us.

I attached the updated patches, the variable `completions-group-sort`
allows the more user friendly values nil and 'alphabetical. I hope it is
more acceptable in this form.

Daniel

[-- Attachment #2: 0001-completing-read-Add-group-function-to-completion-met.patch --]
[-- Type: text/x-diff, Size: 18517 bytes --]

From c9e4e53a5edd6eb00a562c554d402a5bc5e288a1 Mon Sep 17 00:00:00 2001
From: Daniel Mendler <mail@daniel-mendler.de>
Date: Sun, 25 Apr 2021 13:07:29 +0200
Subject: [PATCH 1/5] (completing-read): Add `group-function` to completion
 metadata

A completion table can specify a `group-function` in its metadata.
The group function takes two arguments, a completion candidate and a
transform argument. The group function is used to group the candidates
after sorting and to enhance the completion UI with group titles.

If the transform argument is nil, the function must return the title
of the group to which the completion candidate belongs. The function
may also return nil in case the candidate does not belong to a group.

Otherwise the function must return the transformed candidate. The
transformation allows for example to remove a part of the candidate,
which is then displayed in the title.

The grouping functionality guarded by the variable `completions-group`
and turned off by default for the *Completions* buffer.

The specific form of the `group-function` has been chosen in order to
allow allocation-free grouping. This is important for completion UIs,
which continously update the displayed set of candidates (Icomplete,
Vertico, Ivy, etc.). Only when the transform argument is non-nil the
candidate transformation is performed, which may involve a string
allocation as for example in `xref--completing-read-group`.

The function `xref-show-definitions-completing-read` makes use of the
`group-function`, by moving the file name prefix to the title. If
grouping is enabled, the *Completions* are displayed as
"linenum:summary" instead of "file:linenum:summary". This way the
*Completions* buffer resembles the *Occur* buffer.

* doc/lispref/minibuf.texi: Add documentation.

* lisp/minibuffer.el (completion-metadata): Describe `group-function`
in the docstring.
(completions-group): Add guard variable, by default off.
(completions-group-format): Add format string for group titles.
(completions-group-title): Add face for group titles.
(completions-group-separator): Add face for group separator.
(minibuffer--group-by): New grouping function.
(minibuffer-completion-help): Use it.
(display-completion-list): Add optional GROUP-FUN argument.
(completion--insert-strings): Add optional GROUP-FUN argument. Insert
group titles if `completions-format` is `one-column`. Transform each
candidate with the GROUP-FUN. Attach the untransformed candidate to
the property `completion--string`.

* lisp/simple.el (choose-completion): Retrieve the untransformed
completion candidate from the property `completion--string`.

* lisp/progmodes/xref.el:
(xref--completing-read-group): New grouping function.
(xref-show-definitions-completing-read): Use it.
---
 doc/lispref/minibuf.texi |  10 ++++
 lisp/minibuffer.el       | 123 ++++++++++++++++++++++++++++++++-------
 lisp/progmodes/xref.el   |  18 ++++--
 lisp/simple.el           |  11 ++--
 4 files changed, 131 insertions(+), 31 deletions(-)

diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi
index 145eee8f06..aa57c2bda0 100644
--- a/doc/lispref/minibuf.texi
+++ b/doc/lispref/minibuf.texi
@@ -1943,6 +1943,16 @@ Programmed Completion
 a suffix displayed after the completion string.  This function
 takes priority over @code{annotation-function}.
 
+@item group-function
+The value should be a function for grouping the completion candidates.
+The function must take two arguments, @var{completion}, which is a
+completion candidate and @var{transform}, which is a boolean flag.  If
+@var{transform} is @code{nil}, the function must return a group title,
+to which the candidate belongs. The returned title can also
+@code{nil}.  Otherwise the function must return the transformed
+candidate. The transformation can for example remove a redundant
+prefix, which is displayed in the group title instead.
+
 @item display-sort-function
 The value should be a function for sorting completions.  The function
 should take one argument, a list of completion strings, and return a
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index caf06ec710..e21a699dae 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -126,6 +126,13 @@ completion-metadata
    three-element lists: completion, its prefix and suffix.  This
    function takes priority over `annotation-function' when both are
    provided, so only this function is used.
+- `group-function': function for grouping the completion candidates.
+   Takes two arguments: a completion candidate (COMPLETION) and a
+   boolean flag (TRANSFORM).  If TRANSFORM is nil, the function
+   returns a group title, to which the candidate belongs.  The
+   returned title may be nil.  Otherwise the function returns the
+   transformed candidate.  The transformation can remove a redundant
+   prefix, which is displayed in the group title instead.
 - `display-sort-function': function to sort entries in *Completions*.
    Takes one argument (COMPLETIONS) and should return a new list
    of completions.  Can operate destructively.
@@ -1138,6 +1145,30 @@ completion-cycle-threshold
   :version "24.1"
   :type completion--cycling-threshold-type)
 
+(defcustom completions-group nil
+  "Enable grouping of completion candidates in the *Completions* buffer.
+See also `completions-group-format'."
+  :type 'boolean
+  :version "28.1")
+
+(defcustom completions-group-format
+  (concat
+   (propertize "    " 'face 'completions-group-separator)
+   (propertize " %s " 'face 'completions-group-title)
+   (propertize " " 'face 'completions-group-separator
+               'display '(space :align-to right)))
+  "Format string used for the group title."
+  :type 'string
+  :version "28.1")
+
+(defface completions-group-title '((t :inherit shadow :slant italic))
+  "Face used for the title text of the candidate group headlines."
+  :version "28.1")
+
+(defface completions-group-separator '((t :inherit shadow :strike-through t))
+  "Face used for the separator lines of the candidate groups."
+  :version "28.1")
+
 (defun completion--cycle-threshold (metadata)
   (let* ((cat (completion-metadata-get metadata 'category))
          (over (completion--category-override cat 'cycle)))
@@ -1401,6 +1432,17 @@ minibuffer--sort-preprocess-history
                      (substring c base-size)))
                  hist)))))
 
+(defun minibuffer--group-by (fun elems)
+  "Group ELEMS by FUN."
+  (let ((groups))
+    (dolist (cand elems)
+      (let* ((key (funcall fun cand nil))
+             (group (assoc key groups)))
+        (if group
+            (setcdr group (cons cand (cdr group)))
+          (push (list key cand) groups))))
+    (mapcan (lambda (x) (nreverse (cdr x))) (nreverse groups))))
+
 (defun completion-all-sorted-completions (&optional start end)
   (or completion-all-sorted-completions
       (let* ((start (or start (minibuffer-prompt-end)))
@@ -1747,11 +1789,17 @@ completions-detailed
   :type 'boolean
   :version "28.1")
 
-(defun completion--insert-strings (strings)
+;; TODO: Split up this function in one function per `completions-format'.
+;; TODO: Add group title support for horizontal and vertical format.
+(defun completion--insert-strings (strings &optional group-fun)
   "Insert a list of STRINGS into the current buffer.
-Uses columns to keep the listing readable but compact.
-It also eliminates runs of equal strings."
+Uses columns to keep the listing readable but compact.  It also
+eliminates runs of equal strings.  GROUP-FUN is a `group-function'
+used for grouping the completion."
   (when (consp strings)
+    ;; FIXME: Currently grouping is enabled only for the 'one-column format.
+    (unless (eq completions-format 'one-column)
+      (setq group-fun nil))
     (let* ((length (apply #'max
 			  (mapcar (lambda (s)
 				    (if (consp s)
@@ -1768,6 +1816,7 @@ completion--insert-strings
 		     (max 1 (/ (length strings) 2))))
 	   (colwidth (/ wwidth columns))
            (column 0)
+           (last-title nil)
 	   (rows (/ (length strings) columns))
 	   (row 0)
            (first t)
@@ -1780,6 +1829,13 @@ completion--insert-strings
       ;; The insertion should be "sensible" no matter what choices were made
       ;; for the parameters above.
       (dolist (str strings)
+        ;; Add group titles.
+        (when group-fun
+          (let ((title (funcall group-fun (if (consp str) (car str) str) nil)))
+            (unless (equal title last-title)
+              (when title
+                (insert (format completions-group-format title) "\n"))
+              (setq last-title title))))
 	(unless (equal laststring str) ; Remove (consecutive) duplicates.
 	  (setq laststring str)
           ;; FIXME: `string-width' doesn't pay attention to
@@ -1825,8 +1881,15 @@ completion--insert-strings
 		  nil))))
             (setq first nil)
             (if (not (consp str))
-                (put-text-property (point) (progn (insert str) (point))
-                                   'mouse-face 'highlight)
+                (add-text-properties
+                 (point)
+                 (progn
+                   (insert
+                    (if group-fun
+                        (funcall group-fun str 'transform)
+                      str))
+                   (point))
+                 `(mouse-face highlight completion--string ,str))
               ;; If `str' is a list that has 2 elements,
               ;; then the second element is a suffix annotation.
               ;; If `str' has 3 elements, then the second element
@@ -1837,8 +1900,15 @@ completion--insert-strings
                   (let ((beg (point))
                         (end (progn (insert prefix) (point))))
                     (put-text-property beg end 'mouse-face nil)))
-                (put-text-property (point) (progn (insert (car str)) (point))
-                                   'mouse-face 'highlight)
+                (add-text-properties
+                 (point)
+                 (progn
+                   (insert
+                    (if group-fun
+                         (funcall group-fun (car str) 'transform)
+                      (car str)))
+                   (point))
+                 `(mouse-face highlight completion--string ,(car str)))
                 (let ((beg (point))
                       (end (progn (insert suffix) (point))))
                   (put-text-property beg end 'mouse-face nil)
@@ -1923,7 +1993,7 @@ completion-hilit-commonality
         completions)
        base-size))))
 
-(defun display-completion-list (completions &optional common-substring)
+(defun display-completion-list (completions &optional common-substring group-fun)
   "Display the list of completions, COMPLETIONS, using `standard-output'.
 Each element may be just a symbol or string
 or may be a list of two strings to be printed as if concatenated.
@@ -1933,7 +2003,8 @@ display-completion-list
 The actual completion alternatives, as inserted, are given `mouse-face'
 properties of `highlight'.
 At the end, this runs the normal hook `completion-setup-hook'.
-It can find the completion buffer in `standard-output'."
+It can find the completion buffer in `standard-output'.
+GROUP-FUN is a `group-function' used for grouping the completion."
   (declare (advertised-calling-convention (completions) "24.4"))
   (if common-substring
       (setq completions (completion-hilit-commonality
@@ -1946,7 +2017,7 @@ display-completion-list
 	(let ((standard-output (current-buffer))
 	      (completion-setup-hook nil))
           (with-suppressed-warnings ((callargs display-completion-list))
-	    (display-completion-list completions common-substring)))
+	    (display-completion-list completions common-substring group-fun)))
 	(princ (buffer-string)))
 
     (with-current-buffer standard-output
@@ -1954,7 +2025,7 @@ display-completion-list
       (if (null completions)
           (insert "There are no possible completions of what you have typed.")
         (insert "Possible completions are:\n")
-        (completion--insert-strings completions))))
+        (completion--insert-strings completions group-fun))))
 
   (run-hooks 'completion-setup-hook)
   nil)
@@ -2067,6 +2138,9 @@ minibuffer-completion-help
              (aff-fun (or (completion-metadata-get all-md 'affixation-function)
                           (plist-get completion-extra-properties
                                      :affixation-function)))
+             (sort-fun (completion-metadata-get all-md 'display-sort-function))
+             (group-fun (and completions-group
+                             (completion-metadata-get all-md 'group-function)))
              (mainbuf (current-buffer))
              ;; If the *Completions* buffer is shown in a new
              ;; window, mark it as softly-dedicated, so bury-buffer in
@@ -2098,15 +2172,22 @@ minibuffer-completion-help
                       ;; Remove the base-size tail because `sort' requires a properly
                       ;; nil-terminated list.
                       (when last (setcdr last nil))
-                      (setq completions
-                            ;; FIXME: This function is for the output of all-completions,
-                            ;; not completion-all-completions.  Often it's the same, but
-                            ;; not always.
-                            (let ((sort-fun (completion-metadata-get
-                                             all-md 'display-sort-function)))
-                              (if sort-fun
-                                  (funcall sort-fun completions)
-                                (sort completions 'string-lessp))))
+
+                      ;; Sort first using the `display-sort-function'.
+                      ;; FIXME: This function is for the output of
+                      ;; all-completions, not
+                      ;; completion-all-completions.  Often it's the
+                      ;; same, but not always.
+                      (setq completions (if sort-fun
+                                            (funcall sort-fun completions)
+                                          (sort completions 'string-lessp)))
+
+                      ;; After sorting, group the candidates using the
+                      ;; `group-function'.
+                      (when group-fun
+                        (setq completions
+                              (minibuffer--group-by group-fun completions)))
+
                       (cond
                        (aff-fun
                         (setq completions
@@ -2152,7 +2233,7 @@ minibuffer-completion-help
                                                      (if (eq (car bounds) (length result))
                                                          'exact 'finished)))))))
 
-                      (display-completion-list completions)))))
+                      (display-completion-list completions nil group-fun)))))
           nil)))
     nil))
 
diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el
index 7fc7181acc..2a4fb2c417 100644
--- a/lisp/progmodes/xref.el
+++ b/lisp/progmodes/xref.el
@@ -1044,6 +1044,12 @@ xref-show-definitions-buffer-at-bottom
 (define-obsolete-function-alias 'xref--show-defs-buffer-at-bottom
   #'xref-show-definitions-buffer-at-bottom "28.1")
 
+(defun xref--completing-read-group (cand transform)
+  "Return group title of candidate CAND or TRANSFORM the candidate."
+  (if transform
+      (substring cand (1+ (next-single-property-change 0 'xref--group cand)))
+    (get-text-property 0 'xref--group cand)))
+
 (defun xref-show-definitions-completing-read (fetcher alist)
   "Let the user choose the target definition with completion.
 
@@ -1072,10 +1078,12 @@ xref-show-definitions-completing-read
                                     (format #("%d:" 0 2 (face xref-line-number))
                                             line)
                                   ""))
+                               (group-prefix
+                                (substring group group-prefix-length))
                                (group-fmt
-                                (propertize
-                                 (substring group group-prefix-length)
-                                 'face 'xref-file-header))
+                                (propertize group-prefix
+                                            'face 'xref-file-header
+                                            'xref--group group-prefix))
                                (candidate
                                 (format "%s:%s%s" group-fmt line-fmt summary)))
                           (push (cons candidate xref) xref-alist-with-line-info)))))
@@ -1087,7 +1095,9 @@ xref-show-definitions-completing-read
                          (lambda (string pred action)
                            (cond
                             ((eq action 'metadata)
-                             '(metadata . ((category . xref-location))))
+                             `(metadata
+                               . ((category . xref-location)
+                                  (group-function . ,#'xref--completing-read-group))))
                             (t
                              (complete-with-action action collection string pred)))))
                         (def (caar collection)))
diff --git a/lisp/simple.el b/lisp/simple.el
index b4e34f1e4c..fe7ff0333f 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -8876,18 +8876,17 @@ choose-completion
           (choice
            (save-excursion
              (goto-char (posn-point (event-start event)))
-             (let (beg end)
+             (let (beg)
                (cond
                 ((and (not (eobp)) (get-text-property (point) 'mouse-face))
-                 (setq end (point) beg (1+ (point))))
+                 (setq beg (1+ (point))))
                 ((and (not (bobp))
                       (get-text-property (1- (point)) 'mouse-face))
-                 (setq end (1- (point)) beg (point)))
+                 (setq beg (point)))
                 (t (error "No completion here")))
                (setq beg (previous-single-property-change beg 'mouse-face))
-               (setq end (or (next-single-property-change end 'mouse-face)
-                             (point-max)))
-               (buffer-substring-no-properties beg end)))))
+               (substring-no-properties
+                (get-text-property beg 'completion--string))))))
 
       (unless (buffer-live-p buffer)
         (error "Destination buffer is dead"))
-- 
2.20.1


[-- Attachment #3: 0002-completion-insert-strings-Split-function-Full-group-.patch --]
[-- Type: text/x-diff, Size: 13458 bytes --]

From 6a95ba7952b8f265453f987e0cdf1eaa026b2694 Mon Sep 17 00:00:00 2001
From: Daniel Mendler <mail@daniel-mendler.de>
Date: Fri, 30 Apr 2021 08:40:59 +0200
Subject: [PATCH 2/5] (completion--insert-strings): Split function; Full group
 title support

Split `completion--insert-strings` into a function per completions
format in order to increase readability and extensibility. This change
eases the addition of more formats. Add support for group titles to
the vertical and horizontal format.

* minibuffer.el (completion--insert): Add new function.
(completion--insert-vertical, completion--insert-horizontal,
completion--insert-one-column): Extract new function from
`completion--insert-strings`. Use `completion--insert`.
(completion--insert-strings): Use new insertion functions.
---
 lisp/minibuffer.el | 269 ++++++++++++++++++++++++++-------------------
 1 file changed, 154 insertions(+), 115 deletions(-)

diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index e21a699dae..cf1a4350bd 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -1789,21 +1789,16 @@ completions-detailed
   :type 'boolean
   :version "28.1")
 
-;; TODO: Split up this function in one function per `completions-format'.
-;; TODO: Add group title support for horizontal and vertical format.
 (defun completion--insert-strings (strings &optional group-fun)
   "Insert a list of STRINGS into the current buffer.
 Uses columns to keep the listing readable but compact.  It also
 eliminates runs of equal strings.  GROUP-FUN is a `group-function'
 used for grouping the completion."
   (when (consp strings)
-    ;; FIXME: Currently grouping is enabled only for the 'one-column format.
-    (unless (eq completions-format 'one-column)
-      (setq group-fun nil))
     (let* ((length (apply #'max
 			  (mapcar (lambda (s)
 				    (if (consp s)
-					(apply #'+ (mapcar #'string-width s))
+				        (apply #'+ (mapcar #'string-width s))
 				      (string-width s)))
 				  strings)))
 	   (window (get-buffer-window (current-buffer) 0))
@@ -1814,126 +1809,170 @@ completion--insert-strings
 		     ;; Don't allocate more columns than we can fill.
 		     ;; Windows can't show less than 3 lines anyway.
 		     (max 1 (/ (length strings) 2))))
-	   (colwidth (/ wwidth columns))
-           (column 0)
-           (last-title nil)
-	   (rows (/ (length strings) columns))
-	   (row 0)
-           (first t)
-	   (laststring nil))
+	   (colwidth (/ wwidth columns)))
       (unless (or tab-stop-list (null completion-tab-width)
                   (zerop (mod colwidth completion-tab-width)))
         ;; Align to tab positions for the case
         ;; when the caller uses tabs inside prefix.
         (setq colwidth (- colwidth (mod colwidth completion-tab-width))))
-      ;; The insertion should be "sensible" no matter what choices were made
-      ;; for the parameters above.
-      (dolist (str strings)
-        ;; Add group titles.
+      (funcall (intern (format "completion--insert-%s" completions-format))
+               strings group-fun length wwidth colwidth columns))))
+
+(defun completion--insert-horizontal (strings group-fun
+                                              length wwidth
+                                              colwidth _columns)
+  (let ((column 0)
+        (first t)
+	(last-title nil)
+        (last-string nil))
+    (dolist (str strings)
+      (unless (equal last-string str) ; Remove (consecutive) duplicates.
+	(setq last-string str)
         (when group-fun
           (let ((title (funcall group-fun (if (consp str) (car str) str) nil)))
             (unless (equal title last-title)
+              (setq last-title title)
               (when title
-                (insert (format completions-group-format title) "\n"))
-              (setq last-title title))))
-	(unless (equal laststring str) ; Remove (consecutive) duplicates.
-	  (setq laststring str)
+                (insert (if first "" "\n") (format completions-group-format title) "\n")
+                (setq column 0
+                      first t)))))
+	(unless first
           ;; FIXME: `string-width' doesn't pay attention to
           ;; `display' properties.
-          (let ((length (if (consp str)
-                            (apply #'+ (mapcar #'string-width str))
-                          (string-width str))))
-            (cond
-             ((eq completions-format 'one-column)
-              ;; Nothing special
-              )
-	     ((eq completions-format 'vertical)
-	      ;; Vertical format
-	      (when (> row rows)
-		(forward-line (- -1 rows))
-		(setq row 0 column (+ column colwidth)))
-	      (when (> column 0)
-		(end-of-line)
-		(while (> (current-column) column)
-		  (if (eobp)
-		      (insert "\n")
-		    (forward-line 1)
-		    (end-of-line)))
-		(insert " \t")
-		(set-text-properties (1- (point)) (point)
-				     `(display (space :align-to ,column)))))
-	     (t
-	      ;; Horizontal format
-	      (unless first
-		(if (< wwidth (+ (max colwidth length) column))
-		    ;; No space for `str' at point, move to next line.
-		    (progn (insert "\n") (setq column 0))
-		  (insert " \t")
-		  ;; Leave the space unpropertized so that in the case we're
-		  ;; already past the goal column, there is still
-		  ;; a space displayed.
-		  (set-text-properties (1- (point)) (point)
-				       ;; We can set tab-width using
-				       ;; completion-tab-width, but
-				       ;; the caller can prefer using
-				       ;; \t to align prefixes.
-				       `(display (space :align-to ,column)))
-		  nil))))
-            (setq first nil)
-            (if (not (consp str))
-                (add-text-properties
-                 (point)
-                 (progn
-                   (insert
-                    (if group-fun
-                        (funcall group-fun str 'transform)
-                      str))
-                   (point))
-                 `(mouse-face highlight completion--string ,str))
-              ;; If `str' is a list that has 2 elements,
-              ;; then the second element is a suffix annotation.
-              ;; If `str' has 3 elements, then the second element
-              ;; is a prefix, and the third element is a suffix.
-              (let* ((prefix (when (nth 2 str) (nth 1 str)))
-                     (suffix (or (nth 2 str) (nth 1 str))))
-                (when prefix
-                  (let ((beg (point))
-                        (end (progn (insert prefix) (point))))
-                    (put-text-property beg end 'mouse-face nil)))
-                (add-text-properties
-                 (point)
-                 (progn
-                   (insert
-                    (if group-fun
-                         (funcall group-fun (car str) 'transform)
-                      (car str)))
-                   (point))
-                 `(mouse-face highlight completion--string ,(car str)))
-                (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 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
-             ((eq completions-format 'one-column)
-              (insert "\n"))
-	     ((eq completions-format 'vertical)
-	      ;; Vertical format
-	      (if (> column 0)
-		  (forward-line)
-		(insert "\n"))
-	      (setq row (1+ row)))
-	     (t
-	      ;; Horizontal format
-	      ;; Next column to align to.
-	      (setq column (+ column
-			      ;; Round up to a whole number of columns.
-			      (* colwidth (ceiling length colwidth))))))))))))
+	  (if (< wwidth (+ column (max colwidth
+                                       (if (consp str)
+                                           (apply #'+ (mapcar #'string-width str))
+                                         (string-width str)))))
+	      ;; No space for `str' at point, move to next line.
+	      (progn (insert "\n") (setq column 0))
+	    (insert " \t")
+	    ;; Leave the space unpropertized so that in the case we're
+	    ;; already past the goal column, there is still
+	    ;; a space displayed.
+	    (set-text-properties (1- (point)) (point)
+				 ;; We can set tab-width using
+				 ;; completion-tab-width, but
+				 ;; the caller can prefer using
+				 ;; \t to align prefixes.
+				 `(display (space :align-to ,column)))
+	    nil))
+        (setq first nil)
+        (completion--insert str group-fun)
+	;; Next column to align to.
+	(setq column (+ column
+			;; Round up to a whole number of columns.
+			(* colwidth (ceiling length colwidth))))))))
+
+(defun completion--insert-vertical (strings group-fun
+                                            _length _wwidth
+                                            colwidth columns)
+  (let ((column 0)
+        (rows (/ (length strings) columns))
+	(row 0)
+	(last-title nil)
+	(last-string nil)
+        (start-point (point))
+        (next 0) (pos 0))
+    (dolist (str strings)
+      (unless (equal last-string str) ; Remove (consecutive) duplicates.
+	(setq last-string str)
+	(when (> row rows)
+	  (goto-char start-point)
+	  (setq row 0 column (+ column colwidth)))
+        (when group-fun
+          (let ((title (funcall group-fun (if (consp str) (car str) str) nil)))
+            (unless (equal title last-title)
+              (setq last-title title)
+              (when title
+                ;; Align before title insertion
+	        (when (> column 0)
+	          (end-of-line)
+	          (while (> (current-column) column)
+	            (if (eobp)
+		        (insert "\n")
+	              (forward-line 1)
+	              (end-of-line)))
+	          (insert " \t")
+	          (set-text-properties (1- (point)) (point)
+			               `(display (space :align-to ,column))))
+                (let* ((fmt completions-group-format)
+                       (len (length fmt)))
+                  ;; Adjust display space for columns
+                  (when (equal (get-text-property (- len 1) 'display fmt) '(space :align-to right))
+                    (setq fmt (substring fmt))
+                    (put-text-property (- len 1) len
+                                       'display
+                                       `(space :align-to ,(+ colwidth column -1))
+                                       fmt))
+                  (insert (format fmt title)))
+                ;; Align after title insertion
+	        (if (> column 0)
+	            (forward-line)
+	          (insert "\n"))))))
+        ;; Align before candidate insertion
+	(when (> column 0)
+	  (end-of-line)
+	  (while (> (current-column) column)
+	    (if (eobp)
+		(insert "\n")
+	      (forward-line 1)
+	      (end-of-line)))
+	  (insert " \t")
+	  (set-text-properties (1- (point)) (point)
+			       `(display (space :align-to ,column))))
+        (completion--insert str group-fun)
+        ;; Align after candidate insertion
+	(if (> column 0)
+	    (forward-line)
+	  (insert "\n"))
+	(setq row (1+ row))))))
+
+(defun completion--insert-one-column (strings group-fun &rest _)
+  (let ((last-title nil) (last-string nil))
+    (dolist (str strings)
+      (unless (equal last-string str) ; Remove (consecutive) duplicates.
+	(setq last-string str)
+        (when group-fun
+          (let ((title (funcall group-fun (if (consp str) (car str) str) nil)))
+            (unless (equal title last-title)
+              (setq last-title title)
+              (when title
+                (insert (format completions-group-format title) "\n")))))
+        (completion--insert str group-fun)
+        (insert "\n")))))
+
+(defun completion--insert (str group-fun)
+  (if (not (consp str))
+      (add-text-properties
+       (point)
+       (progn
+         (insert
+          (if group-fun
+              (funcall group-fun str 'transform)
+            str))
+         (point))
+       `(mouse-face highlight completion--string ,str))
+    ;; If `str' is a list that has 2 elements,
+    ;; then the second element is a suffix annotation.
+    ;; If `str' has 3 elements, then the second element
+    ;; is a prefix, and the third element is a suffix.
+    (let* ((prefix (when (nth 2 str) (nth 1 str)))
+           (suffix (or (nth 2 str) (nth 1 str))))
+      (when prefix
+        (let ((beg (point))
+              (end (progn (insert prefix) (point))))
+          (put-text-property beg end 'mouse-face nil)))
+      (completion--insert (car str) group-fun)
+      (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 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))))))
 
 (defvar completion-setup-hook nil
   "Normal hook run at the end of setting up a completion list buffer.
-- 
2.20.1


[-- Attachment #4: 0003-minibuffer-completion-help-Do-not-check-completions-.patch --]
[-- Type: text/x-diff, Size: 1378 bytes --]

From 75f98611ca5aee1706762bbe5dbd9c347ea19d7d Mon Sep 17 00:00:00 2001
From: Daniel Mendler <mail@daniel-mendler.de>
Date: Sun, 2 May 2021 15:50:08 +0200
Subject: [PATCH 3/5] (minibuffer-completion-help): Do not check
 `completions-group` centrally

The guard variable `completions-group` should be checked in each
completion table individually. The guard variable
`completions-detailed` variable is used in the same way.

* minibuffer.el (minibuffer-completion-help): Remove check of
  `completions-group`.
---
 lisp/minibuffer.el | 3 +--
 1 file changed, 1 insertion(+), 2 deletions(-)

diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index cf1a4350bd..b743b2bd40 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -2178,8 +2178,7 @@ minibuffer-completion-help
                           (plist-get completion-extra-properties
                                      :affixation-function)))
              (sort-fun (completion-metadata-get all-md 'display-sort-function))
-             (group-fun (and completions-group
-                             (completion-metadata-get all-md 'group-function)))
+             (group-fun (completion-metadata-get all-md 'group-function))
              (mainbuf (current-buffer))
              ;; If the *Completions* buffer is shown in a new
              ;; window, mark it as softly-dedicated, so bury-buffer in
-- 
2.20.1


[-- Attachment #5: 0004-completion-insert-vertical-Separate-groups-completel.patch --]
[-- Type: text/x-diff, Size: 5061 bytes --]

From 7768f1142f5af9d58229884c8365dd921c2d65c9 Mon Sep 17 00:00:00 2001
From: Daniel Mendler <mail@daniel-mendler.de>
Date: Sun, 2 May 2021 16:19:42 +0200
Subject: [PATCH 4/5] (completion--insert-vertical): Separate groups completely

Insert the candidates vertically within the groups, but keep the
groups completely separate using the full width group separators.

* minibuffer.el (completion--insert-vertical): Adjust grouping.
---
 lisp/minibuffer.el | 108 ++++++++++++++++++++-------------------------
 1 file changed, 48 insertions(+), 60 deletions(-)

diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index b743b2bd40..73a38a8137 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -1866,66 +1866,54 @@ completion--insert-horizontal
 (defun completion--insert-vertical (strings group-fun
                                             _length _wwidth
                                             colwidth columns)
-  (let ((column 0)
-        (rows (/ (length strings) columns))
-	(row 0)
-	(last-title nil)
-	(last-string nil)
-        (start-point (point))
-        (next 0) (pos 0))
-    (dolist (str strings)
-      (unless (equal last-string str) ; Remove (consecutive) duplicates.
-	(setq last-string str)
-	(when (> row rows)
-	  (goto-char start-point)
-	  (setq row 0 column (+ column colwidth)))
-        (when group-fun
-          (let ((title (funcall group-fun (if (consp str) (car str) str) nil)))
-            (unless (equal title last-title)
-              (setq last-title title)
-              (when title
-                ;; Align before title insertion
-	        (when (> column 0)
-	          (end-of-line)
-	          (while (> (current-column) column)
-	            (if (eobp)
-		        (insert "\n")
-	              (forward-line 1)
-	              (end-of-line)))
-	          (insert " \t")
-	          (set-text-properties (1- (point)) (point)
-			               `(display (space :align-to ,column))))
-                (let* ((fmt completions-group-format)
-                       (len (length fmt)))
-                  ;; Adjust display space for columns
-                  (when (equal (get-text-property (- len 1) 'display fmt) '(space :align-to right))
-                    (setq fmt (substring fmt))
-                    (put-text-property (- len 1) len
-                                       'display
-                                       `(space :align-to ,(+ colwidth column -1))
-                                       fmt))
-                  (insert (format fmt title)))
-                ;; Align after title insertion
-	        (if (> column 0)
-	            (forward-line)
-	          (insert "\n"))))))
-        ;; Align before candidate insertion
-	(when (> column 0)
-	  (end-of-line)
-	  (while (> (current-column) column)
-	    (if (eobp)
-		(insert "\n")
-	      (forward-line 1)
-	      (end-of-line)))
-	  (insert " \t")
-	  (set-text-properties (1- (point)) (point)
-			       `(display (space :align-to ,column))))
-        (completion--insert str group-fun)
-        ;; Align after candidate insertion
-	(if (> column 0)
-	    (forward-line)
-	  (insert "\n"))
-	(setq row (1+ row))))))
+  (while strings
+    (let ((group nil)
+          (column 0)
+	  (row 0)
+          (rows)
+          (last-string nil))
+      (if group-fun
+          (let* ((str (car strings))
+                 (title (funcall group-fun (if (consp str) (car str) str) nil)))
+            (while (and strings
+                        (equal title (funcall group-fun
+                                              (if (consp (car strings))
+                                                  (car (car strings))
+                                                (car strings))
+                                              nil)))
+              (push (car strings) group)
+              (pop strings))
+            (setq group (nreverse group)))
+        (setq group strings
+              strings nil))
+      (setq rows (/ (length group) columns))
+      (when group-fun
+        (let* ((str (car group))
+               (title (funcall group-fun (if (consp str) (car str) str) nil)))
+          (when title
+            (goto-char (point-max))
+            (insert (format completions-group-format title) "\n"))))
+      (dolist (str group)
+        (unless (equal last-string str) ; Remove (consecutive) duplicates.
+	  (setq last-string str)
+	  (when (> row rows)
+            (forward-line (- -1 rows))
+	    (setq row 0 column (+ column colwidth)))
+	  (when (> column 0)
+	    (end-of-line)
+	    (while (> (current-column) column)
+	      (if (eobp)
+		  (insert "\n")
+	        (forward-line 1)
+	        (end-of-line)))
+	    (insert " \t")
+	    (set-text-properties (1- (point)) (point)
+			         `(display (space :align-to ,column))))
+          (completion--insert str group-fun)
+	  (if (> column 0)
+	      (forward-line)
+	    (insert "\n"))
+	  (setq row (1+ row)))))))
 
 (defun completion--insert-one-column (strings group-fun &rest _)
   (let ((last-title nil) (last-string nil))
-- 
2.20.1


[-- Attachment #6: 0005-minibuffer-completion-help-Add-group-sorting.patch --]
[-- Type: text/x-diff, Size: 3633 bytes --]

From 5fc173f155e1fb9caae2675d0d4f9667a5d99a45 Mon Sep 17 00:00:00 2001
From: Daniel Mendler <mail@daniel-mendler.de>
Date: Tue, 11 May 2021 09:08:05 +0200
Subject: [PATCH 5/5] (minibuffer-completion-help): Add group sorting

Sorting the groups as returned by the `group-function` of the
completion table depending on the value of `completions-group-sort`.
By default `completions-group-sort` is set to nil, the value
`alphabetical` is offered for alphabetical sorting. Furthermore custom
sorting functions can be used.

* lisp/minibuffer.el (completions-group-sort): New variable.
(minibuffer--group-by): Add SORT-FUN argument.
(minibuffer-completion-help): Pass `completions-group-sort`
to `minibuffer--group-by`.
---
 lisp/minibuffer.el | 37 ++++++++++++++++++++++++++++++++-----
 1 file changed, 32 insertions(+), 5 deletions(-)

diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 73a38a8137..fd94718497 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -1151,6 +1151,18 @@ completions-group
   :type 'boolean
   :version "28.1")
 
+(defcustom completions-group-sort nil
+  "Sort groups in the *Completions* buffer.
+
+The value can either be nil to disable sorting, `alphabetical' for
+alphabetical sorting or a custom sorting function. The sorting
+function takes and returns an alist of groups, where each element is a
+pair of a group title string and a list of group candidate strings."
+  :type '(choice (const nil :tag "No sorting")
+                 (const alphabetical :tag "Alphabetical sorting")
+                 function)
+  :version "28.1")
+
 (defcustom completions-group-format
   (concat
    (propertize "    " 'face 'completions-group-separator)
@@ -1432,16 +1444,21 @@ minibuffer--sort-preprocess-history
                      (substring c base-size)))
                  hist)))))
 
-(defun minibuffer--group-by (fun elems)
-  "Group ELEMS by FUN."
+(defun minibuffer--group-by (group-fun sort-fun elems)
+  "Group ELEMS by GROUP-FUN and sort using SORT-FUN."
   (let ((groups))
     (dolist (cand elems)
-      (let* ((key (funcall fun cand nil))
+      (let* ((key (funcall group-fun cand nil))
              (group (assoc key groups)))
         (if group
             (setcdr group (cons cand (cdr group)))
           (push (list key cand) groups))))
-    (mapcan (lambda (x) (nreverse (cdr x))) (nreverse groups))))
+    (setq groups (nreverse groups)
+          groups (mapc (lambda (x)
+                         (setcdr x (nreverse (cdr x))))
+                       groups)
+          groups (funcall sort-fun groups))
+    (mapcan #'cdr groups)))
 
 (defun completion-all-sorted-completions (&optional start end)
   (or completion-all-sorted-completions
@@ -2212,7 +2229,17 @@ minibuffer-completion-help
                       ;; `group-function'.
                       (when group-fun
                         (setq completions
-                              (minibuffer--group-by group-fun completions)))
+                              (minibuffer--group-by
+                               group-fun
+                               (pcase completions-group-sort
+                                 ('nil #'identity)
+                                 ('alphabetical
+                                  (lambda (groups)
+                                    (sort groups
+                                          (lambda (x y)
+                                            (string< (car x) (car y))))))
+                                 (_ completions-group-sort))
+                               completions)))
 
                       (cond
                        (aff-fun
-- 
2.20.1

Re: [PATCH] `completing-read`: Add `group-function` support to completion metadata (REVISED PATCH VERSION 6)

[Eli Zaretskii]

> Cc: gregory@heytings.org, dgutov@yandex.ru, emacs-devel@gnu.org,
>  monnier@iro.umontreal.ca, juri@linkov.net
> From: Daniel Mendler <mail@daniel-mendler.de>
> Date: Tue, 11 May 2021 22:30:44 +0200
> 
> > Then please consider my humble request to make this user-friendlier by
> > offering simple Lisp values, not just functions.  You and me can grasp
> > 'identity or 'ignore with no trouble, but I'm not talking about you or
> > me, or anyone else of the respected group mentioned above.  This
> > feature is not just for us.
> 
> I attached the updated patches, the variable `completions-group-sort`
> allows the more user friendly values nil and 'alphabetical. I hope it is
> more acceptable in this form.

Thanks, this addresses my concerns.

(Please proofread the comments, doc strings, and Texinfo changes in
the patches to make sure you leave 2 spaces between sentences, per our
conventions to use US English.)

Re: [PATCH] `completing-read`: Add `group-function` support to completion metadata (REVISED PATCH VERSION 7)

[Daniel Mendler]

[-- Attachment #1: Type: text/plain, Size: 599 bytes --]

On 5/13/21 12:32 PM, Eli Zaretskii wrote:
>> I attached the updated patches, the variable `completions-group-sort`
>> allows the more user friendly values nil and 'alphabetical. I hope it is
>> more acceptable in this form.
> 
> Thanks, this addresses my concerns.
> 
> (Please proofread the comments, doc strings, and Texinfo changes in
> the patches to make sure you leave 2 spaces between sentences, per our
> conventions to use US English.)

Thank you, Eli. I went over the commit messages, comments, Texinfo and
doc strings and made a few corrections. The revised patches are attached.

Daniel

[-- Attachment #2: 0001-completing-read-Add-group-function-to-the-completion.patch --]
[-- Type: text/x-diff, Size: 18741 bytes --]

From 0fc290d79e9dbb763517d61eb3e16c3cd2a108d7 Mon Sep 17 00:00:00 2001
From: Daniel Mendler <mail@daniel-mendler.de>
Date: Sun, 25 Apr 2021 13:07:29 +0200
Subject: [PATCH 1/5] (completing-read): Add `group-function` to the completion
 metadata

A completion table can specify a `group-function` in its metadata.
The group function takes two arguments, a completion candidate and a
transform argument.  The group function is used to group the
candidates after sorting and to enhance the completion UI with group
titles.

If the transform argument is nil, the function must return the title
of the group to which the completion candidate belongs.  The function
may also return nil if the candidate does not belong to a group.

if the transform argument is non-nil, the function must return the
transformed candidate.  For example, the transformation allows to
remove a redundant part of the candidate, which is then displayed in
the title.

The grouping functionality is guarded by the customizable variable
`completions-group` and turned off by default for the *Completions*
buffer.

The specific form of the `group-function` has been chosen in order to
allow allocation-free grouping.  This is important for completion UIs,
which continously update the displayed set of candidates (Icomplete,
Vertico, Ivy, etc.).  Only when the transform argument is non-nil the
candidate transformation is performed, which may involve a string
allocation as done in the function `xref--completing-read-group`.

The function `xref-show-definitions-completing-read` makes use of the
`group-function`, by moving the file name prefix to the title.  If
grouping is enabled, the *Completions* are displayed as
"linenum:summary" instead of "file:linenum:summary".  This way the
*Completions* buffer resembles the *Occur* buffer.

* doc/lispref/minibuf.texi: Add documentation.

* lisp/minibuffer.el (completion-metadata): Describe the
`group-function` in the docstring.
(completions-group): Add guard variable, off by default.
(completions-group-format): Add variable defining the format string
for the group titles.
(completions-group-title): Add face used by `completions-group-format`
for the group titles.
(completions-group-separator): Add face used by
`completions-group-format` for the group separator lines.
(minibuffer--group-by): New grouping function.
(minibuffer-completion-help): Use it.
(display-completion-list): Add optional GROUP-FUN argument.
(completion--insert-strings): Add optional GROUP-FUN argument.  Insert
group titles if `completions-format` is `one-column`.  Transform each
candidate with the GROUP-FUN.  Attach the untransformed candidate to
the property `completion--string`.

* lisp/simple.el (choose-completion): Retrieve the untransformed
completion candidate from the property `completion--string`.

* lisp/progmodes/xref.el:
(xref--completing-read-group): New grouping function.
(xref-show-definitions-completing-read): Use it.
---
 doc/lispref/minibuf.texi |  10 ++++
 lisp/minibuffer.el       | 126 ++++++++++++++++++++++++++++++++-------
 lisp/progmodes/xref.el   |  18 ++++--
 lisp/simple.el           |  11 ++--
 4 files changed, 134 insertions(+), 31 deletions(-)

diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi
index 145eee8f06..196dd99076 100644
--- a/doc/lispref/minibuf.texi
+++ b/doc/lispref/minibuf.texi
@@ -1943,6 +1943,16 @@ Programmed Completion
 a suffix displayed after the completion string.  This function
 takes priority over @code{annotation-function}.
 
+@item group-function
+The value should be a function for grouping the completion candidates.
+The function must take two arguments, @var{completion}, which is a
+completion candidate and @var{transform}, which is a boolean flag.  If
+@var{transform} is @code{nil}, the function must return the group
+title of the group to which the candidate belongs.  The returned title
+can also be @code{nil}.  Otherwise the function must return the
+transformed candidate.  The transformation can for example remove a
+redundant prefix, which is displayed in the group title.
+
 @item display-sort-function
 The value should be a function for sorting completions.  The function
 should take one argument, a list of completion strings, and return a
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index caf06ec710..b5245e239e 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -126,6 +126,13 @@ completion-metadata
    three-element lists: completion, its prefix and suffix.  This
    function takes priority over `annotation-function' when both are
    provided, so only this function is used.
+- `group-function': function for grouping the completion candidates.
+   Takes two arguments: a completion candidate (COMPLETION) and a
+   boolean flag (TRANSFORM).  If TRANSFORM is nil, the function
+   returns the group title of the group to which the candidate
+   belongs.  The returned title may be nil.  Otherwise the function
+   returns the transformed candidate.  The transformation can remove a
+   redundant prefix, which is displayed in the group title.
 - `display-sort-function': function to sort entries in *Completions*.
    Takes one argument (COMPLETIONS) and should return a new list
    of completions.  Can operate destructively.
@@ -1138,6 +1145,32 @@ completion-cycle-threshold
   :version "24.1"
   :type completion--cycling-threshold-type)
 
+(defcustom completions-group nil
+  "Enable grouping of completion candidates in the *Completions* buffer.
+See also `completions-group-format'."
+  :type 'boolean
+  :version "28.1")
+
+(defcustom completions-group-format
+  (concat
+   (propertize "    " 'face 'completions-group-separator)
+   (propertize " %s " 'face 'completions-group-title)
+   (propertize " " 'face 'completions-group-separator
+               'display '(space :align-to right)))
+  "Format string used for the group title."
+  :type 'string
+  :version "28.1")
+
+(defface completions-group-title
+  '((t :inherit shadow :slant italic))
+  "Face used for the title text of the candidate group headlines."
+  :version "28.1")
+
+(defface completions-group-separator
+  '((t :inherit shadow :strike-through t))
+  "Face used for the separator lines between the candidate groups."
+  :version "28.1")
+
 (defun completion--cycle-threshold (metadata)
   (let* ((cat (completion-metadata-get metadata 'category))
          (over (completion--category-override cat 'cycle)))
@@ -1401,6 +1434,17 @@ minibuffer--sort-preprocess-history
                      (substring c base-size)))
                  hist)))))
 
+(defun minibuffer--group-by (fun elems)
+  "Group ELEMS by FUN."
+  (let ((groups))
+    (dolist (cand elems)
+      (let* ((key (funcall fun cand nil))
+             (group (assoc key groups)))
+        (if group
+            (setcdr group (cons cand (cdr group)))
+          (push (list key cand) groups))))
+    (mapcan (lambda (x) (nreverse (cdr x))) (nreverse groups))))
+
 (defun completion-all-sorted-completions (&optional start end)
   (or completion-all-sorted-completions
       (let* ((start (or start (minibuffer-prompt-end)))
@@ -1747,11 +1791,17 @@ completions-detailed
   :type 'boolean
   :version "28.1")
 
-(defun completion--insert-strings (strings)
+;; TODO: Split up this function in one function per `completions-format'.
+;; TODO: Add group title support for horizontal and vertical format.
+(defun completion--insert-strings (strings &optional group-fun)
   "Insert a list of STRINGS into the current buffer.
-Uses columns to keep the listing readable but compact.
-It also eliminates runs of equal strings."
+Uses columns to keep the listing readable but compact.  It also
+eliminates runs of equal strings.  GROUP-FUN is a `group-function'
+used for grouping the completion."
   (when (consp strings)
+    ;; FIXME: Currently grouping is enabled only for the 'one-column format.
+    (unless (eq completions-format 'one-column)
+      (setq group-fun nil))
     (let* ((length (apply #'max
 			  (mapcar (lambda (s)
 				    (if (consp s)
@@ -1768,6 +1818,7 @@ completion--insert-strings
 		     (max 1 (/ (length strings) 2))))
 	   (colwidth (/ wwidth columns))
            (column 0)
+           (last-title nil)
 	   (rows (/ (length strings) columns))
 	   (row 0)
            (first t)
@@ -1780,6 +1831,13 @@ completion--insert-strings
       ;; The insertion should be "sensible" no matter what choices were made
       ;; for the parameters above.
       (dolist (str strings)
+        ;; Add group titles.
+        (when group-fun
+          (let ((title (funcall group-fun (if (consp str) (car str) str) nil)))
+            (unless (equal title last-title)
+              (when title
+                (insert (format completions-group-format title) "\n"))
+              (setq last-title title))))
 	(unless (equal laststring str) ; Remove (consecutive) duplicates.
 	  (setq laststring str)
           ;; FIXME: `string-width' doesn't pay attention to
@@ -1825,8 +1883,15 @@ completion--insert-strings
 		  nil))))
             (setq first nil)
             (if (not (consp str))
-                (put-text-property (point) (progn (insert str) (point))
-                                   'mouse-face 'highlight)
+                (add-text-properties
+                 (point)
+                 (progn
+                   (insert
+                    (if group-fun
+                        (funcall group-fun str 'transform)
+                      str))
+                   (point))
+                 `(mouse-face highlight completion--string ,str))
               ;; If `str' is a list that has 2 elements,
               ;; then the second element is a suffix annotation.
               ;; If `str' has 3 elements, then the second element
@@ -1837,8 +1902,15 @@ completion--insert-strings
                   (let ((beg (point))
                         (end (progn (insert prefix) (point))))
                     (put-text-property beg end 'mouse-face nil)))
-                (put-text-property (point) (progn (insert (car str)) (point))
-                                   'mouse-face 'highlight)
+                (add-text-properties
+                 (point)
+                 (progn
+                   (insert
+                    (if group-fun
+                         (funcall group-fun (car str) 'transform)
+                      (car str)))
+                   (point))
+                 `(mouse-face highlight completion--string ,(car str)))
                 (let ((beg (point))
                       (end (progn (insert suffix) (point))))
                   (put-text-property beg end 'mouse-face nil)
@@ -1923,7 +1995,7 @@ completion-hilit-commonality
         completions)
        base-size))))
 
-(defun display-completion-list (completions &optional common-substring)
+(defun display-completion-list (completions &optional common-substring group-fun)
   "Display the list of completions, COMPLETIONS, using `standard-output'.
 Each element may be just a symbol or string
 or may be a list of two strings to be printed as if concatenated.
@@ -1933,7 +2005,9 @@ display-completion-list
 The actual completion alternatives, as inserted, are given `mouse-face'
 properties of `highlight'.
 At the end, this runs the normal hook `completion-setup-hook'.
-It can find the completion buffer in `standard-output'."
+It can find the completion buffer in `standard-output'.
+GROUP-FUN is a `group-function' used for grouping the completion
+candidates."
   (declare (advertised-calling-convention (completions) "24.4"))
   (if common-substring
       (setq completions (completion-hilit-commonality
@@ -1946,7 +2020,7 @@ display-completion-list
 	(let ((standard-output (current-buffer))
 	      (completion-setup-hook nil))
           (with-suppressed-warnings ((callargs display-completion-list))
-	    (display-completion-list completions common-substring)))
+	    (display-completion-list completions common-substring group-fun)))
 	(princ (buffer-string)))
 
     (with-current-buffer standard-output
@@ -1954,7 +2028,7 @@ display-completion-list
       (if (null completions)
           (insert "There are no possible completions of what you have typed.")
         (insert "Possible completions are:\n")
-        (completion--insert-strings completions))))
+        (completion--insert-strings completions group-fun))))
 
   (run-hooks 'completion-setup-hook)
   nil)
@@ -2067,6 +2141,9 @@ minibuffer-completion-help
              (aff-fun (or (completion-metadata-get all-md 'affixation-function)
                           (plist-get completion-extra-properties
                                      :affixation-function)))
+             (sort-fun (completion-metadata-get all-md 'display-sort-function))
+             (group-fun (and completions-group
+                             (completion-metadata-get all-md 'group-function)))
              (mainbuf (current-buffer))
              ;; If the *Completions* buffer is shown in a new
              ;; window, mark it as softly-dedicated, so bury-buffer in
@@ -2098,15 +2175,22 @@ minibuffer-completion-help
                       ;; Remove the base-size tail because `sort' requires a properly
                       ;; nil-terminated list.
                       (when last (setcdr last nil))
-                      (setq completions
-                            ;; FIXME: This function is for the output of all-completions,
-                            ;; not completion-all-completions.  Often it's the same, but
-                            ;; not always.
-                            (let ((sort-fun (completion-metadata-get
-                                             all-md 'display-sort-function)))
-                              (if sort-fun
-                                  (funcall sort-fun completions)
-                                (sort completions 'string-lessp))))
+
+                      ;; Sort first using the `display-sort-function'.
+                      ;; FIXME: This function is for the output of
+                      ;; all-completions, not
+                      ;; completion-all-completions.  Often it's the
+                      ;; same, but not always.
+                      (setq completions (if sort-fun
+                                            (funcall sort-fun completions)
+                                          (sort completions 'string-lessp)))
+
+                      ;; After sorting, group the candidates using the
+                      ;; `group-function'.
+                      (when group-fun
+                        (setq completions
+                              (minibuffer--group-by group-fun completions)))
+
                       (cond
                        (aff-fun
                         (setq completions
@@ -2152,7 +2236,7 @@ minibuffer-completion-help
                                                      (if (eq (car bounds) (length result))
                                                          'exact 'finished)))))))
 
-                      (display-completion-list completions)))))
+                      (display-completion-list completions nil group-fun)))))
           nil)))
     nil))
 
diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el
index 7fc7181acc..2a4fb2c417 100644
--- a/lisp/progmodes/xref.el
+++ b/lisp/progmodes/xref.el
@@ -1044,6 +1044,12 @@ xref-show-definitions-buffer-at-bottom
 (define-obsolete-function-alias 'xref--show-defs-buffer-at-bottom
   #'xref-show-definitions-buffer-at-bottom "28.1")
 
+(defun xref--completing-read-group (cand transform)
+  "Return group title of candidate CAND or TRANSFORM the candidate."
+  (if transform
+      (substring cand (1+ (next-single-property-change 0 'xref--group cand)))
+    (get-text-property 0 'xref--group cand)))
+
 (defun xref-show-definitions-completing-read (fetcher alist)
   "Let the user choose the target definition with completion.
 
@@ -1072,10 +1078,12 @@ xref-show-definitions-completing-read
                                     (format #("%d:" 0 2 (face xref-line-number))
                                             line)
                                   ""))
+                               (group-prefix
+                                (substring group group-prefix-length))
                                (group-fmt
-                                (propertize
-                                 (substring group group-prefix-length)
-                                 'face 'xref-file-header))
+                                (propertize group-prefix
+                                            'face 'xref-file-header
+                                            'xref--group group-prefix))
                                (candidate
                                 (format "%s:%s%s" group-fmt line-fmt summary)))
                           (push (cons candidate xref) xref-alist-with-line-info)))))
@@ -1087,7 +1095,9 @@ xref-show-definitions-completing-read
                          (lambda (string pred action)
                            (cond
                             ((eq action 'metadata)
-                             '(metadata . ((category . xref-location))))
+                             `(metadata
+                               . ((category . xref-location)
+                                  (group-function . ,#'xref--completing-read-group))))
                             (t
                              (complete-with-action action collection string pred)))))
                         (def (caar collection)))
diff --git a/lisp/simple.el b/lisp/simple.el
index 35bb472be0..db8e26a2c0 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -8893,18 +8893,17 @@ choose-completion
           (choice
            (save-excursion
              (goto-char (posn-point (event-start event)))
-             (let (beg end)
+             (let (beg)
                (cond
                 ((and (not (eobp)) (get-text-property (point) 'mouse-face))
-                 (setq end (point) beg (1+ (point))))
+                 (setq beg (1+ (point))))
                 ((and (not (bobp))
                       (get-text-property (1- (point)) 'mouse-face))
-                 (setq end (1- (point)) beg (point)))
+                 (setq beg (point)))
                 (t (error "No completion here")))
                (setq beg (previous-single-property-change beg 'mouse-face))
-               (setq end (or (next-single-property-change end 'mouse-face)
-                             (point-max)))
-               (buffer-substring-no-properties beg end)))))
+               (substring-no-properties
+                (get-text-property beg 'completion--string))))))
 
       (unless (buffer-live-p buffer)
         (error "Destination buffer is dead"))
-- 
2.20.1


[-- Attachment #3: 0002-completion-insert-strings-Split-function-Full-group-.patch --]
[-- Type: text/x-diff, Size: 13753 bytes --]

From 5a55152b4064ea674fea055a8c48a0824b70213d Mon Sep 17 00:00:00 2001
From: Daniel Mendler <mail@daniel-mendler.de>
Date: Fri, 30 Apr 2021 08:40:59 +0200
Subject: [PATCH 2/5] (completion--insert-strings): Split function; Full group
 title support

Split `completion--insert-strings` into a function per completions
format in order to increase readability and extensibility.  This
change eases the addition of more formats.  Add support for group
titles to the vertical and horizontal formatting functions.

* minibuffer.el (completion--insert): Add new function.
(completion--insert-vertical, completion--insert-horizontal,
completion--insert-one-column): Extract function from
`completion--insert-strings`.  Use new function `completion--insert`.
(completion--insert-strings): Use new insertion functions.
---
 lisp/minibuffer.el | 276 ++++++++++++++++++++++++++-------------------
 1 file changed, 158 insertions(+), 118 deletions(-)

diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index b5245e239e..8b3f332782 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -1791,21 +1791,17 @@ completions-detailed
   :type 'boolean
   :version "28.1")
 
-;; TODO: Split up this function in one function per `completions-format'.
-;; TODO: Add group title support for horizontal and vertical format.
 (defun completion--insert-strings (strings &optional group-fun)
   "Insert a list of STRINGS into the current buffer.
-Uses columns to keep the listing readable but compact.  It also
-eliminates runs of equal strings.  GROUP-FUN is a `group-function'
-used for grouping the completion."
+The candidate strings are inserted into the buffer depending on the
+completions format as specified by the variable `completions-format'.
+Runs of equal candidate strings are eliminated.  GROUP-FUN is a
+`group-function' used for grouping the completion candidates."
   (when (consp strings)
-    ;; FIXME: Currently grouping is enabled only for the 'one-column format.
-    (unless (eq completions-format 'one-column)
-      (setq group-fun nil))
     (let* ((length (apply #'max
 			  (mapcar (lambda (s)
 				    (if (consp s)
-					(apply #'+ (mapcar #'string-width s))
+				        (apply #'+ (mapcar #'string-width s))
 				      (string-width s)))
 				  strings)))
 	   (window (get-buffer-window (current-buffer) 0))
@@ -1816,126 +1812,170 @@ completion--insert-strings
 		     ;; Don't allocate more columns than we can fill.
 		     ;; Windows can't show less than 3 lines anyway.
 		     (max 1 (/ (length strings) 2))))
-	   (colwidth (/ wwidth columns))
-           (column 0)
-           (last-title nil)
-	   (rows (/ (length strings) columns))
-	   (row 0)
-           (first t)
-	   (laststring nil))
+	   (colwidth (/ wwidth columns)))
       (unless (or tab-stop-list (null completion-tab-width)
                   (zerop (mod colwidth completion-tab-width)))
         ;; Align to tab positions for the case
         ;; when the caller uses tabs inside prefix.
         (setq colwidth (- colwidth (mod colwidth completion-tab-width))))
-      ;; The insertion should be "sensible" no matter what choices were made
-      ;; for the parameters above.
-      (dolist (str strings)
-        ;; Add group titles.
+      (funcall (intern (format "completion--insert-%s" completions-format))
+               strings group-fun length wwidth colwidth columns))))
+
+(defun completion--insert-horizontal (strings group-fun
+                                              length wwidth
+                                              colwidth _columns)
+  (let ((column 0)
+        (first t)
+	(last-title nil)
+        (last-string nil))
+    (dolist (str strings)
+      (unless (equal last-string str) ; Remove (consecutive) duplicates.
+	(setq last-string str)
         (when group-fun
           (let ((title (funcall group-fun (if (consp str) (car str) str) nil)))
             (unless (equal title last-title)
+              (setq last-title title)
               (when title
-                (insert (format completions-group-format title) "\n"))
-              (setq last-title title))))
-	(unless (equal laststring str) ; Remove (consecutive) duplicates.
-	  (setq laststring str)
+                (insert (if first "" "\n") (format completions-group-format title) "\n")
+                (setq column 0
+                      first t)))))
+	(unless first
           ;; FIXME: `string-width' doesn't pay attention to
           ;; `display' properties.
-          (let ((length (if (consp str)
-                            (apply #'+ (mapcar #'string-width str))
-                          (string-width str))))
-            (cond
-             ((eq completions-format 'one-column)
-              ;; Nothing special
-              )
-	     ((eq completions-format 'vertical)
-	      ;; Vertical format
-	      (when (> row rows)
-		(forward-line (- -1 rows))
-		(setq row 0 column (+ column colwidth)))
-	      (when (> column 0)
-		(end-of-line)
-		(while (> (current-column) column)
-		  (if (eobp)
-		      (insert "\n")
-		    (forward-line 1)
-		    (end-of-line)))
-		(insert " \t")
-		(set-text-properties (1- (point)) (point)
-				     `(display (space :align-to ,column)))))
-	     (t
-	      ;; Horizontal format
-	      (unless first
-		(if (< wwidth (+ (max colwidth length) column))
-		    ;; No space for `str' at point, move to next line.
-		    (progn (insert "\n") (setq column 0))
-		  (insert " \t")
-		  ;; Leave the space unpropertized so that in the case we're
-		  ;; already past the goal column, there is still
-		  ;; a space displayed.
-		  (set-text-properties (1- (point)) (point)
-				       ;; We can set tab-width using
-				       ;; completion-tab-width, but
-				       ;; the caller can prefer using
-				       ;; \t to align prefixes.
-				       `(display (space :align-to ,column)))
-		  nil))))
-            (setq first nil)
-            (if (not (consp str))
-                (add-text-properties
-                 (point)
-                 (progn
-                   (insert
-                    (if group-fun
-                        (funcall group-fun str 'transform)
-                      str))
-                   (point))
-                 `(mouse-face highlight completion--string ,str))
-              ;; If `str' is a list that has 2 elements,
-              ;; then the second element is a suffix annotation.
-              ;; If `str' has 3 elements, then the second element
-              ;; is a prefix, and the third element is a suffix.
-              (let* ((prefix (when (nth 2 str) (nth 1 str)))
-                     (suffix (or (nth 2 str) (nth 1 str))))
-                (when prefix
-                  (let ((beg (point))
-                        (end (progn (insert prefix) (point))))
-                    (put-text-property beg end 'mouse-face nil)))
-                (add-text-properties
-                 (point)
-                 (progn
-                   (insert
-                    (if group-fun
-                         (funcall group-fun (car str) 'transform)
-                      (car str)))
-                   (point))
-                 `(mouse-face highlight completion--string ,(car str)))
-                (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 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
-             ((eq completions-format 'one-column)
-              (insert "\n"))
-	     ((eq completions-format 'vertical)
-	      ;; Vertical format
-	      (if (> column 0)
-		  (forward-line)
-		(insert "\n"))
-	      (setq row (1+ row)))
-	     (t
-	      ;; Horizontal format
-	      ;; Next column to align to.
-	      (setq column (+ column
-			      ;; Round up to a whole number of columns.
-			      (* colwidth (ceiling length colwidth))))))))))))
+	  (if (< wwidth (+ column (max colwidth
+                                       (if (consp str)
+                                           (apply #'+ (mapcar #'string-width str))
+                                         (string-width str)))))
+	      ;; No space for `str' at point, move to next line.
+	      (progn (insert "\n") (setq column 0))
+	    (insert " \t")
+	    ;; Leave the space unpropertized so that in the case we're
+	    ;; already past the goal column, there is still
+	    ;; a space displayed.
+	    (set-text-properties (1- (point)) (point)
+				 ;; We can set tab-width using
+				 ;; completion-tab-width, but
+				 ;; the caller can prefer using
+				 ;; \t to align prefixes.
+				 `(display (space :align-to ,column)))
+	    nil))
+        (setq first nil)
+        (completion--insert str group-fun)
+	;; Next column to align to.
+	(setq column (+ column
+			;; Round up to a whole number of columns.
+			(* colwidth (ceiling length colwidth))))))))
+
+(defun completion--insert-vertical (strings group-fun
+                                            _length _wwidth
+                                            colwidth columns)
+  (let ((column 0)
+        (rows (/ (length strings) columns))
+	(row 0)
+	(last-title nil)
+	(last-string nil)
+        (start-point (point))
+        (next 0) (pos 0))
+    (dolist (str strings)
+      (unless (equal last-string str) ; Remove (consecutive) duplicates.
+	(setq last-string str)
+	(when (> row rows)
+	  (goto-char start-point)
+	  (setq row 0 column (+ column colwidth)))
+        (when group-fun
+          (let ((title (funcall group-fun (if (consp str) (car str) str) nil)))
+            (unless (equal title last-title)
+              (setq last-title title)
+              (when title
+                ;; Align before title insertion
+	        (when (> column 0)
+	          (end-of-line)
+	          (while (> (current-column) column)
+	            (if (eobp)
+		        (insert "\n")
+	              (forward-line 1)
+	              (end-of-line)))
+	          (insert " \t")
+	          (set-text-properties (1- (point)) (point)
+			               `(display (space :align-to ,column))))
+                (let* ((fmt completions-group-format)
+                       (len (length fmt)))
+                  ;; Adjust display space for columns
+                  (when (equal (get-text-property (- len 1) 'display fmt) '(space :align-to right))
+                    (setq fmt (substring fmt))
+                    (put-text-property (- len 1) len
+                                       'display
+                                       `(space :align-to ,(+ colwidth column -1))
+                                       fmt))
+                  (insert (format fmt title)))
+                ;; Align after title insertion
+	        (if (> column 0)
+	            (forward-line)
+	          (insert "\n"))))))
+        ;; Align before candidate insertion
+	(when (> column 0)
+	  (end-of-line)
+	  (while (> (current-column) column)
+	    (if (eobp)
+		(insert "\n")
+	      (forward-line 1)
+	      (end-of-line)))
+	  (insert " \t")
+	  (set-text-properties (1- (point)) (point)
+			       `(display (space :align-to ,column))))
+        (completion--insert str group-fun)
+        ;; Align after candidate insertion
+	(if (> column 0)
+	    (forward-line)
+	  (insert "\n"))
+	(setq row (1+ row))))))
+
+(defun completion--insert-one-column (strings group-fun &rest _)
+  (let ((last-title nil) (last-string nil))
+    (dolist (str strings)
+      (unless (equal last-string str) ; Remove (consecutive) duplicates.
+	(setq last-string str)
+        (when group-fun
+          (let ((title (funcall group-fun (if (consp str) (car str) str) nil)))
+            (unless (equal title last-title)
+              (setq last-title title)
+              (when title
+                (insert (format completions-group-format title) "\n")))))
+        (completion--insert str group-fun)
+        (insert "\n")))))
+
+(defun completion--insert (str group-fun)
+  (if (not (consp str))
+      (add-text-properties
+       (point)
+       (progn
+         (insert
+          (if group-fun
+              (funcall group-fun str 'transform)
+            str))
+         (point))
+       `(mouse-face highlight completion--string ,str))
+    ;; If `str' is a list that has 2 elements,
+    ;; then the second element is a suffix annotation.
+    ;; If `str' has 3 elements, then the second element
+    ;; is a prefix, and the third element is a suffix.
+    (let* ((prefix (when (nth 2 str) (nth 1 str)))
+           (suffix (or (nth 2 str) (nth 1 str))))
+      (when prefix
+        (let ((beg (point))
+              (end (progn (insert prefix) (point))))
+          (put-text-property beg end 'mouse-face nil)))
+      (completion--insert (car str) group-fun)
+      (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 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))))))
 
 (defvar completion-setup-hook nil
   "Normal hook run at the end of setting up a completion list buffer.
-- 
2.20.1


[-- Attachment #4: 0003-minibuffer-completion-help-Do-not-check-completions-.patch --]
[-- Type: text/x-diff, Size: 1379 bytes --]

From 891ee2b7a50f69d75dd0a5624483457fc2c8e003 Mon Sep 17 00:00:00 2001
From: Daniel Mendler <mail@daniel-mendler.de>
Date: Sun, 2 May 2021 15:50:08 +0200
Subject: [PATCH 3/5] (minibuffer-completion-help): Do not check
 `completions-group` centrally

The guard variable `completions-group` should be checked in each
completion table individually.  The guard variable
`completions-detailed` variable is used in the same way.

* minibuffer.el (minibuffer-completion-help): Remove check of
  `completions-group`.
---
 lisp/minibuffer.el | 3 +--
 1 file changed, 1 insertion(+), 2 deletions(-)

diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 8b3f332782..bbf60899e2 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -2182,8 +2182,7 @@ minibuffer-completion-help
                           (plist-get completion-extra-properties
                                      :affixation-function)))
              (sort-fun (completion-metadata-get all-md 'display-sort-function))
-             (group-fun (and completions-group
-                             (completion-metadata-get all-md 'group-function)))
+             (group-fun (completion-metadata-get all-md 'group-function))
              (mainbuf (current-buffer))
              ;; If the *Completions* buffer is shown in a new
              ;; window, mark it as softly-dedicated, so bury-buffer in
-- 
2.20.1


[-- Attachment #5: 0004-completion-insert-vertical-Separate-groups-completel.patch --]
[-- Type: text/x-diff, Size: 5050 bytes --]

From 6a15c420c35c2657c3c53a862e891c21d9972d4f Mon Sep 17 00:00:00 2001
From: Daniel Mendler <mail@daniel-mendler.de>
Date: Sun, 2 May 2021 16:19:42 +0200
Subject: [PATCH 4/5] (completion--insert-vertical): Separate groups completely

Insert the candidates vertically within the groups, but keep the
groups separate using the full width group separators.

* minibuffer.el (completion--insert-vertical): Adjust grouping.
---
 lisp/minibuffer.el | 108 ++++++++++++++++++++-------------------------
 1 file changed, 48 insertions(+), 60 deletions(-)

diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index bbf60899e2..2a2552a6f0 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -1869,66 +1869,54 @@ completion--insert-horizontal
 (defun completion--insert-vertical (strings group-fun
                                             _length _wwidth
                                             colwidth columns)
-  (let ((column 0)
-        (rows (/ (length strings) columns))
-	(row 0)
-	(last-title nil)
-	(last-string nil)
-        (start-point (point))
-        (next 0) (pos 0))
-    (dolist (str strings)
-      (unless (equal last-string str) ; Remove (consecutive) duplicates.
-	(setq last-string str)
-	(when (> row rows)
-	  (goto-char start-point)
-	  (setq row 0 column (+ column colwidth)))
-        (when group-fun
-          (let ((title (funcall group-fun (if (consp str) (car str) str) nil)))
-            (unless (equal title last-title)
-              (setq last-title title)
-              (when title
-                ;; Align before title insertion
-	        (when (> column 0)
-	          (end-of-line)
-	          (while (> (current-column) column)
-	            (if (eobp)
-		        (insert "\n")
-	              (forward-line 1)
-	              (end-of-line)))
-	          (insert " \t")
-	          (set-text-properties (1- (point)) (point)
-			               `(display (space :align-to ,column))))
-                (let* ((fmt completions-group-format)
-                       (len (length fmt)))
-                  ;; Adjust display space for columns
-                  (when (equal (get-text-property (- len 1) 'display fmt) '(space :align-to right))
-                    (setq fmt (substring fmt))
-                    (put-text-property (- len 1) len
-                                       'display
-                                       `(space :align-to ,(+ colwidth column -1))
-                                       fmt))
-                  (insert (format fmt title)))
-                ;; Align after title insertion
-	        (if (> column 0)
-	            (forward-line)
-	          (insert "\n"))))))
-        ;; Align before candidate insertion
-	(when (> column 0)
-	  (end-of-line)
-	  (while (> (current-column) column)
-	    (if (eobp)
-		(insert "\n")
-	      (forward-line 1)
-	      (end-of-line)))
-	  (insert " \t")
-	  (set-text-properties (1- (point)) (point)
-			       `(display (space :align-to ,column))))
-        (completion--insert str group-fun)
-        ;; Align after candidate insertion
-	(if (> column 0)
-	    (forward-line)
-	  (insert "\n"))
-	(setq row (1+ row))))))
+  (while strings
+    (let ((group nil)
+          (column 0)
+	  (row 0)
+          (rows)
+          (last-string nil))
+      (if group-fun
+          (let* ((str (car strings))
+                 (title (funcall group-fun (if (consp str) (car str) str) nil)))
+            (while (and strings
+                        (equal title (funcall group-fun
+                                              (if (consp (car strings))
+                                                  (car (car strings))
+                                                (car strings))
+                                              nil)))
+              (push (car strings) group)
+              (pop strings))
+            (setq group (nreverse group)))
+        (setq group strings
+              strings nil))
+      (setq rows (/ (length group) columns))
+      (when group-fun
+        (let* ((str (car group))
+               (title (funcall group-fun (if (consp str) (car str) str) nil)))
+          (when title
+            (goto-char (point-max))
+            (insert (format completions-group-format title) "\n"))))
+      (dolist (str group)
+        (unless (equal last-string str) ; Remove (consecutive) duplicates.
+	  (setq last-string str)
+	  (when (> row rows)
+            (forward-line (- -1 rows))
+	    (setq row 0 column (+ column colwidth)))
+	  (when (> column 0)
+	    (end-of-line)
+	    (while (> (current-column) column)
+	      (if (eobp)
+		  (insert "\n")
+	        (forward-line 1)
+	        (end-of-line)))
+	    (insert " \t")
+	    (set-text-properties (1- (point)) (point)
+			         `(display (space :align-to ,column))))
+          (completion--insert str group-fun)
+	  (if (> column 0)
+	      (forward-line)
+	    (insert "\n"))
+	  (setq row (1+ row)))))))
 
 (defun completion--insert-one-column (strings group-fun &rest _)
   (let ((last-title nil) (last-string nil))
-- 
2.20.1


[-- Attachment #6: 0005-minibuffer-completion-help-Add-group-sorting.patch --]
[-- Type: text/x-diff, Size: 3967 bytes --]

From 4601a270af996193c6ff06a3d32a035657bf5141 Mon Sep 17 00:00:00 2001
From: Daniel Mendler <mail@daniel-mendler.de>
Date: Tue, 11 May 2021 09:08:05 +0200
Subject: [PATCH 5/5] (minibuffer-completion-help): Add group sorting

Sort the groups as returned by the `group-function` of the completion
table depending on the value of the customizable variable
`completions-group-sort`.  By default `completions-group-sort` is set
to nil.  The variable can be set to the symbol `alphabetical` in order
to configure alphabetical sorting.  Furthermore, a custom sorting
function can be used as value of `completions-group-sort`.

* lisp/minibuffer.el (completions-group-sort): New variable.
(minibuffer--group-by): Add SORT-FUN argument.
(minibuffer-completion-help): Pass `completions-group-sort` to
`minibuffer--group-by`.
---
 lisp/minibuffer.el | 39 +++++++++++++++++++++++++++++++++------
 1 file changed, 33 insertions(+), 6 deletions(-)

diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 2a2552a6f0..6bd3baf074 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -1147,10 +1147,22 @@ completion-cycle-threshold
 
 (defcustom completions-group nil
   "Enable grouping of completion candidates in the *Completions* buffer.
-See also `completions-group-format'."
+See also `completions-group-format' and `completions-group-sort'."
   :type 'boolean
   :version "28.1")
 
+(defcustom completions-group-sort nil
+  "Sort groups in the *Completions* buffer.
+
+The value can either be nil to disable sorting, `alphabetical' for
+alphabetical sorting or a custom sorting function.  The sorting
+function takes and returns an alist of groups, where each element is a
+pair of a group title string and a list of group candidate strings."
+  :type '(choice (const nil :tag "No sorting")
+                 (const alphabetical :tag "Alphabetical sorting")
+                 function)
+  :version "28.1")
+
 (defcustom completions-group-format
   (concat
    (propertize "    " 'face 'completions-group-separator)
@@ -1434,16 +1446,21 @@ minibuffer--sort-preprocess-history
                      (substring c base-size)))
                  hist)))))
 
-(defun minibuffer--group-by (fun elems)
-  "Group ELEMS by FUN."
+(defun minibuffer--group-by (group-fun sort-fun elems)
+  "Group ELEMS by GROUP-FUN and sort groups by SORT-FUN."
   (let ((groups))
     (dolist (cand elems)
-      (let* ((key (funcall fun cand nil))
+      (let* ((key (funcall group-fun cand nil))
              (group (assoc key groups)))
         (if group
             (setcdr group (cons cand (cdr group)))
           (push (list key cand) groups))))
-    (mapcan (lambda (x) (nreverse (cdr x))) (nreverse groups))))
+    (setq groups (nreverse groups)
+          groups (mapc (lambda (x)
+                         (setcdr x (nreverse (cdr x))))
+                       groups)
+          groups (funcall sort-fun groups))
+    (mapcan #'cdr groups)))
 
 (defun completion-all-sorted-completions (&optional start end)
   (or completion-all-sorted-completions
@@ -2216,7 +2233,17 @@ minibuffer-completion-help
                       ;; `group-function'.
                       (when group-fun
                         (setq completions
-                              (minibuffer--group-by group-fun completions)))
+                              (minibuffer--group-by
+                               group-fun
+                               (pcase completions-group-sort
+                                 ('nil #'identity)
+                                 ('alphabetical
+                                  (lambda (groups)
+                                    (sort groups
+                                          (lambda (x y)
+                                            (string< (car x) (car y))))))
+                                 (_ completions-group-sort))
+                               completions)))
 
                       (cond
                        (aff-fun
-- 
2.20.1

Re: [PATCH] `completing-read`: Add `group-function` support to completion metadata (REVISED PATCH VERSION 7)

[Daniel Mendler]

On 5/13/21 1:45 PM, Daniel Mendler wrote:
> On 5/13/21 12:32 PM, Eli Zaretskii wrote:
>>> I attached the updated patches, the variable `completions-group-sort`
>>> allows the more user friendly values nil and 'alphabetical. I hope it is
>>> more acceptable in this form.
>>
>> Thanks, this addresses my concerns.
>>
>> (Please proofread the comments, doc strings, and Texinfo changes in
>> the patches to make sure you leave 2 spaces between sentences, per our
>> conventions to use US English.)
> 
> Thank you, Eli. I went over the commit messages, comments, Texinfo and
> doc strings and made a few corrections. The revised patches are attached.

From my side the attached patches are ready. Is there anything else that
should be addressed? Juri, does the `group-function` work as desired for
`ucs-char-names` in the current form? See my last mail "REVISED PATCH
VERSION 7".

Thank you!

Daniel

Re: [PATCH] `completing-read`: Add `group-function` support to completion metadata (REVISED PATCH VERSION 7)

[Juri Linkov]

>>>> I attached the updated patches, the variable `completions-group-sort`
>>>> allows the more user friendly values nil and 'alphabetical. I hope it is
>>>> more acceptable in this form.
>>>
>>> Thanks, this addresses my concerns.
>>>
>>> (Please proofread the comments, doc strings, and Texinfo changes in
>>> the patches to make sure you leave 2 spaces between sentences, per our
>>> conventions to use US English.)
>>
>> Thank you, Eli. I went over the commit messages, comments, Texinfo and
>> doc strings and made a few corrections. The revised patches are attached.
>
> From my side the attached patches are ready. Is there anything else that
> should be addressed? Juri, does the `group-function` work as desired for
> `ucs-char-names` in the current form? See my last mail "REVISED PATCH
> VERSION 7".

I tried out again, and everything works without problems.  Thank you!

Since there are no more objections, it seems the version 7 of your patch
is the final version, so I pushed it to master.

Re: [PATCH] `completing-read`: Add `group-function` support to completion metadata (REVISED PATCH VERSION 7)

[Daniel Mendler]

On 5/20/21 7:53 PM, Juri Linkov wrote:
> I tried out again, and everything works without problems.  Thank you!
> 
> Since there are no more objections, it seems the version 7 of your patch
> is the final version, so I pushed it to master.

Thank you for merging and thank you all for the discussion and
improvement proposals! I pushed the corresponding changes to my packages
which now use the official `group-function`. I just compiled Emacs
master and everything works as expected.

Daniel

Re: [PATCH] `completing-read`: Add `group-function` support to completion metadata (REVISED PATCH)

[Dmitry Gutov]

On 29.04.2021 19:20, Juri Linkov wrote:
> OTOH, it highlighted the shortcomings of amalgamating both
> grouping and transforming in the same function:
> mule--ucs-names-group doesn't need to provide transformation,
> because the same affixation-function is used for both
> grouping and non-grouping completions.

If affixation-function didn't return a three-element list (and instead 
only returned some focused information pertaining to a single value), 
you wouldn't have this problem.

Re: [PATCH] `completing-read`: Add `group-function` support to completion metadata (REVISED PATCH)

[Daniel Mendler]

On 4/29/21 7:09 PM, Dmitry Gutov wrote:
> If affixation-function didn't return a three-element list (and instead 
> only returned some focused information pertaining to a single value), 
> you wouldn't have this problem.

I don't understand the argument here. From my perspective the
`affixation-function` is good as is. It is a generalization of the
`annotation-function` which allows transformation of all candidates at
once and it additionally allows prefixes. However one could discuss if
the affixation function should be allowed to transform the actual
candidate string, as has been mentioned in the discussion before. I
think one can set text properties but one is not allowed to change the
candidate string - this will break `choose-completion`.

Daniel

Re: [PATCH] `completing-read`: Add `group-function` support to completion metadata (REVISED PATCH)

[Dmitry Gutov]

On 29.04.2021 20:16, Daniel Mendler wrote:
> On 4/29/21 7:09 PM, Dmitry Gutov wrote:
>> If affixation-function didn't return a three-element list (and instead
>> only returned some focused information pertaining to a single value),
>> you wouldn't have this problem.
> 
> I don't understand the argument here.

It's an argument about being able to "do more with less", and as a 
side-effect not have to worry about resolving potential conflicts in 
duplication of information.

> From my perspective the
> `affixation-function` is good as is. It is a generalization of the
> `annotation-function` which allows transformation of all candidates at
> once and it additionally allows prefixes. However one could discuss if
> the affixation function should be allowed to transform the actual
> candidate string, as has been mentioned in the discussion before. I
> think one can set text properties but one is not allowed to change the
> candidate string - this will break `choose-completion`.

I don't think anything like this necessarily has to break 
'choose-completion': the UI can remember the mapping between 
"transformed" and actual completion strings. It's just extra complexity 
in implementation.

On the higher level, though, I do believe completion tables should not 
define _presentation_, only information (with some well-defined 
exceptions, maybe).

RE: [External] : Re: [PATCH] `completing-read`: Add `group-function` support to completion metadata (REVISED PATCH)

[Drew Adams]

> I do believe completion tables should not
> define _presentation_, only information (with
> some well-defined exceptions, maybe).

I agree with this (IIUC).  Strongly.

Sorting (for both listing and cycling) can be one
example of such presentation.

However, I'd put it this way:

In order to affect/realize presentation, one should,
in general, not _have_ to fiddle with the completion
table.

___

This doesn't mean that it should be impossible to
include in the table (or metadata or whatever) some
info that can be used in some ways for presentation.

The point is that presentation of candidates (both
before and after matching) can often be logically
separate from definition of the domain of candidates
to match against, filter, and choose from.

And in practice also, the two can often/usually be
separated.  That is, they can be kept separate if we
don't hard-wire the completion table as the place
where such presentation-support info needs to be
provided.

(I'm guessing this was also your point - what you
meant.  And you too mentioned exceptions.)

___

As a result of this point of view, we should try
NOT to think of supporting presentation concerns by
adding features to the completion table etc.  There
should be no dependence of presentation realization
on the table etc. - in general.

I mentioned sorting as being presentation: put
candidates in a particular order.  But some kinds
of sorting can be closely tied to a particular
completion style (for example): they might be
appropriate only for certain styles, or certain
styles might naturally lend themselves to certain
sort orders.

In addition, a completion "table" that's a function
can also combine some quasi-presentation within its
definition of the domain of candidates.  E.g., user
partial input (matching) can be part of the domain
definition.

Same thing for a "table" that's generated on the
fly by some process.

Presentation and the data to be presented can, IOW,
be mutually defined in some cases.

But the larger point is that it should be possible
(easy) in many cases to implement presentation
separately from definition of the table, metadata,
etc.

Again (aside from some exceptions) sorting is an
example: code and users should, in many cases, be
able to change sort orders during the same process
of completion (e.g. invocation of `completing-read').

Re: [External] : Re: [PATCH] `completing-read`: Add `group-function` support to completion metadata (REVISED PATCH)

[Dmitry Gutov]

On 29.04.2021 21:31, Drew Adams wrote:
> This doesn't mean that it should be impossible to
> include in the table (or metadata or whatever) some
> info that can be used in some ways for presentation.

Yes, so: don't include presentation, but include extra information that 
can be used to build/choose/refine presentation.

RE: [External] : Re: [PATCH] `completing-read`: Add `group-function` support to completion metadata (REVISED PATCH)

[Drew Adams]

> > This doesn't mean that it should be impossible to
> > include in the table (or metadata or whatever) some
> > info that can be used in some ways for presentation.
> 
> Yes, so: don't include presentation, but include extra information
> that can be used to build/choose/refine presentation.

What might that be, in general?

Isn't a function value of `minibuffer-completion-table'
general enough for it to encapsulate any such info you
might want/need?  Don't you already have the means to
include extra info for that?

I don't know - just asking.

Is there really some need to provide specific info or
a specific mechanism for this?  The risk I see is
that doing that might seduce some to hard-wire things
- just what I'd like to avoid.

Is there really something lacking now?

I granted that sometimes (not often, IMO) one might
really want (or even need?) to have some
presentation-helping info in the "table" or in some
metadata or whatever.

But it doesn't follow that something is missing or
needs to be added, for that.  I'm guessing that
what exists is already sufficient for doing that.

If not, just what do you think is needed, and why?

Re: [External] : Re: [PATCH] `completing-read`: Add `group-function` support to completion metadata (REVISED PATCH)

[Dmitry Gutov]

On 30.04.2021 01:15, Drew Adams wrote:
> If not, just what do you think is needed, and why?

Check out elisp--company-kind, for example. And other :company-* stuff 
in elisp-completion-at-point.

RE: [External] : Re: [PATCH] `completing-read`: Add `group-function` support to completion metadata (REVISED PATCH)

[Drew Adams]

> > If not, just what do you think is needed, and why?
> 
> Check out elisp--company-kind, for example. And other 
> :company-* stuff in elisp-completion-at-point.

No thanks.  Either you'll say what you think is needed
or you won't.  That's up to you.

I've said what I wanted to about this.  You apparently
agree that, in general, the completion apparatus should
not be concerned with presentation.  It shouldn't, in
general, need to encode info to support presentation.  
To implement presentation features, we should not need,
in general, to bake some settings into the completion
apparatus ahead of time (e.g. when defining the "table").

You've agreed, I think, that there can be exceptions to
this general rule.

It's the general rule I wanted to get across.  Let's
not design the completion table etc. so it becomes our
means to encode presentation or info for presentation.

We've already gone down that road for completion-styles
and sorting.  IMO that was a mistake.  It's better to
be able to control such things more flexibly, from
anywhere, on the fly, instead of pretty much setting
them once and for all for a given call to, say,
`completing-read'.

Re: [PATCH] `completing-read`: Add `group-function` support to completion metadata (REVISED PATCH)

[Daniel Mendler]

On 4/29/21 7:55 PM, Dmitry Gutov wrote:
> I don't think anything like this necessarily has to break 
> 'choose-completion': the UI can remember the mapping between 
> "transformed" and actual completion strings. It's just extra complexity 
> in implementation.

Of course. I may propose a patch which allows the affixation function to
return transformed candidates. It is not a big problem to support this
use case.

Daniel

Re: [PATCH] `completing-read`: Add `group-function` support to completion metadata (REVISED PATCH VERSION 3)

[Daniel Mendler]

[-- Attachment #1: Type: text/plain, Size: 468 bytes --]

I attached a revised version of the `group-function` for
`completing-read` patches, implementing the suggestions by Juri Linkov.

1. The guard variable `completions-group` is not checked centrally, like
`completions-detailed`.
2. The vertical completions format separates the groups completely using
full-width group separators, instead of inserting the titles within the
vertical flow.

I kept the commits separate in order to make the changes more explicit.

Daniel

[-- Attachment #2: 0001-completing-read-Add-group-function-to-completion-met.patch --]
[-- Type: text/x-diff, Size: 18517 bytes --]

From 076424b58ff76f8437e5427c65cc461ed1c95daf Mon Sep 17 00:00:00 2001
From: Daniel Mendler <mail@daniel-mendler.de>
Date: Sun, 25 Apr 2021 13:07:29 +0200
Subject: [PATCH 1/4] (completing-read): Add `group-function` to completion
 metadata

A completion table can specify a `group-function` in its metadata.
The group function takes two arguments, a completion candidate and a
transform argument. The group function is used to group the candidates
after sorting and to enhance the completion UI with group titles.

If the transform argument is nil, the function must return the title
of the group to which the completion candidate belongs. The function
may also return nil in case the candidate does not belong to a group.

Otherwise the function must return the transformed candidate. The
transformation allows for example to remove a part of the candidate,
which is then displayed in the title.

The grouping functionality guarded by the variable `completions-group`
and turned off by default for the *Completions* buffer.

The specific form of the `group-function` has been chosen in order to
allow allocation-free grouping. This is important for completion UIs,
which continously update the displayed set of candidates (Icomplete,
Vertico, Ivy, etc.). Only when the transform argument is non-nil the
candidate transformation is performed, which may involve a string
allocation as for example in `xref--completing-read-group`.

The function `xref-show-definitions-completing-read` makes use of the
`group-function`, by moving the file name prefix to the title. If
grouping is enabled, the *Completions* are displayed as
"linenum:summary" instead of "file:linenum:summary". This way the
*Completions* buffer resembles the *Occur* buffer.

* doc/lispref/minibuf.texi: Add documentation.

* lisp/minibuffer.el (completion-metadata): Describe `group-function`
in the docstring.
(completions-group): Add guard variable, by default off.
(completions-group-format): Add format string for group titles.
(completions-group-title): Add face for group titles.
(completions-group-separator): Add face for group separator.
(minibuffer--group-by): New grouping function.
(minibuffer-completion-help): Use it.
(display-completion-list): Add optional GROUP-FUN argument.
(completion--insert-strings): Add optional GROUP-FUN argument. Insert
group titles if `completions-format` is `one-column`. Transform each
candidate with the GROUP-FUN. Attach the untransformed candidate to
the property `completion--string`.

* lisp/simple.el (choose-completion): Retrieve the untransformed
completion candidate from the property `completion--string`.

* lisp/progmodes/xref.el:
(xref--completing-read-group): New grouping function.
(xref-show-definitions-completing-read): Use it.
---
 doc/lispref/minibuf.texi |  10 ++++
 lisp/minibuffer.el       | 123 ++++++++++++++++++++++++++++++++-------
 lisp/progmodes/xref.el   |  18 ++++--
 lisp/simple.el           |  11 ++--
 4 files changed, 131 insertions(+), 31 deletions(-)

diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi
index 145eee8f06..aa57c2bda0 100644
--- a/doc/lispref/minibuf.texi
+++ b/doc/lispref/minibuf.texi
@@ -1943,6 +1943,16 @@ Programmed Completion
 a suffix displayed after the completion string.  This function
 takes priority over @code{annotation-function}.
 
+@item group-function
+The value should be a function for grouping the completion candidates.
+The function must take two arguments, @var{completion}, which is a
+completion candidate and @var{transform}, which is a boolean flag.  If
+@var{transform} is @code{nil}, the function must return a group title,
+to which the candidate belongs. The returned title can also
+@code{nil}.  Otherwise the function must return the transformed
+candidate. The transformation can for example remove a redundant
+prefix, which is displayed in the group title instead.
+
 @item display-sort-function
 The value should be a function for sorting completions.  The function
 should take one argument, a list of completion strings, and return a
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index caf06ec710..e21a699dae 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -126,6 +126,13 @@ completion-metadata
    three-element lists: completion, its prefix and suffix.  This
    function takes priority over `annotation-function' when both are
    provided, so only this function is used.
+- `group-function': function for grouping the completion candidates.
+   Takes two arguments: a completion candidate (COMPLETION) and a
+   boolean flag (TRANSFORM).  If TRANSFORM is nil, the function
+   returns a group title, to which the candidate belongs.  The
+   returned title may be nil.  Otherwise the function returns the
+   transformed candidate.  The transformation can remove a redundant
+   prefix, which is displayed in the group title instead.
 - `display-sort-function': function to sort entries in *Completions*.
    Takes one argument (COMPLETIONS) and should return a new list
    of completions.  Can operate destructively.
@@ -1138,6 +1145,30 @@ completion-cycle-threshold
   :version "24.1"
   :type completion--cycling-threshold-type)
 
+(defcustom completions-group nil
+  "Enable grouping of completion candidates in the *Completions* buffer.
+See also `completions-group-format'."
+  :type 'boolean
+  :version "28.1")
+
+(defcustom completions-group-format
+  (concat
+   (propertize "    " 'face 'completions-group-separator)
+   (propertize " %s " 'face 'completions-group-title)
+   (propertize " " 'face 'completions-group-separator
+               'display '(space :align-to right)))
+  "Format string used for the group title."
+  :type 'string
+  :version "28.1")
+
+(defface completions-group-title '((t :inherit shadow :slant italic))
+  "Face used for the title text of the candidate group headlines."
+  :version "28.1")
+
+(defface completions-group-separator '((t :inherit shadow :strike-through t))
+  "Face used for the separator lines of the candidate groups."
+  :version "28.1")
+
 (defun completion--cycle-threshold (metadata)
   (let* ((cat (completion-metadata-get metadata 'category))
          (over (completion--category-override cat 'cycle)))
@@ -1401,6 +1432,17 @@ minibuffer--sort-preprocess-history
                      (substring c base-size)))
                  hist)))))
 
+(defun minibuffer--group-by (fun elems)
+  "Group ELEMS by FUN."
+  (let ((groups))
+    (dolist (cand elems)
+      (let* ((key (funcall fun cand nil))
+             (group (assoc key groups)))
+        (if group
+            (setcdr group (cons cand (cdr group)))
+          (push (list key cand) groups))))
+    (mapcan (lambda (x) (nreverse (cdr x))) (nreverse groups))))
+
 (defun completion-all-sorted-completions (&optional start end)
   (or completion-all-sorted-completions
       (let* ((start (or start (minibuffer-prompt-end)))
@@ -1747,11 +1789,17 @@ completions-detailed
   :type 'boolean
   :version "28.1")
 
-(defun completion--insert-strings (strings)
+;; TODO: Split up this function in one function per `completions-format'.
+;; TODO: Add group title support for horizontal and vertical format.
+(defun completion--insert-strings (strings &optional group-fun)
   "Insert a list of STRINGS into the current buffer.
-Uses columns to keep the listing readable but compact.
-It also eliminates runs of equal strings."
+Uses columns to keep the listing readable but compact.  It also
+eliminates runs of equal strings.  GROUP-FUN is a `group-function'
+used for grouping the completion."
   (when (consp strings)
+    ;; FIXME: Currently grouping is enabled only for the 'one-column format.
+    (unless (eq completions-format 'one-column)
+      (setq group-fun nil))
     (let* ((length (apply #'max
 			  (mapcar (lambda (s)
 				    (if (consp s)
@@ -1768,6 +1816,7 @@ completion--insert-strings
 		     (max 1 (/ (length strings) 2))))
 	   (colwidth (/ wwidth columns))
            (column 0)
+           (last-title nil)
 	   (rows (/ (length strings) columns))
 	   (row 0)
            (first t)
@@ -1780,6 +1829,13 @@ completion--insert-strings
       ;; The insertion should be "sensible" no matter what choices were made
       ;; for the parameters above.
       (dolist (str strings)
+        ;; Add group titles.
+        (when group-fun
+          (let ((title (funcall group-fun (if (consp str) (car str) str) nil)))
+            (unless (equal title last-title)
+              (when title
+                (insert (format completions-group-format title) "\n"))
+              (setq last-title title))))
 	(unless (equal laststring str) ; Remove (consecutive) duplicates.
 	  (setq laststring str)
           ;; FIXME: `string-width' doesn't pay attention to
@@ -1825,8 +1881,15 @@ completion--insert-strings
 		  nil))))
             (setq first nil)
             (if (not (consp str))
-                (put-text-property (point) (progn (insert str) (point))
-                                   'mouse-face 'highlight)
+                (add-text-properties
+                 (point)
+                 (progn
+                   (insert
+                    (if group-fun
+                        (funcall group-fun str 'transform)
+                      str))
+                   (point))
+                 `(mouse-face highlight completion--string ,str))
               ;; If `str' is a list that has 2 elements,
               ;; then the second element is a suffix annotation.
               ;; If `str' has 3 elements, then the second element
@@ -1837,8 +1900,15 @@ completion--insert-strings
                   (let ((beg (point))
                         (end (progn (insert prefix) (point))))
                     (put-text-property beg end 'mouse-face nil)))
-                (put-text-property (point) (progn (insert (car str)) (point))
-                                   'mouse-face 'highlight)
+                (add-text-properties
+                 (point)
+                 (progn
+                   (insert
+                    (if group-fun
+                         (funcall group-fun (car str) 'transform)
+                      (car str)))
+                   (point))
+                 `(mouse-face highlight completion--string ,(car str)))
                 (let ((beg (point))
                       (end (progn (insert suffix) (point))))
                   (put-text-property beg end 'mouse-face nil)
@@ -1923,7 +1993,7 @@ completion-hilit-commonality
         completions)
        base-size))))
 
-(defun display-completion-list (completions &optional common-substring)
+(defun display-completion-list (completions &optional common-substring group-fun)
   "Display the list of completions, COMPLETIONS, using `standard-output'.
 Each element may be just a symbol or string
 or may be a list of two strings to be printed as if concatenated.
@@ -1933,7 +2003,8 @@ display-completion-list
 The actual completion alternatives, as inserted, are given `mouse-face'
 properties of `highlight'.
 At the end, this runs the normal hook `completion-setup-hook'.
-It can find the completion buffer in `standard-output'."
+It can find the completion buffer in `standard-output'.
+GROUP-FUN is a `group-function' used for grouping the completion."
   (declare (advertised-calling-convention (completions) "24.4"))
   (if common-substring
       (setq completions (completion-hilit-commonality
@@ -1946,7 +2017,7 @@ display-completion-list
 	(let ((standard-output (current-buffer))
 	      (completion-setup-hook nil))
           (with-suppressed-warnings ((callargs display-completion-list))
-	    (display-completion-list completions common-substring)))
+	    (display-completion-list completions common-substring group-fun)))
 	(princ (buffer-string)))
 
     (with-current-buffer standard-output
@@ -1954,7 +2025,7 @@ display-completion-list
       (if (null completions)
           (insert "There are no possible completions of what you have typed.")
         (insert "Possible completions are:\n")
-        (completion--insert-strings completions))))
+        (completion--insert-strings completions group-fun))))
 
   (run-hooks 'completion-setup-hook)
   nil)
@@ -2067,6 +2138,9 @@ minibuffer-completion-help
              (aff-fun (or (completion-metadata-get all-md 'affixation-function)
                           (plist-get completion-extra-properties
                                      :affixation-function)))
+             (sort-fun (completion-metadata-get all-md 'display-sort-function))
+             (group-fun (and completions-group
+                             (completion-metadata-get all-md 'group-function)))
              (mainbuf (current-buffer))
              ;; If the *Completions* buffer is shown in a new
              ;; window, mark it as softly-dedicated, so bury-buffer in
@@ -2098,15 +2172,22 @@ minibuffer-completion-help
                       ;; Remove the base-size tail because `sort' requires a properly
                       ;; nil-terminated list.
                       (when last (setcdr last nil))
-                      (setq completions
-                            ;; FIXME: This function is for the output of all-completions,
-                            ;; not completion-all-completions.  Often it's the same, but
-                            ;; not always.
-                            (let ((sort-fun (completion-metadata-get
-                                             all-md 'display-sort-function)))
-                              (if sort-fun
-                                  (funcall sort-fun completions)
-                                (sort completions 'string-lessp))))
+
+                      ;; Sort first using the `display-sort-function'.
+                      ;; FIXME: This function is for the output of
+                      ;; all-completions, not
+                      ;; completion-all-completions.  Often it's the
+                      ;; same, but not always.
+                      (setq completions (if sort-fun
+                                            (funcall sort-fun completions)
+                                          (sort completions 'string-lessp)))
+
+                      ;; After sorting, group the candidates using the
+                      ;; `group-function'.
+                      (when group-fun
+                        (setq completions
+                              (minibuffer--group-by group-fun completions)))
+
                       (cond
                        (aff-fun
                         (setq completions
@@ -2152,7 +2233,7 @@ minibuffer-completion-help
                                                      (if (eq (car bounds) (length result))
                                                          'exact 'finished)))))))
 
-                      (display-completion-list completions)))))
+                      (display-completion-list completions nil group-fun)))))
           nil)))
     nil))
 
diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el
index 7fc7181acc..2a4fb2c417 100644
--- a/lisp/progmodes/xref.el
+++ b/lisp/progmodes/xref.el
@@ -1044,6 +1044,12 @@ xref-show-definitions-buffer-at-bottom
 (define-obsolete-function-alias 'xref--show-defs-buffer-at-bottom
   #'xref-show-definitions-buffer-at-bottom "28.1")
 
+(defun xref--completing-read-group (cand transform)
+  "Return group title of candidate CAND or TRANSFORM the candidate."
+  (if transform
+      (substring cand (1+ (next-single-property-change 0 'xref--group cand)))
+    (get-text-property 0 'xref--group cand)))
+
 (defun xref-show-definitions-completing-read (fetcher alist)
   "Let the user choose the target definition with completion.
 
@@ -1072,10 +1078,12 @@ xref-show-definitions-completing-read
                                     (format #("%d:" 0 2 (face xref-line-number))
                                             line)
                                   ""))
+                               (group-prefix
+                                (substring group group-prefix-length))
                                (group-fmt
-                                (propertize
-                                 (substring group group-prefix-length)
-                                 'face 'xref-file-header))
+                                (propertize group-prefix
+                                            'face 'xref-file-header
+                                            'xref--group group-prefix))
                                (candidate
                                 (format "%s:%s%s" group-fmt line-fmt summary)))
                           (push (cons candidate xref) xref-alist-with-line-info)))))
@@ -1087,7 +1095,9 @@ xref-show-definitions-completing-read
                          (lambda (string pred action)
                            (cond
                             ((eq action 'metadata)
-                             '(metadata . ((category . xref-location))))
+                             `(metadata
+                               . ((category . xref-location)
+                                  (group-function . ,#'xref--completing-read-group))))
                             (t
                              (complete-with-action action collection string pred)))))
                         (def (caar collection)))
diff --git a/lisp/simple.el b/lisp/simple.el
index b4e34f1e4c..fe7ff0333f 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -8876,18 +8876,17 @@ choose-completion
           (choice
            (save-excursion
              (goto-char (posn-point (event-start event)))
-             (let (beg end)
+             (let (beg)
                (cond
                 ((and (not (eobp)) (get-text-property (point) 'mouse-face))
-                 (setq end (point) beg (1+ (point))))
+                 (setq beg (1+ (point))))
                 ((and (not (bobp))
                       (get-text-property (1- (point)) 'mouse-face))
-                 (setq end (1- (point)) beg (point)))
+                 (setq beg (point)))
                 (t (error "No completion here")))
                (setq beg (previous-single-property-change beg 'mouse-face))
-               (setq end (or (next-single-property-change end 'mouse-face)
-                             (point-max)))
-               (buffer-substring-no-properties beg end)))))
+               (substring-no-properties
+                (get-text-property beg 'completion--string))))))
 
       (unless (buffer-live-p buffer)
         (error "Destination buffer is dead"))
-- 
2.20.1


[-- Attachment #3: 0002-completion-insert-strings-Split-function-Full-group-.patch --]
[-- Type: text/x-diff, Size: 13458 bytes --]

From 11b3c3e4ffa873b832b45336a00338ef36df4970 Mon Sep 17 00:00:00 2001
From: Daniel Mendler <mail@daniel-mendler.de>
Date: Fri, 30 Apr 2021 08:40:59 +0200
Subject: [PATCH 2/4] (completion--insert-strings): Split function; Full group
 title support

Split `completion--insert-strings` into a function per completions
format in order to increase readability and extensibility. This change
eases the addition of more formats. Add support for group titles to
the vertical and horizontal format.

* minibuffer.el (completion--insert): Add new function.
(completion--insert-vertical, completion--insert-horizontal,
completion--insert-one-column): Extract new function from
`completion--insert-strings`. Use `completion--insert`.
(completion--insert-strings): Use new insertion functions.
---
 lisp/minibuffer.el | 269 ++++++++++++++++++++++++++-------------------
 1 file changed, 154 insertions(+), 115 deletions(-)

diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index e21a699dae..cf1a4350bd 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -1789,21 +1789,16 @@ completions-detailed
   :type 'boolean
   :version "28.1")
 
-;; TODO: Split up this function in one function per `completions-format'.
-;; TODO: Add group title support for horizontal and vertical format.
 (defun completion--insert-strings (strings &optional group-fun)
   "Insert a list of STRINGS into the current buffer.
 Uses columns to keep the listing readable but compact.  It also
 eliminates runs of equal strings.  GROUP-FUN is a `group-function'
 used for grouping the completion."
   (when (consp strings)
-    ;; FIXME: Currently grouping is enabled only for the 'one-column format.
-    (unless (eq completions-format 'one-column)
-      (setq group-fun nil))
     (let* ((length (apply #'max
 			  (mapcar (lambda (s)
 				    (if (consp s)
-					(apply #'+ (mapcar #'string-width s))
+				        (apply #'+ (mapcar #'string-width s))
 				      (string-width s)))
 				  strings)))
 	   (window (get-buffer-window (current-buffer) 0))
@@ -1814,126 +1809,170 @@ completion--insert-strings
 		     ;; Don't allocate more columns than we can fill.
 		     ;; Windows can't show less than 3 lines anyway.
 		     (max 1 (/ (length strings) 2))))
-	   (colwidth (/ wwidth columns))
-           (column 0)
-           (last-title nil)
-	   (rows (/ (length strings) columns))
-	   (row 0)
-           (first t)
-	   (laststring nil))
+	   (colwidth (/ wwidth columns)))
       (unless (or tab-stop-list (null completion-tab-width)
                   (zerop (mod colwidth completion-tab-width)))
         ;; Align to tab positions for the case
         ;; when the caller uses tabs inside prefix.
         (setq colwidth (- colwidth (mod colwidth completion-tab-width))))
-      ;; The insertion should be "sensible" no matter what choices were made
-      ;; for the parameters above.
-      (dolist (str strings)
-        ;; Add group titles.
+      (funcall (intern (format "completion--insert-%s" completions-format))
+               strings group-fun length wwidth colwidth columns))))
+
+(defun completion--insert-horizontal (strings group-fun
+                                              length wwidth
+                                              colwidth _columns)
+  (let ((column 0)
+        (first t)
+	(last-title nil)
+        (last-string nil))
+    (dolist (str strings)
+      (unless (equal last-string str) ; Remove (consecutive) duplicates.
+	(setq last-string str)
         (when group-fun
           (let ((title (funcall group-fun (if (consp str) (car str) str) nil)))
             (unless (equal title last-title)
+              (setq last-title title)
               (when title
-                (insert (format completions-group-format title) "\n"))
-              (setq last-title title))))
-	(unless (equal laststring str) ; Remove (consecutive) duplicates.
-	  (setq laststring str)
+                (insert (if first "" "\n") (format completions-group-format title) "\n")
+                (setq column 0
+                      first t)))))
+	(unless first
           ;; FIXME: `string-width' doesn't pay attention to
           ;; `display' properties.
-          (let ((length (if (consp str)
-                            (apply #'+ (mapcar #'string-width str))
-                          (string-width str))))
-            (cond
-             ((eq completions-format 'one-column)
-              ;; Nothing special
-              )
-	     ((eq completions-format 'vertical)
-	      ;; Vertical format
-	      (when (> row rows)
-		(forward-line (- -1 rows))
-		(setq row 0 column (+ column colwidth)))
-	      (when (> column 0)
-		(end-of-line)
-		(while (> (current-column) column)
-		  (if (eobp)
-		      (insert "\n")
-		    (forward-line 1)
-		    (end-of-line)))
-		(insert " \t")
-		(set-text-properties (1- (point)) (point)
-				     `(display (space :align-to ,column)))))
-	     (t
-	      ;; Horizontal format
-	      (unless first
-		(if (< wwidth (+ (max colwidth length) column))
-		    ;; No space for `str' at point, move to next line.
-		    (progn (insert "\n") (setq column 0))
-		  (insert " \t")
-		  ;; Leave the space unpropertized so that in the case we're
-		  ;; already past the goal column, there is still
-		  ;; a space displayed.
-		  (set-text-properties (1- (point)) (point)
-				       ;; We can set tab-width using
-				       ;; completion-tab-width, but
-				       ;; the caller can prefer using
-				       ;; \t to align prefixes.
-				       `(display (space :align-to ,column)))
-		  nil))))
-            (setq first nil)
-            (if (not (consp str))
-                (add-text-properties
-                 (point)
-                 (progn
-                   (insert
-                    (if group-fun
-                        (funcall group-fun str 'transform)
-                      str))
-                   (point))
-                 `(mouse-face highlight completion--string ,str))
-              ;; If `str' is a list that has 2 elements,
-              ;; then the second element is a suffix annotation.
-              ;; If `str' has 3 elements, then the second element
-              ;; is a prefix, and the third element is a suffix.
-              (let* ((prefix (when (nth 2 str) (nth 1 str)))
-                     (suffix (or (nth 2 str) (nth 1 str))))
-                (when prefix
-                  (let ((beg (point))
-                        (end (progn (insert prefix) (point))))
-                    (put-text-property beg end 'mouse-face nil)))
-                (add-text-properties
-                 (point)
-                 (progn
-                   (insert
-                    (if group-fun
-                         (funcall group-fun (car str) 'transform)
-                      (car str)))
-                   (point))
-                 `(mouse-face highlight completion--string ,(car str)))
-                (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 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
-             ((eq completions-format 'one-column)
-              (insert "\n"))
-	     ((eq completions-format 'vertical)
-	      ;; Vertical format
-	      (if (> column 0)
-		  (forward-line)
-		(insert "\n"))
-	      (setq row (1+ row)))
-	     (t
-	      ;; Horizontal format
-	      ;; Next column to align to.
-	      (setq column (+ column
-			      ;; Round up to a whole number of columns.
-			      (* colwidth (ceiling length colwidth))))))))))))
+	  (if (< wwidth (+ column (max colwidth
+                                       (if (consp str)
+                                           (apply #'+ (mapcar #'string-width str))
+                                         (string-width str)))))
+	      ;; No space for `str' at point, move to next line.
+	      (progn (insert "\n") (setq column 0))
+	    (insert " \t")
+	    ;; Leave the space unpropertized so that in the case we're
+	    ;; already past the goal column, there is still
+	    ;; a space displayed.
+	    (set-text-properties (1- (point)) (point)
+				 ;; We can set tab-width using
+				 ;; completion-tab-width, but
+				 ;; the caller can prefer using
+				 ;; \t to align prefixes.
+				 `(display (space :align-to ,column)))
+	    nil))
+        (setq first nil)
+        (completion--insert str group-fun)
+	;; Next column to align to.
+	(setq column (+ column
+			;; Round up to a whole number of columns.
+			(* colwidth (ceiling length colwidth))))))))
+
+(defun completion--insert-vertical (strings group-fun
+                                            _length _wwidth
+                                            colwidth columns)
+  (let ((column 0)
+        (rows (/ (length strings) columns))
+	(row 0)
+	(last-title nil)
+	(last-string nil)
+        (start-point (point))
+        (next 0) (pos 0))
+    (dolist (str strings)
+      (unless (equal last-string str) ; Remove (consecutive) duplicates.
+	(setq last-string str)
+	(when (> row rows)
+	  (goto-char start-point)
+	  (setq row 0 column (+ column colwidth)))
+        (when group-fun
+          (let ((title (funcall group-fun (if (consp str) (car str) str) nil)))
+            (unless (equal title last-title)
+              (setq last-title title)
+              (when title
+                ;; Align before title insertion
+	        (when (> column 0)
+	          (end-of-line)
+	          (while (> (current-column) column)
+	            (if (eobp)
+		        (insert "\n")
+	              (forward-line 1)
+	              (end-of-line)))
+	          (insert " \t")
+	          (set-text-properties (1- (point)) (point)
+			               `(display (space :align-to ,column))))
+                (let* ((fmt completions-group-format)
+                       (len (length fmt)))
+                  ;; Adjust display space for columns
+                  (when (equal (get-text-property (- len 1) 'display fmt) '(space :align-to right))
+                    (setq fmt (substring fmt))
+                    (put-text-property (- len 1) len
+                                       'display
+                                       `(space :align-to ,(+ colwidth column -1))
+                                       fmt))
+                  (insert (format fmt title)))
+                ;; Align after title insertion
+	        (if (> column 0)
+	            (forward-line)
+	          (insert "\n"))))))
+        ;; Align before candidate insertion
+	(when (> column 0)
+	  (end-of-line)
+	  (while (> (current-column) column)
+	    (if (eobp)
+		(insert "\n")
+	      (forward-line 1)
+	      (end-of-line)))
+	  (insert " \t")
+	  (set-text-properties (1- (point)) (point)
+			       `(display (space :align-to ,column))))
+        (completion--insert str group-fun)
+        ;; Align after candidate insertion
+	(if (> column 0)
+	    (forward-line)
+	  (insert "\n"))
+	(setq row (1+ row))))))
+
+(defun completion--insert-one-column (strings group-fun &rest _)
+  (let ((last-title nil) (last-string nil))
+    (dolist (str strings)
+      (unless (equal last-string str) ; Remove (consecutive) duplicates.
+	(setq last-string str)
+        (when group-fun
+          (let ((title (funcall group-fun (if (consp str) (car str) str) nil)))
+            (unless (equal title last-title)
+              (setq last-title title)
+              (when title
+                (insert (format completions-group-format title) "\n")))))
+        (completion--insert str group-fun)
+        (insert "\n")))))
+
+(defun completion--insert (str group-fun)
+  (if (not (consp str))
+      (add-text-properties
+       (point)
+       (progn
+         (insert
+          (if group-fun
+              (funcall group-fun str 'transform)
+            str))
+         (point))
+       `(mouse-face highlight completion--string ,str))
+    ;; If `str' is a list that has 2 elements,
+    ;; then the second element is a suffix annotation.
+    ;; If `str' has 3 elements, then the second element
+    ;; is a prefix, and the third element is a suffix.
+    (let* ((prefix (when (nth 2 str) (nth 1 str)))
+           (suffix (or (nth 2 str) (nth 1 str))))
+      (when prefix
+        (let ((beg (point))
+              (end (progn (insert prefix) (point))))
+          (put-text-property beg end 'mouse-face nil)))
+      (completion--insert (car str) group-fun)
+      (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 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))))))
 
 (defvar completion-setup-hook nil
   "Normal hook run at the end of setting up a completion list buffer.
-- 
2.20.1


[-- Attachment #4: 0003-minibuffer-completion-help-Do-not-check-completions-.patch --]
[-- Type: text/x-diff, Size: 1378 bytes --]

From 2f6decb2f0d0f1f1c6b057314b2c90f596830e22 Mon Sep 17 00:00:00 2001
From: Daniel Mendler <mail@daniel-mendler.de>
Date: Sun, 2 May 2021 15:50:08 +0200
Subject: [PATCH 3/4] (minibuffer-completion-help): Do not check
 `completions-group` centrally

The guard variable `completions-group` should be checked in each
completion table individually. The guard variable
`completions-detailed` variable is used in the same way.

* minibuffer.el (minibuffer-completion-help): Remove check of
  `completions-group`.
---
 lisp/minibuffer.el | 3 +--
 1 file changed, 1 insertion(+), 2 deletions(-)

diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index cf1a4350bd..b743b2bd40 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -2178,8 +2178,7 @@ minibuffer-completion-help
                           (plist-get completion-extra-properties
                                      :affixation-function)))
              (sort-fun (completion-metadata-get all-md 'display-sort-function))
-             (group-fun (and completions-group
-                             (completion-metadata-get all-md 'group-function)))
+             (group-fun (completion-metadata-get all-md 'group-function))
              (mainbuf (current-buffer))
              ;; If the *Completions* buffer is shown in a new
              ;; window, mark it as softly-dedicated, so bury-buffer in
-- 
2.20.1


[-- Attachment #5: 0004-completion-insert-vertical-Separate-groups-completel.patch --]
[-- Type: text/x-diff, Size: 5061 bytes --]

From 9c9850de654c60b000fe3be4365b1bd261bf4f21 Mon Sep 17 00:00:00 2001
From: Daniel Mendler <mail@daniel-mendler.de>
Date: Sun, 2 May 2021 16:19:42 +0200
Subject: [PATCH 4/4] (completion--insert-vertical): Separate groups completely

Insert the candidates vertically within the groups, but keep the
groups completely separate using the full width group separators.

* minibuffer.el (completion--insert-vertical): Adjust grouping.
---
 lisp/minibuffer.el | 108 ++++++++++++++++++++-------------------------
 1 file changed, 48 insertions(+), 60 deletions(-)

diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index b743b2bd40..73a38a8137 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -1866,66 +1866,54 @@ completion--insert-horizontal
 (defun completion--insert-vertical (strings group-fun
                                             _length _wwidth
                                             colwidth columns)
-  (let ((column 0)
-        (rows (/ (length strings) columns))
-	(row 0)
-	(last-title nil)
-	(last-string nil)
-        (start-point (point))
-        (next 0) (pos 0))
-    (dolist (str strings)
-      (unless (equal last-string str) ; Remove (consecutive) duplicates.
-	(setq last-string str)
-	(when (> row rows)
-	  (goto-char start-point)
-	  (setq row 0 column (+ column colwidth)))
-        (when group-fun
-          (let ((title (funcall group-fun (if (consp str) (car str) str) nil)))
-            (unless (equal title last-title)
-              (setq last-title title)
-              (when title
-                ;; Align before title insertion
-	        (when (> column 0)
-	          (end-of-line)
-	          (while (> (current-column) column)
-	            (if (eobp)
-		        (insert "\n")
-	              (forward-line 1)
-	              (end-of-line)))
-	          (insert " \t")
-	          (set-text-properties (1- (point)) (point)
-			               `(display (space :align-to ,column))))
-                (let* ((fmt completions-group-format)
-                       (len (length fmt)))
-                  ;; Adjust display space for columns
-                  (when (equal (get-text-property (- len 1) 'display fmt) '(space :align-to right))
-                    (setq fmt (substring fmt))
-                    (put-text-property (- len 1) len
-                                       'display
-                                       `(space :align-to ,(+ colwidth column -1))
-                                       fmt))
-                  (insert (format fmt title)))
-                ;; Align after title insertion
-	        (if (> column 0)
-	            (forward-line)
-	          (insert "\n"))))))
-        ;; Align before candidate insertion
-	(when (> column 0)
-	  (end-of-line)
-	  (while (> (current-column) column)
-	    (if (eobp)
-		(insert "\n")
-	      (forward-line 1)
-	      (end-of-line)))
-	  (insert " \t")
-	  (set-text-properties (1- (point)) (point)
-			       `(display (space :align-to ,column))))
-        (completion--insert str group-fun)
-        ;; Align after candidate insertion
-	(if (> column 0)
-	    (forward-line)
-	  (insert "\n"))
-	(setq row (1+ row))))))
+  (while strings
+    (let ((group nil)
+          (column 0)
+	  (row 0)
+          (rows)
+          (last-string nil))
+      (if group-fun
+          (let* ((str (car strings))
+                 (title (funcall group-fun (if (consp str) (car str) str) nil)))
+            (while (and strings
+                        (equal title (funcall group-fun
+                                              (if (consp (car strings))
+                                                  (car (car strings))
+                                                (car strings))
+                                              nil)))
+              (push (car strings) group)
+              (pop strings))
+            (setq group (nreverse group)))
+        (setq group strings
+              strings nil))
+      (setq rows (/ (length group) columns))
+      (when group-fun
+        (let* ((str (car group))
+               (title (funcall group-fun (if (consp str) (car str) str) nil)))
+          (when title
+            (goto-char (point-max))
+            (insert (format completions-group-format title) "\n"))))
+      (dolist (str group)
+        (unless (equal last-string str) ; Remove (consecutive) duplicates.
+	  (setq last-string str)
+	  (when (> row rows)
+            (forward-line (- -1 rows))
+	    (setq row 0 column (+ column colwidth)))
+	  (when (> column 0)
+	    (end-of-line)
+	    (while (> (current-column) column)
+	      (if (eobp)
+		  (insert "\n")
+	        (forward-line 1)
+	        (end-of-line)))
+	    (insert " \t")
+	    (set-text-properties (1- (point)) (point)
+			         `(display (space :align-to ,column))))
+          (completion--insert str group-fun)
+	  (if (> column 0)
+	      (forward-line)
+	    (insert "\n"))
+	  (setq row (1+ row)))))))
 
 (defun completion--insert-one-column (strings group-fun &rest _)
   (let ((last-title nil) (last-string nil))
-- 
2.20.1

Re: [PATCH] `completing-read`: Add `group-function` support to completion metadata (REVISED PATCH VERSION 3)

[Juri Linkov]

[-- Attachment #1: Type: text/plain, Size: 774 bytes --]

> I attached a revised version of the `group-function` for
> `completing-read` patches, implementing the suggestions by Juri Linkov.
>
> 1. The guard variable `completions-group` is not checked centrally, like
> `completions-detailed`.
> 2. The vertical completions format separates the groups completely using
> full-width group separators, instead of inserting the titles within the
> vertical flow.

Thanks!  Now separating the groups completely using full-width group separators
for the vertical format allows enabling outline-minor-mode and using
TAB/S-TAB keys to hide groups for better overview in a large buffer.

I tried (setq outline-regexp " ") to match the space character
at the beginning of group titles to find outline headers,
and the result is quite nice:


[-- Attachment #2: completion-groups.png --]
[-- Type: image/png, Size: 24941 bytes --]

Re: [PATCH] `completing-read`: Add `group-function` support to completion metadata (REVISED PATCH VERSION 3)

[Daniel Mendler]

On 5/2/21 11:49 PM, Juri Linkov wrote:
> Thanks!  Now separating the groups completely using full-width group separators
> for the vertical format allows enabling outline-minor-mode and using
> TAB/S-TAB keys to hide groups for better overview in a large buffer.
> 
> I tried (setq outline-regexp " ") to match the space character
> at the beginning of group titles to find outline headers,
> and the result is quite nice:

Thanks! That's a nice advantage of the layout you proposed. In case one
wants to use outlines it may be better to configure the group titles a
bit differently, such that the outline regexp is less likely to give
false postives.

(setq outline-regexp "###")
(setq completions-group-format
      (concat
       (propertize "###" 'invisible t)
       (propertize "    " 'face 'completions-group-separator)
       (propertize " %s " 'face 'completions-group-title)
       (propertize " " 'face 'completions-group-separator
                   'display '(space :align-to right))))

Daniel