; 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)
This commit is contained in:
Eshel Yaron 2024-02-01 12:30:24 +01:00
parent 35d99b1ec7
commit e6882a5cc8
No known key found for this signature in database
GPG key ID: EF3EE9CA35D78618
2 changed files with 27 additions and 12 deletions

View file

@ -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)

View file

@ -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