Subject: bug#74561: closed (Re: bug#74561: [PATCH] Allow limiting the size of *Completions*)

From: [email-masked] (GNU bug Tracking System)
Date: Fri, 21 Mar 2025 21:27:02 +0000

Your bug report

#74561: [PATCH] Allow limiting the size of *Completions*

which was filed against the emacs package, has been closed.

The explanation is attached below, along with your original report.
If you require more details, please reply to [email-masked].

-- 
74561: https://debbugs.gnu.org/cgi/bugreport.cgi?bug=74561
GNU Bug Tracking System
Contact [email-masked] with problems

Subject: Re: bug#74561: [PATCH] Allow limiting the size of *Completions*
From: Stefan Monnier <[email-masked]>
To: Spencer Baugh <[email-masked]>
Cc: [email-masked], [email-masked], [email-masked], [email-masked], [email-masked], Eli Zaretskii <[email-masked]>, Stefan Kangas <[email-masked]>
Date: Fri, 21 Mar 2025 17:26:06 -0400
List-Id: <debbugs-submit.debbugs.gnu.org>

>>> Any further thoughts about this patch?
>> LGTM,
> Could someone please install this change, then?  (I can't do it myself)

Pushed with the additional patch below.

        Stefan
commit b21636580bed822bd9fb8bb84014311fa9b4c071
Author: Spencer Baugh <[email-masked]>
Date:   Fri Mar 21 17:24:50 2025 -0400

    minibuffer.el: Fix warnings and coding style in last change
    
    * lisp/minibuffer.el: Cut lines to fit into 80 columns.
    (completion--insert-strings): Simplify `if` to `or`.
    (completion--insert-horizontal, completion--insert-one-column):
    Fix warning about used var starting with `_`.  Avoid `apply-partially`.

diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 47b152ed35d..8fba0b88b20 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -2256,7 +2256,7 @@ completion--insert-strings
 		     ;; Windows can't show less than 3 lines anyway.
 		     (max 1 (/ (length strings) 2))))
 	   (colwidth (/ wwidth columns))
