mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-11-23 07:19:15 +00:00
00caec8058
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)
311 lines
12 KiB
EmacsLisp
311 lines
12 KiB
EmacsLisp
;;; completion-preview-tests.el --- tests for completion-preview.el -*- lexical-binding: t -*-
|
|
|
|
;; Copyright (C) 2023-2024 Free Software Foundation, Inc.
|
|
|
|
;; This file is part of GNU Emacs.
|
|
|
|
;; GNU Emacs is free software: you can redistribute it and/or modify
|
|
;; it under the terms of the GNU General Public License as published by
|
|
;; the Free Software Foundation, either version 3 of the License, or
|
|
;; (at your option) any later version.
|
|
|
|
;; GNU Emacs is distributed in the hope that it will be useful,
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
;; GNU General Public License for more details.
|
|
|
|
;; You should have received a copy of the GNU General Public License
|
|
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
|
|
|
;;; Code:
|
|
|
|
(require 'ert)
|
|
(require 'completion-preview)
|
|
|
|
(defun completion-preview-tests--capf (completions &rest props)
|
|
(lambda ()
|
|
(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 beg-face end-face)
|
|
"Check that the completion preview is showing STRING.
|
|
|
|
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 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)
|
|
(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 ()
|
|
"Test Completion Preview mode."
|
|
(with-temp-buffer
|
|
(setq-local completion-at-point-functions
|
|
(list (completion-preview-tests--capf '("foobarbaz"))))
|
|
|
|
(insert "foo")
|
|
(let ((this-command 'self-insert-command))
|
|
(completion-preview--post-command))
|
|
|
|
;; Exact match
|
|
(completion-preview-tests--check-preview "barbaz"
|
|
'completion-preview-exact
|
|
'completion-preview-exact)
|
|
|
|
(insert "v")
|
|
(let ((this-command 'self-insert-command))
|
|
(completion-preview--post-command))
|
|
|
|
;; No match, no preview
|
|
(completion-preview-tests--check-preview nil)
|
|
|
|
(delete-char -1)
|
|
(let ((this-command 'delete-backward-char))
|
|
(completion-preview--post-command))
|
|
|
|
;; Exact match again
|
|
(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."
|
|
(with-temp-buffer
|
|
(setq-local completion-at-point-functions
|
|
(list (completion-preview-tests--capf
|
|
'("foobar" "foobaz"))))
|
|
(insert "foo")
|
|
(let ((this-command 'self-insert-command))
|
|
(completion-preview--post-command))
|
|
|
|
;; Multiple matches, the preview shows the first one
|
|
(completion-preview-tests--check-preview "bar" 'completion-preview-common)
|
|
|
|
(completion-preview-next-candidate 1)
|
|
|
|
;; Next match
|
|
(completion-preview-tests--check-preview "baz" 'completion-preview-common)))
|
|
|
|
(ert-deftest completion-preview-exact-match-only ()
|
|
"Test `completion-preview-exact-match-only'."
|
|
(with-temp-buffer
|
|
(setq-local completion-at-point-functions
|
|
(list (completion-preview-tests--capf
|
|
'("spam" "foobar" "foobaz")))
|
|
completion-preview-exact-match-only t)
|
|
(insert "foo")
|
|
(let ((this-command 'self-insert-command))
|
|
(completion-preview--post-command))
|
|
|
|
;; Multiple matches, so no preview
|
|
(completion-preview-tests--check-preview nil)
|
|
|
|
(delete-region (point-min) (point-max))
|
|
(insert "spa")
|
|
(let ((this-command 'self-insert-command))
|
|
(completion-preview--post-command))
|
|
|
|
;; Exact match
|
|
(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."
|
|
(with-temp-buffer
|
|
(setq-local completion-at-point-functions
|
|
(list
|
|
(lambda () #'ignore)
|
|
(completion-preview-tests--capf
|
|
'("foobar" "foobaz"))))
|
|
(insert "foo")
|
|
(let ((this-command 'self-insert-command))
|
|
(completion-preview--post-command))
|
|
(completion-preview-tests--check-preview "bar" 'completion-preview-common)))
|
|
|
|
(ert-deftest completion-preview-non-exclusive-capfs ()
|
|
"Test Completion Preview mode with non-exclusive capfs."
|
|
(with-temp-buffer
|
|
(setq-local completion-at-point-functions
|
|
(list
|
|
(completion-preview-tests--capf
|
|
'("spam") :exclusive 'no)
|
|
(completion-preview-tests--capf
|
|
'("foobar" "foobaz") :exclusive 'no)
|
|
(completion-preview-tests--capf
|
|
'("foobarbaz"))))
|
|
(insert "foo")
|
|
(let ((this-command 'self-insert-command))
|
|
(completion-preview--post-command))
|
|
(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"
|
|
'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."
|
|
(with-temp-buffer
|
|
(setq-local completion-at-point-functions
|
|
(list
|
|
(completion-preview-tests--capf
|
|
'("foobarbaz" "food"))))
|
|
(insert "foo")
|
|
(let ((this-command 'self-insert-command))
|
|
(completion-preview--post-command))
|
|
(completion-preview-tests--check-preview "d")
|
|
(insert "b")
|
|
(let ((this-command 'self-insert-command))
|
|
(completion-preview--post-command))
|
|
(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))
|
|
(completion-preview-tests--check-preview "d")))
|
|
|
|
(ert-deftest completion-preview-capf-errors ()
|
|
"Test Completion Preview mode with capfs that signal errors.
|
|
|
|
`dabbrev-capf' is one example of such a capf."
|
|
(with-temp-buffer
|
|
(setq-local completion-at-point-functions
|
|
(list
|
|
(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"
|
|
'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."
|
|
(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")))
|
|
|
|
(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
|