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

From: [email-masked]
Date: Tue, 04 Mar 2025 17:33:06 +0000 (UTC)

Any further thoughts about this patch?

I have an updated version which is even more efficient: we now throw a
continuation instead of a symbol, and call that continuation to insert
the remaining completions.  That means the initial completions which are
already inserted in the buffer don't need to be deleted and reinserted.
Happily, this is also less code.

>From ccc9687291c29e6fe9829502c560d04d1644428c Mon Sep 17 00:00:00 2001
From: Spencer Baugh <[email-masked]>
Date: Sun, 16 Feb 2025 20:16:19 -0500
Subject: [PATCH] Lazily highlight and insert candidates in *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.

However, rendering all the completion candidates is unnecessary if
the *Completions* window is never scrolled to see those candiates.  By
eagerly inserting only some candidates and lazily highlighting and
inserting the remaining candidates only when necessary, performance is
much improved.

* lisp/minibuffer.el (completion--insert-strings): Insert
completions lazily. (bug#74561)
(completions--lazy-insert-button): Add.
(completion--insert-horizontal, completion--insert-one-column):
Throw a continuation when enough lines of completions are
inserted.
(completion--insert-vertical): Add ignored lines argument.
(minibuffer-completion-help): Set completion-lazy-hilit.
(with-minibuffer-completions-window): Call
completion--lazy-insert-strings.
(with-minibuffer-completions-window):
* lisp/simple.el (completion-setup-function): Preserve
buffer-locals required for lazy completion insertion.
(switch-to-completions): Call completion--lazy-insert-strings.
* etc/NEWS: Announce.
---
 etc/NEWS           | 10 ++++++
 lisp/minibuffer.el | 77 +++++++++++++++++++++++++++++++++++++---------
 lisp/simple.el     |  5 ++-
 3 files changed, 77 insertions(+), 15 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index 39c62756085..6b030c9fdb6 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -189,6 +189,16 @@ will still be on that candidate after "*Completions*" is updated with a
 new list of completions.  The candidate is automatically deselected when
 the "*Completions*" buffer is hidden.
 
+---
+*** "*Completions*" is displayed faster with many completion candidates.
+As always, if there are more completion candidates than can be displayed
+in the current frame, only a subset of the candidates is displayed.
+This process is now faster: only that subset of the candidates is
+actually inserted into "*Completions*" until you run a command which
+interacts with the text of the "*Completions*" buffer.  This
+optimization only applies when 'completions-format' is 'horizontal' or
+'one-column'.
+
 ---
 *** New user option 'crm-prompt' for 'completing-read-multiple'.
 This option configures the prompt format of 'completing-read-multiple'.
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index b0ca0a2ece8..5cc9f6221e6 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -2232,6 +2232,8 @@ completions-header-format
                  (string :tag "Format string for heading line"))
   :version "29.1")
 
