From ea73fd467a91bc0c23c18a213ffbb1a96525450d Mon Sep 17 00:00:00 2001 From: Eshel Yaron Date: Mon, 19 Feb 2024 09:43:35 +0100 Subject: [PATCH] ; Simplify 'display-completion-list' * lisp/minibuffer.el (display-completion-list): Remove obsolete argument COMMON-SUBSTRING. (completion--insert-strings): Improve docstring. (minibuffer-completion-help): Adjust. * etc/NEWS: Announce it. * doc/lispref/minibuf.texi (Programmed Completion): Add anchor for the definition of completions grouping functions. (Completion Commands): Document GROUP-FUN argument of 'display-completion-list'. --- doc/lispref/minibuf.texi | 6 ++- etc/NEWS | 5 ++ lisp/minibuffer.el | 103 +++++++++++++++++---------------------- 3 files changed, 56 insertions(+), 58 deletions(-) diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi index 971acd8a894..3ae13f0b05a 100644 --- a/doc/lispref/minibuf.texi +++ b/doc/lispref/minibuf.texi @@ -1358,7 +1358,7 @@ current minibuffer. It works by setting the local value of @code{completion-local-styles}. @xref{Completion Variables}. @end deffn -@defun display-completion-list completions +@defun display-completion-list completions group-fun This function displays @var{completions} to the stream in @code{standard-output}, usually a buffer. (@xref{Read and Print}, for more information about streams.) The argument @var{completions} is normally @@ -1369,6 +1369,9 @@ which is printed as if the strings were concatenated. The first of the two strings is the actual completion, the second string serves as annotation. +The optional argument @var{group-fun} is a completions grouping +function, @ref{Completions grouping function}. + This function is called by @code{minibuffer-completion-help}. A common way to use it is together with @code{with-output-to-temp-buffer}, like this: @@ -2140,6 +2143,7 @@ a suffix displayed after the completion string. This function takes priority over @code{annotation-function}. @cindex @code{group-function}, in completion +@anchor{Completions grouping 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 diff --git a/etc/NEWS b/etc/NEWS index f37d9e67302..4e6476d5907 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1695,6 +1695,11 @@ from which you are switching. You can check for this variable in your 'read-buffer-function' to determine if the caller intends to switch to the buffer that this function reads. +--- +** New 'display-completion-list' optional argument for grouping completions. +'display-completion-list' now takes an optional argument GROUP-FUN that +controls grouping of displayed completions. + +++ ** New buffer-local variable 'undo-inhibit-region'. Lisp code can set this to non-nil to tell the next 'undo' command to diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 49efb36908f..78734ea71bc 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -2312,8 +2312,10 @@ If this option is nil, no heading line is shown." "Insert a list of STRINGS into the current buffer. 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." +Runs of equal candidate strings are eliminated. + +Optional argument GROUP-FUN, if non-nil, is a completions grouping +function as described in the documentation of `completion-metadata'." (when (consp strings) (let* ((length (apply #'max (mapcar (lambda (s) @@ -2603,7 +2605,7 @@ when you select this sort order." :version "30.1" :type 'boolean) -(defun display-completion-list (completions &optional common-substring group-fun) +(defun display-completion-list (completions &optional 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. @@ -2614,59 +2616,46 @@ 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'. -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 - completions (length common-substring) - ;; We don't know the base-size. - nil))) - (if (not (bufferp standard-output)) - ;; This *never* (ever) happens, so there's no point trying to be clever. - (with-temp-buffer - (let ((standard-output (current-buffer)) - (completion-setup-hook nil)) - (with-suppressed-warnings ((callargs display-completion-list)) - (display-completion-list completions common-substring group-fun))) - (princ (buffer-string))) - (let ((pred-desc - (if-let ((pd (minibuffer--completion-predicate-description))) - (concat ", " pd) - "")) - (sort-desc - (if minibuffer-completions-sort-function - (concat - (when-let - ((sd (nth 4 (seq-find - (lambda (order) - (eq - (nth 3 order) - (advice--cd*r - minibuffer-completions-sort-function))) - minibuffer-completions-sort-orders)))) - (concat ", " sd)) - (when (advice-function-member-p - #'reverse minibuffer-completions-sort-function) - ", reversed")) - "")) - (cat (if completion-category (format " %s" completion-category) ""))) - (with-current-buffer standard-output - (goto-char (point-max)) - (if completions-header-format - (let ((heading - (format-spec completions-header-format - (list (cons ?s (length completions)) - (cons ?t sort-desc) - (cons ?r pred-desc) - (cons ?c cat))))) - (add-face-text-property - 0 (length heading) 'completions-heading t heading) - (insert heading)) - (unless completion-show-help - ;; Ensure beginning-of-buffer isn't a completion. - (insert (propertize "\n" 'face '(:height 0))))) - (completion--insert-strings completions group-fun)))) + +Optional argument GROUP-FUN, if non-nil, is a completions grouping +function as described in the documentation of `completion-metadata'." + (let ((pred-desc + (if-let ((pd (minibuffer--completion-predicate-description))) + (concat ", " pd) + "")) + (sort-desc + (if minibuffer-completions-sort-function + (concat + (when-let + ((sd (nth 4 (seq-find + (lambda (order) + (eq + (nth 3 order) + (advice--cd*r + minibuffer-completions-sort-function))) + minibuffer-completions-sort-orders)))) + (concat ", " sd)) + (when (advice-function-member-p + #'reverse minibuffer-completions-sort-function) + ", reversed")) + "")) + (cat (if completion-category (format " %s" completion-category) ""))) + (with-current-buffer standard-output + (goto-char (point-max)) + (if completions-header-format + (let ((heading + (format-spec completions-header-format + (list (cons ?s (length completions)) + (cons ?t sort-desc) + (cons ?r pred-desc) + (cons ?c cat))))) + (add-face-text-property + 0 (length heading) 'completions-heading t heading) + (insert heading)) + (unless completion-show-help + ;; Ensure beginning-of-buffer isn't a completion. + (insert (propertize "\n" 'face '(:height 0))))) + (completion--insert-strings completions group-fun))) (run-hooks 'completion-setup-hook) nil) @@ -3099,7 +3088,7 @@ completions list." (if (eq (car bounds) (length result)) 'exact 'finished))))))) - (display-completion-list completions nil group-fun))))) + (display-completion-list completions group-fun))))) nil))) nil)) -- 2.39.5