Subject: bug#74408: 30.0.92; FR: Add a function completion-list-candidate-at-point

From: Daniel Mendler <[email-masked]>
Date: Tue, 19 Nov 2024 00:36:49 +0100

Stefan Monnier <[email-masked]> writes:

> AFAICT, it's easy to make `completion-list-candidate-at-point` accept an
> optional position argument (which would default to point), which would
> be helpful in the two places where we use that function.
> WDYT?

Indeed. Updated patch attached.

Daniel

>From bd755ae662e6cc5815e795d3c54dd7bda3cdc4e2 Mon Sep 17 00:00:00 2001
From: Daniel Mendler <[email-masked]>
Date: Mon, 18 Nov 2024 00:58:48 +0100
Subject: [PATCH] New function `completion-list-candidate-at-point'

Replace `completions--start-of-candidate-at' with the new
function `completion-list-candidate-at-point' which returns the
candidate string and the candidate bounds as a list in the
format (STR BEG END).

* lisp/simple.el (completions--start-of-candidate-at): Remove.
(completion-list-candidate-at-point): New function.
(choose-completion): Use it.
* lisp/minibuffer.el (minibuffer-completion-help): Use it.
---
 lisp/minibuffer.el |  5 +++--
 lisp/simple.el     | 40 +++++++++++++++++++++-------------------
 2 files changed, 24 insertions(+), 21 deletions(-)

diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 9b498615926..405ee21cdb2 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -2628,8 +2628,9 @@ minibuffer-completion-help
               (when-let* ((buffer (get-buffer "*Completions*"))
                           (window (get-buffer-window buffer 0)))
                 (with-current-buffer buffer
-                  (when-let* ((beg (completions--start-of-candidate-at (window-point window))))
-                    (cons (get-text-property beg 'completion--string) (- (point) beg))))))
+                  (when-let* ((cand (completion-list-candidate-at-point
+                                     (window-point window))))
+                    (cons (car cand) (- (point) (cadr cand)))))))
              ;; 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
diff --git a/lisp/simple.el b/lisp/simple.el
index 3a142ef14b3..443a848b0ab 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -10246,22 +10246,26 @@ 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."
+(defun completion-list-candidate-at-point (&optional pt)
+  "Candidate string and bounds at PT in completions buffer.
+The return value has the format (STR BEG END).
+The optional argument PT defaults to (point)."
   (save-excursion
-    (goto-char position)
+    (when pt (goto-char pt))
     (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)))))
+      (when (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))))
+        (setq beg (or (previous-single-property-change
+                       beg 'completion--string)
+                      beg))
+        (list (get-text-property beg 'completion--string) beg
+              (or (next-single-property-change beg 'completion--string)
+                  (point-max)))))))
 
 (defun choose-completion (&optional event no-exit no-quit)
   "Choose the completion at point.
@@ -10286,11 +10290,9 @@ choose-completion
                (or (get-text-property (posn-point (event-start event))
                                       'completion--string)
                    (error "No completion here"))
-             (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")))))
+             (or (car (completion-list-candidate-at-point
+                       (posn-point (event-start event))))
+                 (error "No completion here")))))
 
       (unless (buffer-live-p buffer)
         (error "Destination buffer is dead"))
-- 
2.45.2