+(defvar-local completions--lazy-insert-button nil)
+
 (defun completion--insert-strings (strings &optional group-fun)
   "Insert a list of STRINGS into the current buffer.
 The candidate strings are inserted into the buffer depending on the
@@ -2253,23 +2255,50 @@ 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)))
+	   (colwidth (/ wwidth columns))
+	   (lines (if completions-max-height 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
         ;; when the caller uses tabs inside prefix.
         (setq colwidth (- colwidth (mod colwidth completion-tab-width))))
-      (funcall (intern (format "completion--insert-%s" completions-format))
-               strings group-fun length wwidth colwidth columns))))
+      (let ((completions-continuation
+             (catch 'completions-truncated
+               (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))
+          (button-put completions--lazy-insert-button
+                      'completions-continuation completions-continuation))))))
+
+(defun completion--lazy-insert-strings (&optional button)
+  (setq button (or button completions--lazy-insert-button))
+  (when button
+    (let ((completion-lazy-hilit t)
+          (standard-output (current-buffer))
+          (inhibit-read-only t)
+          (completions-continuation (button-get button 'completions-continuation)))
+      (save-excursion
+        (goto-char (button-start button))
+        (delete-region (point) (button-end button))
+        (setq-local completions--lazy-insert-button nil)
+        (funcall completions-continuation)))))
 
 (defun completion--insert-horizontal (strings group-fun
                                               length wwidth
-                                              colwidth _columns)
+                                              colwidth _columns lines
+                                              &optional last-title)
   (let ((column 0)
         (first t)
-	(last-title nil)
-        (last-string nil))
-    (dolist (str strings)
+        (last-string nil)
+        str)
+    (while strings
+      (setq str (pop strings))
       (unless (equal last-string str) ; Remove (consecutive) duplicates.
 	(setq last-string str)
         (when group-fun
@@ -2288,7 +2317,16 @@ completion--insert-horizontal
                                            (apply #'+ (mapcar #'string-width str))
                                          (string-width str)))))
 	      ;; No space for `str' at point, move to next line.
-	      (progn (insert "\n") (setq column 0))
+	      (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)))
+                (setq column 0))
 	    (insert " \t")
 	    ;; Leave the space unpropertized so that in the case we're
 	    ;; already past the goal column, there is still
@@ -2309,7 +2347,7 @@ completion--insert-horizontal
 
 (defun completion--insert-vertical (strings group-fun
                                             _length _wwidth
-                                            colwidth columns)
+                                            colwidth columns _lines)
   (while strings
     (let ((group nil)
           (column 0)
@@ -2359,9 +2397,12 @@ completion--insert-vertical
 	    (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)
+(defun completion--insert-one-column (strings group-fun _length _wwidth _colwidth _columns lines
+                                              &optional last-title)
+  (let ((last-string nil)
+        str)
+    (while strings
+      (setq str (pop strings))
       (unless (equal last-string str) ; Remove (consecutive) duplicates.
 	(setq last-string str)
         (when group-fun
@@ -2371,14 +2412,20 @@ completion--insert-one-column
               (when title
                 (insert (format completions-group-format title) "\n")))))
         (completion--insert str group-fun)
-        (insert "\n")))
+        (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)))))
     (delete-char -1)))
 
 (defun completion--insert (str group-fun)
   (if (not (consp str))
       (add-text-properties
        (point)
-       (progn
+       (let ((str (completion-lazy-hilit str)))
          (insert
           (if group-fun
               (funcall group-fun str 'transform)
@@ -2622,6 +2669,7 @@ minibuffer-completion-help
          (end (or end (point-max)))
          (string (buffer-substring start end))
          (md (completion--field-metadata start))
+         (completion-lazy-hilit t)
          (completions (completion-all-completions
                        string
                        minibuffer-completion-table
@@ -4965,6 +5013,7 @@ with-minibuffer-completions-window
                             (get-buffer-window "*Completions*" 0)))))
      (when window
        (with-selected-window window
+         (completion--lazy-insert-strings)
          ,@body))))
 
 (defcustom minibuffer-completion-auto-choose t
diff --git a/lisp/simple.el b/lisp/simple.el
index 2d36062e9c2..12dac272129 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -10456,10 +10456,12 @@ completion-setup-function
                 (buffer-substring (minibuffer-prompt-end) (point)))))))
     (with-current-buffer standard-output
       (let ((base-position completion-base-position)
-            (insert-fun completion-list-insert-choice-function))
+            (insert-fun completion-list-insert-choice-function)
+            (lazy-button completions--lazy-insert-button))
         (completion-list-mode)
         (when completions-highlight-face
           (setq-local cursor-face-highlight-nonselected-window t))
+        (setq-local completions--lazy-insert-button lazy-button)
         (setq-local completion-base-position base-position)
         (setq-local completion-list-insert-choice-function insert-fun))
       (setq-local completion-reference-buffer mainbuf)
@@ -10505,6 +10507,7 @@ switch-to-completions
                           (progn (minibuffer-completion-help)
                                  (get-buffer-window "*Completions*" 0)))))
     (select-window window)
+    (completion--lazy-insert-strings)
     (when (bobp)
       (cond
        ((and (memq this-command '(completion-at-point minibuffer-complete))
-- 
2.44.0