-	   (lines (if completions-max-height completions-max-height (frame-height))))
+	   (lines (or completions-max-height (frame-height))))
       (unless (or tab-stop-list (null completion-tab-width)
                   (zerop (mod colwidth completion-tab-width)))
         ;; Align to tab positions for the case
@@ -2264,15 +2264,17 @@ completion--insert-strings
         (setq colwidth (- colwidth (mod colwidth completion-tab-width))))
       (let ((completions-continuation
              (catch 'completions-truncated
-               (funcall (intern (format "completion--insert-%s" completions-format))
+               (funcall (intern (format "completion--insert-%s"
+                                        completions-format))
                         strings group-fun length wwidth colwidth columns lines)
                nil)))
         (when completions-continuation
           ;; If there's a bug which causes us to not insert the remaining
           ;; completions automatically, the user can at least press this button.
           (setq-local completions--lazy-insert-button
-                      (insert-button "[Completions truncated, click here to insert the rest.]"
-                                     'action #'completion--lazy-insert-strings))
+                      (insert-button
+                       "[Completions truncated, click here to insert the rest.]"
+                       'action #'completion--lazy-insert-strings))
           (button-put completions--lazy-insert-button
                       'completions-continuation completions-continuation))))))
 
@@ -2282,7 +2284,8 @@ completion--lazy-insert-strings
     (let ((completion-lazy-hilit t)
           (standard-output (current-buffer))
           (inhibit-read-only t)
-          (completions-continuation (button-get button 'completions-continuation)))
+          (completions-continuation
+           (button-get button 'completions-continuation)))
       (save-excursion
         (goto-char (button-start button))
         (delete-region (point) (button-end button))
@@ -2291,7 +2294,7 @@ completion--lazy-insert-strings
 
 (defun completion--insert-horizontal (strings group-fun
                                               length wwidth
-                                              colwidth _columns lines
+                                              colwidth columns lines
                                               &optional last-title)
   (let ((column 0)
         (first t)
@@ -2306,26 +2309,28 @@ completion--insert-horizontal
             (unless (equal title last-title)
               (setq last-title title)
               (when title
-                (insert (if first "" "\n") (format completions-group-format title) "\n")
+               (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.
-	  (if (< wwidth (+ column (max colwidth
-                                       (if (consp str)
-                                           (apply #'+ (mapcar #'string-width str))
-                                         (string-width str)))))
+	  (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")
                 (when (and lines (> (line-number-at-pos) lines))
                   (throw 'completions-truncated
-                         (apply-partially
-                          #'completion--insert-horizontal
-                          ;; Add str back, since we haven't inserted it yet.
-                          (cons str strings) group-fun length wwidth colwidth _columns nil
-                          last-title)))
+                         (lambda ()
+                           (completion--insert-horizontal
+                            ;; Add str back, since we haven't inserted it yet.
+                            (cons str strings) group-fun length wwidth colwidth
+                            columns nil last-title))))
                 (setq column 0))
 	    (insert " \t")
 	    ;; Leave the space unpropertized so that in the case we're
@@ -2397,8 +2402,8 @@ completion--insert-vertical
 	    (insert "\n"))
 	  (setq row (1+ row)))))))
 
-(defun completion--insert-one-column (strings group-fun _length _wwidth _colwidth _columns lines
-                                              &optional last-title)
+(defun completion--insert-one-column ( strings group-fun length wwidth colwidth
+                                       columns lines &optional last-title)
   (let ((last-string nil)
         str)
     (while strings
@@ -2415,10 +2420,10 @@ completion--insert-one-column
         (insert "\n")
         (when (and lines (> (line-number-at-pos) lines))
           (throw 'completions-truncated
-                 (apply-partially
-                  #'completion--insert-one-column
-                  strings group-fun _length _wwidth _colwidth _columns nil
-                  last-title)))))
+                 (lambda ()
+                   (completion--insert-one-column
+                    strings group-fun length wwidth colwidth columns nil
+                    last-title))))))
     (delete-char -1)))
 
 (defun completion--insert (str group-fun)

Subject: [PATCH] Allow limiting the size of *Completions*
From: Spencer Baugh <[email-masked]>
To: [email-masked]
Cc: [email-masked], [email-masked]
Date: Wed, 27 Nov 2024 15:25:19 -0500
List-Id: <debbugs-submit.debbugs.gnu.org>

Tags: patch

>From profiling, the main bottleneck in completion over large
completion sets is display-completion-list, when there are many
available candidates.  For example, in my large monorepo, when
completing over the 589196 files or the 73897 branches, even with the
candidates narrowed down by typing some prefix to complete, TAB (when
it shows *Completions*) or ? is slow, mostly in
display-completion-list.

By adding completions-list-max with a very large default, performance
is greatly improved in these situations without impacting the normal
case of completion on reasonably sized sets.

Limiting the work done by display-completion-list is also important
for packages which auto-update *Completions* inside while-no-input:
since display-completion-list doesn't do anything which reads input,
while-no-input won't interrupt it.  Such packages can instead just
bind completions-list-max to a smaller value.

* lisp/minibuffer.el (display-completion-list): Add FULL-COUNT
argument.
(completions-list-max): Add.
(minibuffer-completion-help): Truncate completions based on
completions-list-max.

In GNU Emacs 29.2.50 (build 9, x86_64-pc-linux-gnu, X toolkit, cairo
 version 1.15.12, Xaw scroll bars) of 2024-11-20 built on
 igm-qws-u22796a
Repository revision: 28dc0b6f9987e0def7dff4deaa23aa60f021d2a7
Repository branch: emacs-29
Windowing system distributor 'The X.Org Foundation', version 11.0.12011000
System Description: Rocky Linux 8.10 (Green Obsidian)

Configured using:
 'configure --with-x-toolkit=lucid --without-gpm --without-gconf
 --without-selinux --without-imagemagick --with-modules --with-gif=no
 --with-tree-sitter --with-native-compilation=aot
 PKG_CONFIG_PATH=/usr/local/home/garnish/libtree-sitter/0.22.6-1/lib/pkgconfig/'

>From 808b1a6d01fcd2d2cc03324aa9826b3160047653 Mon Sep 17 00:00:00 2001
From: Spencer Baugh <[email-masked]>
Date: Thu, 14 Nov 2024 17:14:10 -0500
Subject: [PATCH] Allow limiting the size of *Completions*

>From profiling, the main bottleneck in completion over large
completion sets is display-completion-list, when there are many
available candidates.  For example, in my large monorepo, when
completing over the 589196 files or the 73897 branches, even with the
candidates narrowed down by typing some prefix to complete, TAB (when
it shows *Completions*) or ? is slow, mostly in
display-completion-list.

By adding completions-list-max with a very large default, performance
is greatly improved in these situations without impacting the normal
case of completion on reasonably sized sets.

Limiting the work done by display-completion-list is also important
for packages which auto-update *Completions* inside while-no-input:
since display-completion-list doesn't do anything which reads input,
while-no-input won't interrupt it.  Such packages can instead just
bind completions-list-max to a smaller value.

* lisp/minibuffer.el (display-completion-list): Add FULL-COUNT
argument.
(completions-list-max): Add.
(minibuffer-completion-help): Truncate completions based on
completions-list-max.
---
 lisp/minibuffer.el | 38 +++++++++++++++++++++++++++++++-------
 1 file changed, 31 insertions(+), 7 deletions(-)

diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 5d11064d900..8078e1603ae 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -2354,7 +2354,7 @@ completion-hilit-commonality
         completions)
        base-size))))
 
-(defun display-completion-list (completions &optional common-substring group-fun)
+(defun display-completion-list (completions &optional common-substring group-fun full-count)
   "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.
@@ -2366,7 +2366,9 @@ display-completion-list
 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."
+candidates.
+If FULL-COUNT is non-nil, it's used as the total number of
+completions."
   (declare (advertised-calling-convention (completions) "24.4"))
   (if common-substring
       (setq completions (completion-hilit-commonality
@@ -2379,17 +2381,24 @@ 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 group-fun)))
+	    (display-completion-list completions common-substring group-fun full-count)))
 	(princ (buffer-string)))
 
     (with-current-buffer standard-output
       (goto-char (point-max))
       (if completions-header-format
-          (insert (format completions-header-format (length completions)))
+          (insert (format completions-header-format (or full-count (length completions))))
         (unless completion-show-help
           ;; Ensure beginning-of-buffer isn't a completion.
           (insert (propertize "\n" 'face '(:height 0)))))
-      (completion--insert-strings completions group-fun)))
+      (completion--insert-strings completions group-fun)
+      (when (and full-count (/= full-count (length completions)))
+        (newline)
+        (insert (propertize
+                 (format "Displaying %s of %s possible completions.\n"
+                         (length completions) full-count)
+                 'face
+                 'shadow)))))
 
   (run-hooks 'completion-setup-hook)
   nil)
@@ -2455,6 +2464,15 @@ completions--fit-window-to-buffer
         (resize-temp-buffer-window win))
     (fit-window-to-buffer win completions-max-height)))
 
