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

@@ -185,6 +185,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'.

lisp/minibuffer.el

@@ -2232,6 +2232,8 @@ If this is nil, no heading line will be shown."
                  (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 @@ Runs of equal candidate strings are eliminated.  GROUP-FUN is a
 		     ;; 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 @@ Runs of equal candidate strings are eliminated.  GROUP-FUN is a
                                            (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 @@ Runs of equal candidate strings are eliminated.  GROUP-FUN is a
 
 (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 @@ Runs of equal candidate strings are eliminated.  GROUP-FUN is a
 	    (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 @@ Runs of equal candidate strings are eliminated.  GROUP-FUN is a
               (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 @@ The candidate will still be chosen by `choose-completion' unless
          (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
@@ -4966,6 +5014,7 @@ and execute the forms."
                             (get-buffer-window "*Completions*" 0)))))
      (when window
        (with-selected-window window
+         (completion--lazy-insert-strings)
          ,@body))))
 
 (defcustom minibuffer-completion-auto-choose t

lisp/simple.el

@@ -10473,10 +10473,12 @@ Called from `temp-buffer-show-hook'."
                 (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)
@@ -10522,6 +10524,7 @@ to move point between completions.\n\n")))))))
                           (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))