[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master 00caec80581: New command 'completion-preview-complete'
|
From: |
Eshel Yaron |
|
Subject: |
master 00caec80581: New command 'completion-preview-complete' |
|
Date: |
Sat, 20 Apr 2024 07:32:47 -0400 (EDT) |
branch: master
commit 00caec805810c752f0015c2ca23a494621e63046
Author: Eshel Yaron <me@eshelyaron.com>
Commit: Eshel Yaron <me@eshelyaron.com>
New command 'completion-preview-complete'
This command completes the symbol at point up to the longest
common prefix of all completions candidates. We also add an
indication of the longest common prefix in the completion
preview by highlighting that part of the preview with the
'completion-preview-exact' face. To facilitate these features
we change the way we store the completion candidates while the
preview is visible, to explicitly keep the common prefix along
with a list of its suffixes.
* lisp/completion-preview.el (completion-preview--try-table):
Return longest common prefix and list of suffixes instead of
list of full candidates. Add illustrative comment.
(completion-preview--capf-wrapper, completion-preview--update)
(completion-preview--show, completion-preview-insert)
(completion-preview-next-candidate): Adjust.
(completion-preview-common): New face.
(completion-preview-exact): Tweak to distinguish it from
'completion-preview-common'.
(completion-preview-complete): New command.
(completion-preview-active-mode-map): Bind it.
(completion-preview-mode): Mention it in docstring.
(completion-preview-commands): Add 'completion-preview-complete'.
(completion-preview--make-overlay): Simplify.
(completion-preview--internal-command-p): Remove.
(completion-preview-require-certain-commands): Update.
(completion-preview--inhibit-update): New inline function.
(completion-preview--inhibit-update-p): New local variable.
(completion-preview--post-command, completion-preview-hide):
Reset it to nil.
* test/lisp/completion-preview-tests.el
(completion-preview-tests--check-preview): Check the 'face'
property of both the first and last character. Update callers.
(completion-preview-insert-calls-exit-function)
(completion-preview-complete): New tests. (Bug#70381)
---
lisp/completion-preview.el | 282 +++++++++++++++++++++++++---------
test/lisp/completion-preview-tests.el | 147 +++++++++++++++---
2 files changed, 335 insertions(+), 94 deletions(-)
diff --git a/lisp/completion-preview.el b/lisp/completion-preview.el
index 4e52aa9b151..8bc8cadc46b 100644
--- a/lisp/completion-preview.el
+++ b/lisp/completion-preview.el
@@ -39,6 +39,16 @@
;; example, to M-n and M-p in `completion-preview-active-mode-map' to
;; have them handy whenever the preview is visible.
;;
+;; When the completion candidate that the preview is showing shares a
+;; common prefix with all other candidates, Completion Preview mode
+;; underlines that common prefix. If you want to insert the common
+;; prefix but with a different suffix than the one the preview is
+;; showing, use the command `completion-preview-complete'. This command
+;; inserts just the common prefix and lets you go on typing as usual.
+;; If you invoke `completion-preview-complete' when there is no common
+;; prefix (so nothing is underlined in the preview), it displays a list
+;; of all matching completion candidates.
+;;
;; If you set the user option `completion-preview-exact-match-only' to
;; non-nil, Completion Preview mode only suggests a completion
;; candidate when its the only possible completion for the (partial)
@@ -73,7 +83,8 @@ first candidate, and you can cycle between the candidates with
insert-char
delete-backward-char
backward-delete-char-untabify
- analyze-text-conversion)
+ analyze-text-conversion
+ completion-preview-complete)
"List of commands that should trigger completion preview."
:type '(repeat (function :tag "Command" :value self-insert-command))
:version "30.1")
@@ -104,16 +115,22 @@ If this option is nil, these commands do not display any
message."
(defface completion-preview
'((t :inherit shadow))
- "Face for completion preview overlay."
+ "Face for completion candidates in the completion preview overlay."
:version "30.1")
-(defface completion-preview-exact
+(defface completion-preview-common
'((((supports :underline t))
:underline t :inherit completion-preview)
(((supports :weight bold))
:weight bold :inherit completion-preview)
(t :background "gray"))
- "Face for exact completion preview overlay."
+ "Face for the longest common prefix in the completion preview."
+ :version "30.1")
+
+(defface completion-preview-exact
+ ;; An exact match is also the longest common prefix of all matches.
+ '((t :underline "gray25" :inherit completion-preview-common))
+ "Face for matches in the completion preview overlay."
:version "30.1")
(defface completion-preview-highlight
@@ -124,6 +141,8 @@ If this option is nil, these commands do not display any
message."
(defvar-keymap completion-preview-active-mode-map
:doc "Keymap for Completion Preview Active mode."
"C-i" #'completion-preview-insert
+ ;; FIXME: Should this have another/better binding by default?
+ "M-i" #'completion-preview-complete
;; "M-n" #'completion-preview-next-candidate
;; "M-p" #'completion-preview-prev-candidate
)
@@ -131,8 +150,8 @@ If this option is nil, these commands do not display any
message."
(defvar-keymap completion-preview--mouse-map
:doc "Keymap for mouse clicks on the completion preview."
"<down-mouse-1>" #'completion-preview-insert
- "C-<down-mouse-1>" #'completion-at-point
- "<down-mouse-2>" #'completion-at-point
+ "C-<down-mouse-1>" #'completion-preview-complete
+ "<down-mouse-2>" #'completion-preview-complete
"<wheel-up>" #'completion-preview-prev-candidate
"<wheel-down>" #'completion-preview-next-candidate)
@@ -147,14 +166,16 @@ If this option is nil, these commands do not display any
message."
Completion Preview mode avoids updating the preview after these commands.")
-(defsubst completion-preview--internal-command-p ()
- "Return non-nil if `this-command' manipulates the completion preview."
- (memq this-command completion-preview--internal-commands))
+(defvar-local completion-preview--inhibit-update-p nil
+ "Whether to inhibit updating the completion preview following this command.")
+
+(defsubst completion-preview--inhibit-update ()
+ "Inhibit updating the completion preview following this command."
+ (setq completion-preview--inhibit-update-p t))
(defsubst completion-preview-require-certain-commands ()
"Check if `this-command' is one of `completion-preview-commands'."
- (or (completion-preview--internal-command-p)
- (memq this-command completion-preview-commands)))
+ (memq this-command completion-preview-commands))
(defun completion-preview-require-minimum-symbol-length ()
"Check if the length of symbol at point is at least above a certain
threshold.
@@ -167,7 +188,8 @@ Completion Preview mode avoids updating the preview after
these commands.")
"Hide the completion preview."
(when completion-preview--overlay
(delete-overlay completion-preview--overlay)
- (setq completion-preview--overlay nil)))
+ (setq completion-preview--overlay nil
+ completion-preview--inhibit-update-p nil)))
(defun completion-preview--make-overlay (pos string)
"Make preview overlay showing STRING at POS, or move existing preview there."
@@ -175,13 +197,9 @@ Completion Preview mode avoids updating the preview after
these commands.")
(move-overlay completion-preview--overlay pos pos)
(setq completion-preview--overlay (make-overlay pos pos))
(overlay-put completion-preview--overlay 'window (selected-window)))
- (let ((previous (overlay-get completion-preview--overlay 'after-string)))
- (unless (and previous (string= previous string)
- (eq (get-text-property 0 'face previous)
- (get-text-property 0 'face string)))
- (add-text-properties 0 1 '(cursor 1) string)
- (overlay-put completion-preview--overlay 'after-string string))
- completion-preview--overlay))
+ (add-text-properties 0 1 '(cursor 1) string)
+ (overlay-put completion-preview--overlay 'after-string string)
+ completion-preview--overlay)
(defsubst completion-preview--get (prop)
"Return property PROP of the completion preview overlay."
@@ -221,17 +239,25 @@ See also `completion-styles'.")
PROPS is a property list with additional information about TABLE.
See `completion-at-point-functions' for more details.
-If TABLE contains a matching completion, return a list
-\(PREVIEW BEG END ALL BASE EXIT-FN) where PREVIEW is the text to
-show in the completion preview, ALL is the list of all matching
-completion candidates, BASE is a common prefix that TABLE elided
-from the start of each candidate, and EXIT-FN is either a
-function to call after inserting PREVIEW or nil. If TABLE does
-not contain matching completions, or if there are multiple
-matching completions and `completion-preview-exact-match-only' is
-non-nil, return nil instead."
+If TABLE contains a matching candidate, return a list
+\(BASE COMMON SUFFIXES) where BASE is a prefix of the text
+between BEG and END that TABLE elided from the start of each candidate,
+COMMON is the longest common prefix of all matching candidates,
+SUFFIXES is a list of different suffixes that together with COMMON yield
+the matching candidates. If TABLE does not contain matching
+candidates or if there are multiple matching completions and
+`completion-preview-exact-match-only' is non-nil, return nil instead."
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+ ;; ;;
+ ;; | buffer text | preview | ;;
+ ;; | | | ;;
+ ;; beg end | ;;
+ ;; |------+------|--+--------| Each of base, common and suffix ;;
+ ;; | base | common | suffix | <- may be empty, except common and ;;
+ ;; suffix cannot both be empty. ;;
+ ;; ;;
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(let* ((pred (plist-get props :predicate))
- (exit-fn (plist-get props :exit-function))
(string (buffer-substring beg end))
(md (completion-metadata string table pred))
(sort-fn (or (completion-metadata-get md 'cycle-sort-function)
@@ -250,16 +276,16 @@ non-nil, return nil instead."
(when last
(setcdr last nil)
(when-let ((sorted (funcall sort-fn
- (delete prefix (all-completions prefix
all)))))
- (unless (and (cdr sorted) completion-preview-exact-match-only)
- (list (propertize (substring (car sorted) (length prefix))
- 'face (if (cdr sorted)
- 'completion-preview
- 'completion-preview-exact)
- 'mouse-face 'completion-preview-highlight
- 'keymap completion-preview--mouse-map)
- (+ beg base) end sorted
- (substring string 0 base) exit-fn))))))
+ (delete prefix (all-completions prefix
all))))
+ (common (try-completion prefix sorted))
+ (lencom (length common))
+ (suffixes sorted))
+ (unless (and (cdr suffixes) completion-preview-exact-match-only)
+ ;; Remove the common prefix from each candidate.
+ (while sorted
+ (setcar sorted (substring (car sorted) lencom))
+ (setq sorted (cdr sorted)))
+ (list (substring string 0 base) common suffixes))))))
(defun completion-preview--capf-wrapper (capf)
"Translate return value of CAPF to properties for completion preview
overlay."
@@ -267,25 +293,41 @@ non-nil, return nil instead."
(and (consp res)
(not (functionp res))
(seq-let (beg end table &rest plist) res
- (or (completion-preview--try-table table beg end plist)
+ (or (when-let ((data (completion-preview--try-table
+ table beg end plist)))
+ `(,(+ beg (length (car data))) ,end ,plist ,@data))
(unless (eq 'no (plist-get plist :exclusive))
;; Return non-nil to exclude other capfs.
'(nil)))))))
(defun completion-preview--update ()
"Update completion preview."
- (seq-let (preview beg end all base exit-fn)
+ (seq-let (beg end props base common suffixes)
(run-hook-wrapped
'completion-at-point-functions
#'completion-preview--capf-wrapper)
- (when preview
- (let ((ov (completion-preview--make-overlay end preview)))
+ (when-let ((suffix (car suffixes)))
+ (set-text-properties 0 (length suffix)
+ (list 'face (if (cdr suffixes)
+ 'completion-preview
+ 'completion-preview-exact))
+ suffix)
+ (set-text-properties 0 (length common)
+ (list 'face (if (cdr suffixes)
+ 'completion-preview-common
+ 'completion-preview-exact))
+ common)
+ (let ((ov (completion-preview--make-overlay
+ end (propertize (concat (substring common (- end beg)) suffix)
+ 'mouse-face 'completion-preview-highlight
+ 'keymap completion-preview--mouse-map))))
(overlay-put ov 'completion-preview-beg beg)
(overlay-put ov 'completion-preview-end end)
(overlay-put ov 'completion-preview-index 0)
- (overlay-put ov 'completion-preview-cands all)
+ (overlay-put ov 'completion-preview-suffixes suffixes)
+ (overlay-put ov 'completion-preview-common common)
(overlay-put ov 'completion-preview-base base)
- (overlay-put ov 'completion-preview-exit-fn exit-fn)
+ (overlay-put ov 'completion-preview-props props)
(completion-preview-active-mode)))))
(defun completion-preview--show ()
@@ -308,17 +350,22 @@ point, otherwise hide it."
;; 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))
+ (sufs (completion-preview--get 'completion-preview-suffixes))
(index (completion-preview--get 'completion-preview-index))
- (cand (nth index cands))
- (after (completion-preview--get 'after-string))
- (face (get-text-property 0 'face after)))
+ (common (completion-preview--get 'completion-preview-common))
+ (suffix (nth index sufs))
+ (cand nil))
+ (set-text-properties 0 (length suffix)
+ (list 'face (if (cdr sufs)
+ 'completion-preview
+ 'completion-preview-exact))
+ suffix)
+ (setq cand (concat common (nth index sufs)))
(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
end (propertize (substring cand (- end beg))
- 'face face
'mouse-face
'completion-preview-highlight
'keymap completion-preview--mouse-map))
'completion-preview-end end)
@@ -329,16 +376,18 @@ point, otherwise hide it."
(defun completion-preview--post-command ()
"Create, update or delete completion preview post last command."
- (if (and (completion-preview-require-certain-commands)
- (completion-preview-require-minimum-symbol-length))
- ;; We should show the preview.
- (or
- ;; If we're called after a command that itself updates the
- ;; preview, don't do anything.
- (completion-preview--internal-command-p)
- ;; Otherwise, show the preview.
- (completion-preview--show))
- (completion-preview-active-mode -1)))
+ (let ((internal-p (or completion-preview--inhibit-update-p
+ (memq this-command
+ completion-preview--internal-commands))))
+ (setq completion-preview--inhibit-update-p nil)
+
+ ;; If we're called after a command that itself updates the
+ ;; preview, don't do anything.
+ (unless internal-p
+ (if (and (completion-preview-require-certain-commands)
+ (completion-preview-require-minimum-symbol-length))
+ (completion-preview--show)
+ (completion-preview-active-mode -1)))))
(defun completion-preview-insert ()
"Insert the completion candidate that the preview is showing."
@@ -347,16 +396,84 @@ point, otherwise hide it."
(let* ((pre (completion-preview--get 'completion-preview-base))
(end (completion-preview--get 'completion-preview-end))
(ind (completion-preview--get 'completion-preview-index))
- (all (completion-preview--get 'completion-preview-cands))
- (efn (completion-preview--get 'completion-preview-exit-fn))
+ (all (completion-preview--get 'completion-preview-suffixes))
+ (com (completion-preview--get 'completion-preview-common))
+ (efn (plist-get (completion-preview--get
'completion-preview-props)
+ :exit-function))
(aft (completion-preview--get 'after-string))
- (str (concat pre (nth ind all))))
+ (str (concat pre com (nth ind all))))
(completion-preview-active-mode -1)
(goto-char end)
(insert (substring-no-properties aft))
(when (functionp efn) (funcall efn str 'finished)))
(user-error "No current completion preview")))
+(defun completion-preview-complete ()
+ "Complete up to the longest common prefix of all completion candidates.
+
+If you call this command twice in a row, or otherwise if there is no
+common prefix to insert, it displays the list of matching completion
+candidates unless `completion-auto-help' is nil. If you repeat this
+command again when the completions list is visible, it scrolls the
+completions list."
+ (interactive)
+ (unless completion-preview-active-mode
+ (user-error "No current completion preview"))
+ (let* ((beg (completion-preview--get 'completion-preview-beg))
+ (end (completion-preview--get 'completion-preview-end))
+ (com (completion-preview--get 'completion-preview-common))
+ (cur (completion-preview--get 'completion-preview-index))
+ (all (completion-preview--get 'completion-preview-suffixes))
+ (base (completion-preview--get 'completion-preview-base))
+ (props (completion-preview--get 'completion-preview-props))
+ (efn (plist-get props :exit-function))
+ (ins (substring-no-properties com (- end beg))))
+ (goto-char end)
+ (if (string-empty-p ins)
+ ;; If there's nothing to insert, call `completion-at-point' to
+ ;; show the completions list (or just display a message when
+ ;; `completion-auto-help' is nil).
+ (let* ((completion-styles completion-preview-completion-styles)
+ (sub (substring-no-properties com))
+ (col (mapcar (lambda (suf)
+ (concat sub (substring-no-properties suf)))
+ (append (nthcdr cur all) (take cur all))))
+ ;; The candidates are already in order.
+ (props (plist-put props :display-sort-function #'identity))
+ ;; The :exit-function might be slow, e.g. when the
+ ;; backend is Eglot, so we ensure that the preview is
+ ;; hidden before any original :exit-function is called.
+ (props (plist-put props :exit-function
+ (when (functionp efn)
+ (lambda (string status)
+ (completion-preview-active-mode -1)
+ (funcall efn string status)))))
+ ;; The predicate is meant for the original completion
+ ;; candidates, which may be symbols or cons cells, but
+ ;; now we only have strings, so it might be unapplicable.
+ (props (plist-put props :predicate nil))
+ (completion-at-point-functions
+ (list (lambda () `(,beg ,end ,col ,@props)))))
+ (completion-preview--inhibit-update)
+ (completion-at-point))
+ ;; Otherwise, insert the common prefix and update the preview.
+ (insert ins)
+ (let ((suf (nth cur all))
+ (pos (point)))
+ (if (or (string-empty-p suf) (null suf))
+ ;; If we've inserted a full candidate, let the post-command
+ ;; hook update the completion preview in case the candidate
+ ;; can be completed further.
+ (when (functionp efn)
+ (funcall efn (concat base com) (if (cdr all) 'exact 'finished)))
+ ;; Otherwise, remove the common prefix from the preview.
+ (completion-preview--inhibit-update)
+ (overlay-put (completion-preview--make-overlay
+ pos (propertize
+ suf 'mouse-face 'completion-preview-highlight
+ 'keymap completion-preview--mouse-map))
+ 'completion-preview-end pos))))))
+
(defun completion-preview-prev-candidate ()
"Cycle the candidate that the preview is showing to the previous suggestion."
(interactive)
@@ -372,18 +489,29 @@ prefix argument and defaults to 1."
(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))
+ (all (completion-preview--get 'completion-preview-suffixes))
+ (com (completion-preview--get 'completion-preview-common))
(cur (completion-preview--get 'completion-preview-index))
(len (length all))
(new (mod (+ cur direction) len))
- (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 (- end beg))
- 'face (if (< 1 len)
- 'completion-preview
- 'completion-preview-exact)
+ (suf (nth new all))
+ (lencom (length com)))
+ ;; Skip suffixes that are no longer applicable. This may happen
+ ;; when the user continues typing and immediately runs this
+ ;; command, before the completion backend returns an updated set
+ ;; of completions for the new (longer) prefix, so we still have
+ ;; the previous (larger) set of candidates at hand.
+ (while (or (<= (+ beg lencom (length suf)) end)
+ (not (string-prefix-p (buffer-substring beg end)
+ (concat com suf))))
+ (setq new (mod (+ new direction) len)
+ suf (nth new all)))
+ (set-text-properties 0 (length suf)
+ (list 'face (if (cdr all)
+ 'completion-preview
+ 'completion-preview-exact))
+ suf)
+ (let ((aft (propertize (substring (concat com suf) (- end beg))
'mouse-face 'completion-preview-highlight
'keymap completion-preview--mouse-map)))
(add-text-properties 0 1 '(cursor 1) aft)
@@ -398,6 +526,7 @@ prefix argument and defaults to 1."
(buffer-local-value 'completion-preview-active-mode buffer))
(dolist (cmd '(completion-preview-insert
+ completion-preview-complete
completion-preview-prev-candidate
completion-preview-next-candidate))
(put cmd 'completion-predicate #'completion-preview--active-p))
@@ -409,11 +538,12 @@ prefix argument and defaults to 1."
This mode automatically shows and updates the completion preview
according to the text around point.
\\<completion-preview-active-mode-map>\
-When the preview is visible, \\[completion-preview-insert]
-accepts the completion suggestion,
+When the preview is visible, \\[completion-preview-insert] accepts the
+completion suggestion, \\[completion-preview-complete] completes up to
+the longest common prefix of all completion candidates,
\\[completion-preview-next-candidate] cycles forward to the next
-completion suggestion, and \\[completion-preview-prev-candidate]
-cycles backward."
+completion suggestion, and \\[completion-preview-prev-candidate] cycles
+backward."
:lighter " CP"
(if completion-preview-mode
(add-hook 'post-command-hook #'completion-preview--post-command nil t)
diff --git a/test/lisp/completion-preview-tests.el
b/test/lisp/completion-preview-tests.el
index 5b2c28bd3dd..7d358d07519 100644
--- a/test/lisp/completion-preview-tests.el
+++ b/test/lisp/completion-preview-tests.el
@@ -27,23 +27,25 @@
(when-let ((bounds (bounds-of-thing-at-point 'symbol)))
(append (list (car bounds) (cdr bounds) completions) props))))
-(defun completion-preview-tests--check-preview (string &optional exact)
+(defun completion-preview-tests--check-preview
+ (string &optional beg-face end-face)
"Check that the completion preview is showing STRING.
-If EXACT is non-nil, check that STRING has the
-`completion-preview-exact' face. Otherwise check that STRING has
-the `completion-preview' face.
+BEG-FACE and END-FACE say which faces the beginning and end of STRING
+should have, respectively. Both BEG-FACE and END-FACE default to
+`completion-preview'.
If STRING is nil, check that there is no completion preview
instead."
(if (not string)
- (should (not completion-preview--overlay))
+ (should-not completion-preview--overlay)
(should completion-preview--overlay)
(let ((after-string (completion-preview--get 'after-string)))
(should (string= after-string string))
(should (eq (get-text-property 0 'face after-string)
- (if exact
- 'completion-preview-exact
+ (or beg-face 'completion-preview)))
+ (should (eq (get-text-property (1- (length after-string)) 'face
after-string)
+ (or end-face
'completion-preview))))))
(ert-deftest completion-preview ()
@@ -57,7 +59,9 @@ instead."
(completion-preview--post-command))
;; Exact match
- (completion-preview-tests--check-preview "barbaz" 'exact)
+ (completion-preview-tests--check-preview "barbaz"
+ 'completion-preview-exact
+ 'completion-preview-exact)
(insert "v")
(let ((this-command 'self-insert-command))
@@ -71,7 +75,9 @@ instead."
(completion-preview--post-command))
;; Exact match again
- (completion-preview-tests--check-preview "barbaz" 'exact)))
+ (completion-preview-tests--check-preview "barbaz"
+ 'completion-preview-exact
+ 'completion-preview-exact)))
(ert-deftest completion-preview-multiple-matches ()
"Test Completion Preview mode with multiple matching candidates."
@@ -84,12 +90,12 @@ instead."
(completion-preview--post-command))
;; Multiple matches, the preview shows the first one
- (completion-preview-tests--check-preview "bar")
+ (completion-preview-tests--check-preview "bar" 'completion-preview-common)
(completion-preview-next-candidate 1)
;; Next match
- (completion-preview-tests--check-preview "baz")))
+ (completion-preview-tests--check-preview "baz"
'completion-preview-common)))
(ert-deftest completion-preview-exact-match-only ()
"Test `completion-preview-exact-match-only'."
@@ -111,7 +117,9 @@ instead."
(completion-preview--post-command))
;; Exact match
- (completion-preview-tests--check-preview "m" 'exact)))
+ (completion-preview-tests--check-preview "m"
+ 'completion-preview-exact
+ 'completion-preview-exact)))
(ert-deftest completion-preview-function-capfs ()
"Test Completion Preview mode with capfs that return a function."
@@ -124,7 +132,7 @@ instead."
(insert "foo")
(let ((this-command 'self-insert-command))
(completion-preview--post-command))
- (completion-preview-tests--check-preview "bar")))
+ (completion-preview-tests--check-preview "bar"
'completion-preview-common)))
(ert-deftest completion-preview-non-exclusive-capfs ()
"Test Completion Preview mode with non-exclusive capfs."
@@ -140,11 +148,13 @@ instead."
(insert "foo")
(let ((this-command 'self-insert-command))
(completion-preview--post-command))
- (completion-preview-tests--check-preview "bar")
+ (completion-preview-tests--check-preview "bar" 'completion-preview-common)
(setq-local completion-preview-exact-match-only t)
(let ((this-command 'self-insert-command))
(completion-preview--post-command))
- (completion-preview-tests--check-preview "barbaz" 'exact)))
+ (completion-preview-tests--check-preview "barbaz"
+ 'completion-preview-exact
+ 'completion-preview-exact)))
(ert-deftest completion-preview-face-updates ()
"Test updating the face in completion preview when match is no longer exact."
@@ -160,7 +170,9 @@ instead."
(insert "b")
(let ((this-command 'self-insert-command))
(completion-preview--post-command))
- (completion-preview-tests--check-preview "arbaz" 'exact)
+ (completion-preview-tests--check-preview "arbaz"
+ 'completion-preview-exact
+ 'completion-preview-exact)
(delete-char -1)
(let ((this-command 'delete-backward-char))
(completion-preview--post-command))
@@ -173,13 +185,15 @@ instead."
(with-temp-buffer
(setq-local completion-at-point-functions
(list
- (lambda () (user-error "bad"))
+ (lambda () (user-error "Bad"))
(completion-preview-tests--capf
'("foobarbaz"))))
(insert "foo")
(let ((this-command 'self-insert-command))
(completion-preview--post-command))
- (completion-preview-tests--check-preview "barbaz" 'exact)))
+ (completion-preview-tests--check-preview "barbaz"
+ 'completion-preview-exact
+ 'completion-preview-exact)))
(ert-deftest completion-preview-mid-symbol-cycle ()
"Test cycling the completion preview with point at the middle of a symbol."
@@ -196,4 +210,101 @@ instead."
(completion-preview-next-candidate 1)
(completion-preview-tests--check-preview "z")))
+(ert-deftest completion-preview-complete ()
+ "Test `completion-preview-complete'."
+ (with-temp-buffer
+ (let ((exit-fn-called nil)
+ (exit-fn-args nil)
+ (message-args nil)
+ (completion-auto-help nil))
+ (setq-local completion-at-point-functions
+ (list
+ (completion-preview-tests--capf
+ '("foobar" "foobaz" "foobash" "foobash-mode")
+ :exit-function
+ (lambda (&rest args)
+ (setq exit-fn-called t
+ exit-fn-args args)))))
+ (insert "foo")
+ (let ((this-command 'self-insert-command))
+ (completion-preview--post-command))
+ (message "here")
+
+ (completion-preview-tests--check-preview "bar"
'completion-preview-common)
+
+ ;; Insert the common prefix, "ba".
+ (completion-preview-complete)
+
+ ;; Only "r" should remain.
+ (completion-preview-tests--check-preview "r")
+
+ (cl-letf (((symbol-function #'minibuffer-message)
+ (lambda (&rest args) (setq message-args args))))
+
+ ;; With `completion-auto-help' set to nil, a second call to
+ ;; `completion-preview-complete' just displays a message.
+ (completion-preview-complete)
+ (setq completion-preview--inhibit-update-p nil)
+
+ (should (equal message-args '("Next char not unique"))))
+
+ ;; The preview should stay put.
+ (completion-preview-tests--check-preview "r")
+ ;; (completion-preview-active-mode -1)
+
+ ;; Narrow further.
+ (insert "s")
+ (let ((this-command 'self-insert-command))
+ (completion-preview--post-command))
+
+ ;; The preview should indicate an exact match.
+ (completion-preview-tests--check-preview "h"
+ 'completion-preview-common
+ 'completion-preview-common)
+
+ ;; Insert the entire preview content.
+ (completion-preview-complete)
+ (setq completion-preview--inhibit-update-p nil)
+ (let ((this-command 'completion-preview-complete))
+ (completion-preview--post-command))
+
+ ;; The preview should update to indicate that there's a further
+ ;; possible completion.
+ (completion-preview-tests--check-preview "-mode"
+ 'completion-preview-exact
+ 'completion-preview-exact)
+ (should exit-fn-called)
+ (should (equal exit-fn-args '("foobash" exact)))
+ (setq exit-fn-called nil exit-fn-args nil)
+
+ ;; Insert the extra suffix.
+ (completion-preview-complete)
+
+ ;; Nothing more to show, so the preview should now be gone.
+ (should-not completion-preview--overlay)
+ (should exit-fn-called)
+ (should (equal exit-fn-args '("foobash-mode" finished))))))
+
+(ert-deftest completion-preview-insert-calls-exit-function ()
+ "Test that `completion-preview-insert' calls the completion exit function."
+ (let ((exit-fn-called nil) (exit-fn-args nil))
+ (with-temp-buffer
+ (setq-local completion-at-point-functions
+ (list
+ (completion-preview-tests--capf
+ '("foobar" "foobaz")
+ :exit-function
+ (lambda (&rest args)
+ (setq exit-fn-called t
+ exit-fn-args args)))))
+ (insert "foo")
+ (let ((this-command 'self-insert-command))
+ (completion-preview--post-command))
+ (completion-preview-tests--check-preview "bar"
'completion-preview-common)
+ (completion-preview-insert)
+ (should (string= (buffer-string) "foobar"))
+ (should-not completion-preview--overlay)
+ (should exit-fn-called)
+ (should (equal exit-fn-args '("foobar" finished))))))
+
;;; completion-preview-tests.el ends here
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- master 00caec80581: New command 'completion-preview-complete',
Eshel Yaron <=