+(defcustom completions-list-max 10000
+  "Maximum number of completions for `minibuffer-completion-help' to list.
+
+After the completions are sorted, any beyond this amount are
+discarded and a message about truncation is inserted.  This can
+improve performance when displaying large numbers of completions."
+  :type 'number
+  :version "31.1")
+
 (defcustom completion-auto-deselect t
   "If non-nil, deselect current completion candidate when you type in minibuffer.
 
@@ -2554,7 +2572,8 @@ minibuffer-completion-help
              ;; window, mark it as softly-dedicated, so bury-buffer in
              ;; minibuffer-hide-completions will know whether to
              ;; delete the window or not.
-             (display-buffer-mark-dedicated 'soft))
+             (display-buffer-mark-dedicated 'soft)
+             full-count)
         (with-current-buffer-window
           "*Completions*"
           ;; This is a copy of `display-buffer-fallback-action'
@@ -2610,6 +2629,11 @@ minibuffer-completion-help
                                  (_ completions-group-sort))
                                completions)))
 
+                      (when completions-list-max
+                        (setq full-count (length completions))
+                        (when (< completions-list-max full-count)
+                          (setq completions (take completions-list-max completions))))
+
                       (cond
                        (aff-fun
                         (setq completions
@@ -2661,7 +2685,7 @@ minibuffer-completion-help
                                                      (if (eq (car bounds) (length result))
                                                          'exact 'finished))))))
 
-                      (display-completion-list completions nil group-fun)
+                      (display-completion-list completions nil group-fun full-count)
                       (when current-candidate-and-offset
                         (with-current-buffer standard-output
                           (when-let* ((match (text-property-search-forward
-- 
2.39.3