>From 4f66c9d60573f221ead94a052ef65b699c530741 Mon Sep 17 00:00:00 2001 From: Daniel Mendler 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