; Fix mid-symbol updating/cycling completion preview

This fixes an issue where 'completion-preview-next-candidate'
would fail to take into account the part of the symbol that
follows point (the suffix) when point is at the middle of a
symbol, as well as a similar issue in 'completion-preview--show'
that would manifest with slow 'completion-at-point-functions'.

* lisp/completion-preview.el (completion-preview-next-candidate)
(completion-preview--show): Ensure that the completion preview
remains at the end of a symbol, when updating it while point is
in the middle of that symbol.

* test/lisp/completion-preview-tests.el
(completion-preview-mid-symbol-cycle): New test.  (Bug#68875)

2 files changed, 27 insertions, 12 deletions

diff --git a/lisp/completion-preview.el b/lisp/completion-preview.el
index 6fd60f3c416..e827da43a08 100644
--- a/lisp/completion-preview.el
+++ b/lisp/completion-preview.el
@@ -302,21 +302,21 @@ point, otherwise hide it."
     ;; never display a stale preview and that the preview doesn't
     ;; flicker, even with slow completion backends.
     (let* ((beg (completion-preview--get 'completion-preview-beg))
+           (end (max (point) (overlay-start completion-preview--overlay)))
            (cands (completion-preview--get 'completion-preview-cands))
            (index (completion-preview--get 'completion-preview-index))
            (cand (nth index cands))
-           (len (length cand))
-           (end (+ beg len))
-           (cur (point))
-           (face (get-text-property 0 'face (completion-preview--get 'after-string))))
-      (if (and (< beg cur end) (string-prefix-p (buffer-substring beg cur) cand))
+           (after (completion-preview--get 'after-string))
+           (face (get-text-property 0 'face after)))
+      (if (and (<= beg (point) end (1- (+ beg (length cand))))
+               (string-prefix-p (buffer-substring beg end) cand))
           ;; The previous preview is still applicable, update it.
           (overlay-put (completion-preview--make-overlay
-                        cur (propertize (substring cand (- cur beg))
+                        end (propertize (substring cand (- end beg))
                                         'face face
                                         'mouse-face 'completion-preview-highlight
                                         'keymap completion-preview--mouse-map))
-                       'completion-preview-end cur)
+                       'completion-preview-end end)
         ;; The previous preview is no longer applicable, hide it.
         (completion-preview-active-mode -1))))
   ;; Run `completion-at-point-functions' to get a new candidate.
@@ -366,16 +366,16 @@ prefix argument and defaults to 1."
   (interactive "p")
   (when completion-preview-active-mode
     (let* ((beg (completion-preview--get 'completion-preview-beg))
+           (end (completion-preview--get 'completion-preview-end))
            (all (completion-preview--get 'completion-preview-cands))
            (cur (completion-preview--get 'completion-preview-index))
            (len (length all))
            (new (mod (+ cur direction) len))
-           (str (nth new all))
-           (pos (point)))
-      (while (or (<= (+ beg (length str)) pos)
-                 (not (string-prefix-p (buffer-substring beg pos) str)))
+           (str (nth new all)))
+      (while (or (<= (+ beg (length str)) end)
+                 (not (string-prefix-p (buffer-substring beg end) str)))
         (setq new (mod (+ new direction) len) str (nth new all)))
-      (let ((aft (propertize (substring str (- pos beg))
+      (let ((aft (propertize (substring str (- end beg))
                              'face (if (< 1 len)
                                        'completion-preview
                                      'completion-preview-exact)
diff --git a/test/lisp/completion-preview-tests.el b/test/lisp/completion-preview-tests.el
index 190764e9125..5b2c28bd3dd 100644
--- a/test/lisp/completion-preview-tests.el
+++ b/test/lisp/completion-preview-tests.el
@@ -181,4 +181,19 @@ instead."
       (completion-preview--post-command))
     (completion-preview-tests--check-preview "barbaz" 'exact)))
 
+(ert-deftest completion-preview-mid-symbol-cycle ()
+  "Test cycling the completion preview with point at the middle of a symbol."
+  (with-temp-buffer
+    (setq-local completion-at-point-functions
+                (list
+                 (completion-preview-tests--capf
+                  '("foobar" "foobaz"))))
+    (insert "fooba")
+    (forward-char -2)
+    (let ((this-command 'self-insert-command))
+      (completion-preview--post-command))
+    (completion-preview-tests--check-preview "r")
+    (completion-preview-next-candidate 1)
+    (completion-preview-tests--check-preview "z")))
+
 ;;; completion-preview-tests.el ends here