; 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): Use recorded 'completion-preview-end'
position instead of current point.

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

diff --git a/lisp/completion-preview.el b/lisp/completion-preview.el
index 6fd60f3c4166452fee33e74c291c0b0ede3ff2b4..d7d3e9bf9f7dbe7ef6a933fa8b5449bcc7f3d1c1 100644 (file)
--- 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) (completion-preview--get 'completion-preview-end)))
            (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 190764e91258f094d2b3a3893ffe18d17891c388..5b2c28bd3dd5e926075bacf6d1b71dbf7ab364e5 100644 (file)
--- 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