bug#74019: [PATCH] Optionally preserve selected candidate across *Completions* update

[Spencer Baugh via "Bug reports for GNU Emacs, the Swiss army knife of text editors" <bug-gnu-emacs@gnu.org>]

[-- Attachment #1: Type: text/plain, Size: 1568 bytes --]

Tags: patch


Add completion-preserve-selection, a defcustom which allows keeping the
same selected candidate after *Completions* is updated by
minibuffer-completion-help.

This works correctly with choose-completion-deselect-if-after: If point
is after a completion (such that choose-completion-deselect-if-after=t
means it won't be treated as selected), point will still be after that
completion after updating the list.

This feature is primarily motivated by the fact that some other
completion UIs (e.g. ido, vertico, etc) effectively have this behavior:
whenever they update the list of completions, they preserve whatever
candidate is selected.

Since the default UI doesn't (yet) have support for auto-updating the
list of completions, preserving the selected candidate is less
significant.  But it might be an interesting feature on its own, and
it's very non-invasive, so maybe we can turn it on by default.

In GNU Emacs 29.2.50 (build 5, x86_64-pc-linux-gnu, X toolkit, cairo
 version 1.15.12, Xaw scroll bars) of 2024-10-15 built on
 igm-qws-u22796a
Repository revision: 16a2e41014c6ea0f3cf268be8d37fe09aeac231e
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/'


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Optionally-preserve-selected-candidate-across-Comple.patch --]
[-- Type: text/patch, Size: 6939 bytes --]

From 7708bdbc0641c6468aba70662791d9dda043ff88 Mon Sep 17 00:00:00 2001
From: Spencer Baugh <sbaugh@janestreet.com>
Date: Fri, 25 Oct 2024 16:56:30 -0400
Subject: [PATCH] Optionally preserve selected candidate across *Completions*
 update

* lisp/minibuffer.el (completion-preserve-selection):
(minibuffer-completion-help):
(minibuffer-next-completion):
* lisp/simple.el (choose-completion):
(completion-setup-function):
---
 lisp/minibuffer.el | 29 +++++++++++++++++++++++++----
 lisp/simple.el     | 39 ++++++++++++++++++++++++---------------
 2 files changed, 49 insertions(+), 19 deletions(-)

diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 44d07557f48..a18f4330514 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -2538,6 +2538,16 @@ completions--fit-window-to-buffer
         (resize-temp-buffer-window win))
     (fit-window-to-buffer win completions-max-height)))
 
+(defcustom completion-preserve-selection nil
+  "If non-nil, `minibuffer-completion-help' preserves the selected completion candidate.
+
+If non-nil, and point is on a completion candidate in the displayed
+*Completions* window, `minibuffer-completion-help' will put point on the
+same candidate after updating *Completions*."
+  :type '(choice (const :tag "Updating *Completions* deselects any completion candidate" t)
+                 (const :tag "Candidates in *Completions* stay selected when the list is updated" nil))
+  :version "31.1")
+
 (defcustom completion-auto-deselect t
   "If non-nil, deselect current completion candidate when you type in minibuffer.
 
@@ -2624,6 +2634,12 @@ minibuffer-completion-help
              (sort-fun (completion-metadata-get all-md 'display-sort-function))
              (group-fun (completion-metadata-get all-md 'group-function))
              (mainbuf (current-buffer))
+             (current-candidate-and-offset
+              (when-let* ((window (get-buffer-window "*Completions*" 0)))
+                (with-selected-window window
+                  (when-let* ((beg (completions--start-of-candidate-at (point))))
+
+                    (cons (get-text-property beg 'completion--string) (- (point) beg))))))
              ;; If the *Completions* buffer is shown in a new
              ;; window, mark it as softly-dedicated, so bury-buffer in
              ;; minibuffer-hide-completions will know whether to
@@ -2647,7 +2663,7 @@ minibuffer-completion-help
             ,(when temp-buffer-resize-mode
                '(preserve-size . (nil . t)))
             (body-function
-             . ,#'(lambda (_window)
+             . ,#'(lambda (window)
                     (with-current-buffer mainbuf
                       (when completion-auto-deselect
                         (add-hook 'after-change-functions #'completions--after-change nil t))
@@ -2737,7 +2753,14 @@ 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)
+                      (when (and completion-preserve-selection current-candidate-and-offset)
+                        (with-current-buffer standard-output
+                          (when-let* ((match (text-property-search-forward
+                                              'completion--string (car current-candidate-and-offset) t)))
+                            (goto-char (prop-match-beginning match))
+                            (forward-char (cdr current-candidate-and-offset))
+                            (set-window-point window (point)))))))))
           nil)))
     nil))
 
@@ -4905,8 +4928,6 @@ minibuffer-next-completion
   (interactive "p")
   (let ((auto-choose minibuffer-completion-auto-choose))
     (with-minibuffer-completions-window
-      (when completions-highlight-face
-        (setq-local cursor-face-highlight-nonselected-window t))
       (if vertical
           (next-line-completion (or n 1))
         (next-completion (or n 1)))
diff --git a/lisp/simple.el b/lisp/simple.el
index 2ffd6e86e56..3a142ef14b3 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -10246,6 +10246,23 @@ choose-completion-deselect-if-after
 
 This makes `completions--deselect' effective.")
 
+(defun completions--start-of-candidate-at (position)
+  "Return the start position of the completion candidate at POSITION."
+  (save-excursion
+    (goto-char position)
+    (let (beg)
+      (cond
+       ((and (not (eobp))
+             (get-text-property (point) 'completion--string))
+        (setq beg (1+ (point))))
+       ((and (not (bobp))
+             (get-text-property (1- (point)) 'completion--string))
+        (setq beg (point))))
+      (when beg
+        (or (previous-single-property-change
+             beg 'completion--string)
+            beg)))))
+
 (defun choose-completion (&optional event no-exit no-quit)
   "Choose the completion at point.
 If EVENT, use EVENT's position to determine the starting position.
@@ -10269,21 +10286,11 @@ choose-completion
                (or (get-text-property (posn-point (event-start event))
                                       'completion--string)
                    (error "No completion here"))
-           (save-excursion
-             (goto-char (posn-point (event-start event)))
-             (let (beg)
-               (cond
-                ((and (not (eobp))
-                      (get-text-property (point) 'completion--string))
-                 (setq beg (1+ (point))))
-                ((and (not (bobp))
-                      (get-text-property (1- (point)) 'completion--string))
-                 (setq beg (point)))
-                (t (error "No completion here")))
-               (setq beg (or (previous-single-property-change
-                              beg 'completion--string)
-                             beg))
-               (get-text-property beg 'completion--string))))))
+             (if-let* ((candidate-start
+                        (completions--start-of-candidate-at
+                         (posn-point (event-start event)))))
+                 (get-text-property candidate-start 'completion--string)
+               (error "No completion here")))))
 
       (unless (buffer-live-p buffer)
         (error "Destination buffer is dead"))
@@ -10451,6 +10458,8 @@ completion-setup-function
       (let ((base-position completion-base-position)
             (insert-fun completion-list-insert-choice-function))
         (completion-list-mode)
+        (when completions-highlight-face
+          (setq-local cursor-face-highlight-nonselected-window t))
         (setq-local completion-base-position base-position)
         (setq-local completion-list-insert-choice-function insert-fun))
       (setq-local completion-reference-buffer mainbuf)
-- 
2.39.3