mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-12-02 08:22:22 +00:00
a9af70849d
Add tests for regressions that followed commit ff3f17ca3c.
See discussion here:
https://lists.gnu.org/archive/html/emacs-devel/2024-05/msg00701.html
* test/lisp/minibuffer-tests.el (completion-cycle)
(minibuffer-next-completion): New tests.
648 lines
26 KiB
EmacsLisp
648 lines
26 KiB
EmacsLisp
;;; minibuffer-tests.el --- Tests for completion functions -*- lexical-binding: t; -*-
|
||
|
||
;; Copyright (C) 2013-2024 Free Software Foundation, Inc.
|
||
|
||
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
|
||
;; Keywords:
|
||
|
||
;; 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/>.
|
||
|
||
;;; Commentary:
|
||
|
||
;;
|
||
|
||
;;; Code:
|
||
|
||
(require 'ert)
|
||
(require 'ert-x)
|
||
|
||
(eval-when-compile (require 'cl-lib))
|
||
|
||
(ert-deftest completion-test1 ()
|
||
(with-temp-buffer
|
||
(cl-flet* ((test/completion-table (string pred action)
|
||
(let ((completion-ignore-case t))
|
||
(complete-with-action action '("test: ") string pred)))
|
||
(test/completion-at-point ()
|
||
(list (copy-marker (point-min))
|
||
(copy-marker (point))
|
||
#'test/completion-table)))
|
||
(let ((completion-at-point-functions (list #'test/completion-at-point)))
|
||
(insert "TEST")
|
||
(completion-at-point)
|
||
(should (equal (buffer-string)
|
||
"test: "))))))
|
||
|
||
(ert-deftest completion-table-with-predicate-test ()
|
||
(let ((full-collection
|
||
'("apple" ; Has A.
|
||
"beet" ; Has B.
|
||
"banana" ; Has A & B.
|
||
"cherry" ; Has neither.
|
||
))
|
||
(no-A (lambda (x) (not (string-match-p "a" x))))
|
||
(no-B (lambda (x) (not (string-match-p "b" x)))))
|
||
(should
|
||
(member "cherry"
|
||
(completion-table-with-predicate
|
||
full-collection no-A t "" no-B t)))
|
||
(should-not
|
||
(member "banana"
|
||
(completion-table-with-predicate
|
||
full-collection no-A t "" no-B t)))
|
||
;; "apple" should still match when strict is nil.
|
||
(should (eq t (try-completion
|
||
"apple"
|
||
(apply-partially
|
||
'completion-table-with-predicate
|
||
full-collection no-A nil)
|
||
no-B)))
|
||
;; "apple" should still match when strict is nil and pred2 is nil
|
||
;; (Bug#27841).
|
||
(should (eq t (try-completion
|
||
"apple"
|
||
(apply-partially
|
||
'completion-table-with-predicate
|
||
full-collection no-A nil))))))
|
||
|
||
(ert-deftest completion-table-subvert-test ()
|
||
(let* ((origtable '("A-hello" "A-there"))
|
||
(subvtable (completion-table-subvert origtable "B" "A")))
|
||
(should (equal (try-completion "B-hel" subvtable)
|
||
"B-hello"))
|
||
(should (equal (all-completions "B-hel" subvtable) '("-hello")))
|
||
(should (test-completion "B-hello" subvtable))
|
||
(should (equal (completion-boundaries "B-hel" subvtable
|
||
nil "suffix")
|
||
'(1 . 6)))))
|
||
|
||
(ert-deftest completion-table-test-quoting ()
|
||
(let ((process-environment
|
||
`("CTTQ1=ed" "CTTQ2=et/" ,@process-environment))
|
||
(default-directory (ert-resource-directory)))
|
||
(pcase-dolist (`(,input ,output)
|
||
'(
|
||
;; Test that $ in files is properly $$ quoted.
|
||
("data/m-cttq" "data/minibuffer-test-cttq$$tion")
|
||
;; Test that $$ in input is properly unquoted.
|
||
("data/m-cttq$$t" "data/minibuffer-test-cttq$$tion")
|
||
;; Test that env-vars are preserved.
|
||
("lisp/c${CTTQ1}et/se-u" "lisp/c${CTTQ1}et/semantic-utest")
|
||
("lisp/ced${CTTQ2}se-u" "lisp/ced${CTTQ2}semantic-utest")
|
||
;; Test that env-vars don't prevent partial-completion.
|
||
;; FIXME: Ideally we'd like to keep the ${CTTQ}!
|
||
("lis/c${CTTQ1}/se-u" "lisp/cedet/semantic-utest")
|
||
))
|
||
(should (equal (completion-try-completion input
|
||
#'completion--file-name-table
|
||
nil (length input))
|
||
(cons output (length output)))))))
|
||
|
||
(ert-deftest completion--insert-strings-faces ()
|
||
(with-temp-buffer
|
||
(completion--insert-strings
|
||
'(("completion1" "suffix1")))
|
||
(should (equal (get-text-property 12 'face) '(completions-annotations))))
|
||
(with-temp-buffer
|
||
(completion--insert-strings
|
||
'(("completion1" #("suffix1" 0 7 (face shadow)))))
|
||
(should (equal (get-text-property 12 'face) 'shadow)))
|
||
(with-temp-buffer
|
||
(completion--insert-strings
|
||
'(("completion1" "prefix1" "suffix1")))
|
||
(should (equal (get-text-property 19 'face) nil)))
|
||
(with-temp-buffer
|
||
(completion--insert-strings
|
||
'(("completion1" "prefix1" #("suffix1" 0 7 (face shadow)))))
|
||
(should (equal (get-text-property 19 'face) 'shadow))))
|
||
|
||
(ert-deftest completion-pcm--optimize-pattern ()
|
||
(should (equal (completion-pcm--optimize-pattern '("buf" point "f"))
|
||
'("buf" point "f")))
|
||
(should (equal (completion-pcm--optimize-pattern '(any "" any))
|
||
'(any))))
|
||
|
||
(defun test-completion-all-sorted-completions (base def history-var history-list)
|
||
(with-temp-buffer
|
||
(insert base)
|
||
(cl-letf (((symbol-function #'minibufferp) #'always))
|
||
(let ((completion-styles '(basic))
|
||
(completion-category-defaults nil)
|
||
(completion-category-overrides nil)
|
||
(minibuffer-history-variable history-var)
|
||
(minibuffer-history history-list)
|
||
(minibuffer-default def)
|
||
(minibuffer-completion-table
|
||
(lambda (str pred action)
|
||
(pcase action
|
||
(`(boundaries . ,_) `(boundaries ,(length base) . 0))
|
||
(_ (complete-with-action
|
||
action
|
||
'("epsilon" "alpha" "gamma" "beta" "delta")
|
||
(substring str (length base)) pred))))))
|
||
(completion-all-sorted-completions)))))
|
||
|
||
(ert-deftest completion-all-sorted-completions ()
|
||
;; No base, disabled history, no default
|
||
(should (equal (test-completion-all-sorted-completions
|
||
"" nil t nil)
|
||
`("beta" "alpha" "delta" "gamma" "epsilon" . 0)))
|
||
;; No base, disabled history, default string
|
||
(should (equal (test-completion-all-sorted-completions
|
||
"" "gamma" t nil)
|
||
`("gamma" "beta" "alpha" "delta" "epsilon" . 0)))
|
||
;; No base, empty history, default string
|
||
(should (equal (test-completion-all-sorted-completions
|
||
"" "gamma" 'minibuffer-history nil)
|
||
`("gamma" "beta" "alpha" "delta" "epsilon" . 0)))
|
||
;; No base, empty history, default list
|
||
(should (equal (test-completion-all-sorted-completions
|
||
"" '("gamma" "zeta") 'minibuffer-history nil)
|
||
`("gamma" "beta" "alpha" "delta" "epsilon" . 0)))
|
||
;; No base, history, default string
|
||
(should (equal (test-completion-all-sorted-completions
|
||
"" "gamma" 'minibuffer-history '("other" "epsilon" "delta"))
|
||
`("gamma" "epsilon" "delta" "beta" "alpha" . 0)))
|
||
;; Base, history, default string
|
||
(should (equal (test-completion-all-sorted-completions
|
||
"base/" "base/gamma" 'minibuffer-history
|
||
'("some/alpha" "base/epsilon" "base/delta"))
|
||
`("gamma" "epsilon" "delta" "beta" "alpha" . 5)))
|
||
;; Base, history, default string
|
||
(should (equal (test-completion-all-sorted-completions
|
||
"base/" "gamma" 'minibuffer-history
|
||
'("some/alpha" "base/epsilon" "base/delta"))
|
||
`("epsilon" "delta" "beta" "alpha" "gamma" . 5))))
|
||
|
||
(defun completion--pcm-score (comp)
|
||
"Get `completion-score' from COMP."
|
||
;; FIXME, uses minibuffer.el implementation details
|
||
(completion--flex-score comp completion-pcm--regexp))
|
||
|
||
(defun completion--pcm-first-difference-pos (comp)
|
||
"Get `completions-first-difference' from COMP."
|
||
(cl-loop for pos = (next-single-property-change 0 'face comp)
|
||
then (next-single-property-change pos 'face comp)
|
||
while pos
|
||
when (eq (get-text-property pos 'face comp)
|
||
'completions-first-difference)
|
||
return pos))
|
||
|
||
(ert-deftest completion-test--pcm-bug38458 ()
|
||
(should (equal (let ((completion-ignore-case t))
|
||
(completion-pcm--merge-try '("tes" point "ing")
|
||
'("Testing" "testing")
|
||
"" ""))
|
||
'("testing" . 4))))
|
||
|
||
(ert-deftest completion-pcm-test-1 ()
|
||
;; Point is at end, this does not match anything
|
||
(should (null
|
||
(completion-pcm-all-completions
|
||
"foo" '("hello" "world" "barfoobar") nil 3))))
|
||
|
||
(ert-deftest completion-pcm-test-2 ()
|
||
;; Point is at beginning, this matches "barfoobar"
|
||
(should (equal
|
||
(car (completion-pcm-all-completions
|
||
"foo" '("hello" "world" "barfoobar") nil 0))
|
||
"barfoobar")))
|
||
|
||
(ert-deftest completion-pcm-test-3 ()
|
||
;; Full match!
|
||
(should (eql
|
||
(completion--pcm-score
|
||
(car (completion-pcm-all-completions
|
||
"R" '("R" "hello") nil 1)))
|
||
1.0)))
|
||
|
||
(ert-deftest completion-pcm-test-4 ()
|
||
;; One fourth of a match and no match due to point being at the end
|
||
(should (eql
|
||
(completion--pcm-score
|
||
(car (completion-pcm-all-completions
|
||
"RO" '("RaOb") nil 1)))
|
||
(/ 1.0 4.0)))
|
||
(should (null
|
||
(completion-pcm-all-completions
|
||
"RO" '("RaOb") nil 2))))
|
||
|
||
(ert-deftest completion-pcm-test-5 ()
|
||
;; Since point is at the beginning, there is nothing that can really
|
||
;; be typed anymore
|
||
(should (null
|
||
(completion--pcm-first-difference-pos
|
||
(car (completion-pcm-all-completions
|
||
"f" '("few" "many") nil 0))))))
|
||
|
||
(ert-deftest completion-pcm-test-6 ()
|
||
;; Wildcards and delimiters work
|
||
(should (equal
|
||
(car (completion-pcm-all-completions
|
||
"li-pac*" '("list-packages") nil 7))
|
||
"list-packages"))
|
||
(should (null
|
||
(car (completion-pcm-all-completions
|
||
"li-pac*" '("do-not-list-packages") nil 7)))))
|
||
|
||
(ert-deftest completion-substring-test-1 ()
|
||
;; One third of a match!
|
||
(should (equal
|
||
(car (completion-substring-all-completions
|
||
"foo" '("hello" "world" "barfoobar") nil 3))
|
||
"barfoobar"))
|
||
(should (eql
|
||
(completion--pcm-score
|
||
(car (completion-substring-all-completions
|
||
"foo" '("hello" "world" "barfoobar") nil 3)))
|
||
(/ 1.0 3.0))))
|
||
|
||
(ert-deftest completion-substring-test-2 ()
|
||
;; Full match!
|
||
(should (eql
|
||
(completion--pcm-score
|
||
(car (completion-substring-all-completions
|
||
"R" '("R" "hello") nil 1)))
|
||
1.0)))
|
||
|
||
(ert-deftest completion-substring-test-3 ()
|
||
;; Substring match
|
||
(should (equal
|
||
(car (completion-substring-all-completions
|
||
"custgroup" '("customize-group") nil 4))
|
||
"customize-group"))
|
||
(should (null
|
||
(car (completion-substring-all-completions
|
||
"custgroup" '("customize-group") nil 5)))))
|
||
|
||
(ert-deftest completion-substring-test-4 ()
|
||
;; `completions-first-difference' should be at the right place
|
||
(should (eql
|
||
(completion--pcm-first-difference-pos
|
||
(car (completion-substring-all-completions
|
||
"jab" '("dabjobstabby" "many") nil 1)))
|
||
4))
|
||
(should (null
|
||
(completion--pcm-first-difference-pos
|
||
(car (completion-substring-all-completions
|
||
"jab" '("dabjabstabby" "many") nil 1)))))
|
||
(should (equal
|
||
(completion--pcm-first-difference-pos
|
||
(car (completion-substring-all-completions
|
||
"jab" '("dabjabstabby" "many") nil 3)))
|
||
6)))
|
||
|
||
(ert-deftest completion-substring-test-5 ()
|
||
;; merge-completions needs to work correctly when
|
||
(should (equal
|
||
(completion-pcm--merge-completions '("ab" "sab") '(prefix "b"))
|
||
'("b" "a" prefix)))
|
||
(should (equal
|
||
(completion-pcm--merge-completions '("ab" "ab") '(prefix "b"))
|
||
'("b" "a")))
|
||
;; substring completion should successfully complete the entire string
|
||
(should (equal
|
||
(completion-substring-try-completion "b" '("ab" "ab") nil 0)
|
||
'("ab" . 2))))
|
||
|
||
(ert-deftest completion-flex-test-1 ()
|
||
;; Fuzzy match
|
||
(should (equal
|
||
(car (completion-flex-all-completions
|
||
"foo" '("hello" "world" "fabrobazo") nil 3))
|
||
"fabrobazo")))
|
||
|
||
(ert-deftest completion-flex-test-2 ()
|
||
;; Full match!
|
||
(should (eql
|
||
(completion--pcm-score
|
||
(car (completion-flex-all-completions
|
||
"R" '("R" "hello") nil 1)))
|
||
1.0)))
|
||
|
||
(ert-deftest completion-flex-test-3 ()
|
||
;; Another fuzzy match, but more of a "substring" one
|
||
(should (equal
|
||
(car (completion-flex-all-completions
|
||
"custgroup" '("customize-group-other-window") nil 4))
|
||
"customize-group-other-window"))
|
||
;; `completions-first-difference' should be at the right place
|
||
(should (equal
|
||
(completion--pcm-first-difference-pos
|
||
(car (completion-flex-all-completions
|
||
"custgroup" '("customize-group-other-window") nil 4)))
|
||
4))
|
||
(should (equal
|
||
(completion--pcm-first-difference-pos
|
||
(car (completion-flex-all-completions
|
||
"custgroup" '("customize-group-other-window") nil 9)))
|
||
15)))
|
||
|
||
|
||
(defmacro completing-read-with-minibuffer-setup (collection &rest body)
|
||
(declare (indent 1) (debug (collection body)))
|
||
`(catch 'result
|
||
(minibuffer-with-setup-hook
|
||
(lambda ()
|
||
(let ((redisplay-skip-initial-frame nil)
|
||
(executing-kbd-macro nil)) ; Don't skip redisplay
|
||
(throw 'result (progn . ,body))))
|
||
(let ((executing-kbd-macro t)) ; Force the real minibuffer
|
||
(completing-read "Prompt: " ,collection)))))
|
||
|
||
(ert-deftest completion-auto-help-test ()
|
||
(let (messages)
|
||
(cl-letf* (((symbol-function 'minibuffer-message)
|
||
(lambda (message &rest args)
|
||
(push (apply #'format-message message args) messages))))
|
||
(let ((completion-auto-help nil))
|
||
(completing-read-with-minibuffer-setup
|
||
'("a" "ab" "ac")
|
||
(execute-kbd-macro (kbd "a TAB TAB"))
|
||
(should (equal (car messages) "Complete, but not unique"))
|
||
(should-not (get-buffer-window "*Completions*" 0))
|
||
(execute-kbd-macro (kbd "b TAB"))
|
||
(should (equal (car messages) "Sole completion"))))
|
||
(let ((completion-auto-help t))
|
||
(completing-read-with-minibuffer-setup
|
||
'("a" "ab" "ac")
|
||
(execute-kbd-macro (kbd "a TAB TAB"))
|
||
(should (get-buffer-window "*Completions*" 0))
|
||
(execute-kbd-macro (kbd "b TAB"))
|
||
(should (equal (car messages) "Sole completion"))))
|
||
(let ((completion-auto-help 'visible))
|
||
(completing-read-with-minibuffer-setup
|
||
'("a" "ab" "ac" "achoo")
|
||
(execute-kbd-macro (kbd "a TAB TAB"))
|
||
(should (get-buffer-window "*Completions*" 0))
|
||
(execute-kbd-macro (kbd "ch TAB"))
|
||
(should (equal (car messages) "Sole completion")))))))
|
||
|
||
(ert-deftest completion-auto-select-test ()
|
||
(let ((completion-auto-select t))
|
||
(completing-read-with-minibuffer-setup
|
||
'("aa" "ab" "ac")
|
||
(execute-kbd-macro (kbd "a TAB"))
|
||
(should (and (get-buffer-window "*Completions*" 0)
|
||
(eq (current-buffer) (get-buffer "*Completions*"))))
|
||
(execute-kbd-macro (kbd "TAB TAB TAB"))
|
||
(should (and (get-buffer-window "*Completions*" 0)
|
||
(eq (current-buffer) (get-buffer " *Minibuf-1*"))))
|
||
(execute-kbd-macro (kbd "S-TAB"))
|
||
(should (and (get-buffer-window "*Completions*" 0)
|
||
(eq (current-buffer) (get-buffer "*Completions*"))))))
|
||
(let ((completion-auto-select 'second-tab))
|
||
(completing-read-with-minibuffer-setup
|
||
'("aa" "ab" "ac")
|
||
(execute-kbd-macro (kbd "a TAB"))
|
||
(should (and (get-buffer-window "*Completions*" 0)
|
||
(not (eq (current-buffer) (get-buffer "*Completions*")))))
|
||
(execute-kbd-macro (kbd "TAB TAB"))
|
||
(should (eq (current-buffer) (get-buffer "*Completions*"))))))
|
||
|
||
(ert-deftest completion-auto-wrap-test ()
|
||
(let ((completion-auto-wrap nil))
|
||
(completing-read-with-minibuffer-setup
|
||
'("aa" "ab" "ac")
|
||
(insert "a")
|
||
(minibuffer-completion-help)
|
||
(switch-to-completions)
|
||
(should (equal "aa" (get-text-property (point) 'completion--string)))
|
||
(next-completion 2)
|
||
(should (equal "ac" (get-text-property (point) 'completion--string)))
|
||
;; Fixed in bug#54374
|
||
(next-completion 5)
|
||
(should (equal "ac" (get-text-property (point) 'completion--string)))
|
||
(previous-completion 5)
|
||
(should (equal "aa" (get-text-property (point) 'completion--string)))
|
||
|
||
(first-completion)
|
||
(should (equal "aa" (get-text-property (point) 'completion--string)))
|
||
(next-line-completion 2)
|
||
(should (equal "ac" (get-text-property (point) 'completion--string)))
|
||
(next-line-completion 5)
|
||
(should (equal "ac" (get-text-property (point) 'completion--string)))
|
||
(previous-line-completion 5)
|
||
(should (equal "aa" (get-text-property (point) 'completion--string)))
|
||
(goto-char (point-min))
|
||
(next-line-completion 5)
|
||
(should (equal "ac" (get-text-property (point) 'completion--string)))
|
||
(goto-char (point-min))
|
||
(previous-line-completion 5)
|
||
(should (equal "aa" (get-text-property (point) 'completion--string)))))
|
||
(let ((completion-auto-wrap t))
|
||
(completing-read-with-minibuffer-setup
|
||
'("aa" "ab" "ac")
|
||
(insert "a")
|
||
(minibuffer-completion-help)
|
||
(switch-to-completions)
|
||
(should (equal "aa" (get-text-property (point) 'completion--string)))
|
||
(next-completion 2)
|
||
(should (equal "ac" (get-text-property (point) 'completion--string)))
|
||
(next-completion 1)
|
||
(should (equal "aa" (get-text-property (point) 'completion--string)))
|
||
(previous-completion 1)
|
||
(should (equal "ac" (get-text-property (point) 'completion--string)))
|
||
|
||
(first-completion)
|
||
(should (equal "aa" (get-text-property (point) 'completion--string)))
|
||
(next-line-completion 2)
|
||
(should (equal "ac" (get-text-property (point) 'completion--string)))
|
||
(next-line-completion 1)
|
||
(should (equal "aa" (get-text-property (point) 'completion--string)))
|
||
(previous-line-completion 1)
|
||
(should (equal "ac" (get-text-property (point) 'completion--string)))
|
||
(goto-char (point-min))
|
||
(next-line-completion 4)
|
||
(should (equal "aa" (get-text-property (point) 'completion--string)))
|
||
(goto-char (point-min))
|
||
(previous-line-completion 4)
|
||
(should (equal "ac" (get-text-property (point) 'completion--string))))))
|
||
|
||
(ert-deftest completion-next-line-multline-test ()
|
||
(let ((completion-auto-wrap t))
|
||
(completing-read-with-minibuffer-setup
|
||
'("a\na" "a\nb" "ac")
|
||
(insert "a")
|
||
(minibuffer-completion-help)
|
||
(switch-to-completions)
|
||
(goto-char (point-min))
|
||
(next-line-completion 5)
|
||
(should (equal "a\nb" (get-text-property (point) 'completion--string)))
|
||
(goto-char (point-min))
|
||
(previous-line-completion 5)
|
||
(should (equal "a\nb" (get-text-property (point) 'completion--string))))))
|
||
|
||
(ert-deftest completions-header-format-test ()
|
||
(let ((completion-show-help nil)
|
||
(completions-header-format nil))
|
||
(completing-read-with-minibuffer-setup
|
||
'("aa" "ab" "ac")
|
||
(insert "a")
|
||
(minibuffer-completion-help)
|
||
(switch-to-completions)
|
||
;; Fixed in bug#55430
|
||
(should (equal "aa" (get-text-property (point) 'completion--string)))
|
||
(next-completion 2)
|
||
(should (equal "ac" (get-text-property (point) 'completion--string)))
|
||
(previous-completion 2)
|
||
(should (equal "aa" (get-text-property (point) 'completion--string)))
|
||
;; Fixed in bug#54374
|
||
(previous-completion 1)
|
||
(should (equal "ac" (get-text-property (point) 'completion--string)))
|
||
(next-completion 1)
|
||
(should (equal "aa" (get-text-property (point) 'completion--string)))
|
||
|
||
(next-line-completion 2)
|
||
(should (equal "ac" (get-text-property (point) 'completion--string)))
|
||
(previous-line-completion 2)
|
||
(should (equal "aa" (get-text-property (point) 'completion--string)))
|
||
(previous-line-completion 1)
|
||
(should (equal "ac" (get-text-property (point) 'completion--string)))
|
||
(next-line-completion 1)
|
||
(should (equal "aa" (get-text-property (point) 'completion--string)))
|
||
|
||
;; Fixed in bug#55430
|
||
(execute-kbd-macro (kbd "C-u RET"))
|
||
(should (equal (minibuffer-contents) "aa")))
|
||
(completing-read-with-minibuffer-setup
|
||
'("aa" "ab" "ac")
|
||
;; Fixed in bug#55289
|
||
(execute-kbd-macro (kbd "a M-<up> M-<down>"))
|
||
(should (equal (minibuffer-contents) "aa")))))
|
||
|
||
(ert-deftest completions-affixation-navigation-test ()
|
||
(let ((completion-extra-properties
|
||
`(:affixation-function
|
||
,(lambda (completions)
|
||
(mapcar (lambda (c)
|
||
(list c "prefix " " suffix"))
|
||
completions)))))
|
||
(completing-read-with-minibuffer-setup
|
||
'("aa" "ab" "ac")
|
||
(insert "a")
|
||
(minibuffer-completion-help)
|
||
(switch-to-completions)
|
||
(should (equal 'highlight (get-text-property (point) 'mouse-face)))
|
||
(should (equal "aa" (get-text-property (point) 'completion--string)))
|
||
(let ((completion-auto-wrap t))
|
||
(next-completion 3))
|
||
(should (equal 'highlight (get-text-property (point) 'mouse-face)))
|
||
(should (equal "aa" (get-text-property (point) 'completion--string)))
|
||
(let ((completion-auto-wrap nil))
|
||
(next-completion 3))
|
||
(should (equal 'highlight (get-text-property (point) 'mouse-face)))
|
||
(should (equal "ac" (get-text-property (point) 'completion--string)))
|
||
;; Fixed in bug#54374
|
||
(goto-char (1- (point-max)))
|
||
(should-not (equal 'highlight (get-text-property (point) 'mouse-face)))
|
||
|
||
(first-completion)
|
||
(should (equal "aa" (get-text-property (point) 'completion--string)))
|
||
(let ((completion-auto-wrap t))
|
||
(next-line-completion 3))
|
||
(should (equal "aa" (get-text-property (point) 'completion--string)))
|
||
(let ((completion-auto-wrap nil))
|
||
(next-line-completion 3))
|
||
(should (equal "ac" (get-text-property (point) 'completion--string)))
|
||
|
||
(execute-kbd-macro (kbd "C-u RET"))
|
||
(should (equal (minibuffer-contents) "ac")))))
|
||
|
||
(ert-deftest completions-group-navigation-test ()
|
||
(completing-read-with-minibuffer-setup
|
||
(lambda (string pred action)
|
||
(if (eq action 'metadata)
|
||
`(metadata
|
||
(group-function
|
||
. ,(lambda (name transform)
|
||
(if transform
|
||
name
|
||
(pcase name
|
||
(`"aa1" "Group 1")
|
||
(`"aa2" "Group 1")
|
||
(`"aa3" "Group 1")
|
||
(`"aa4" "Group 1")
|
||
(`"ab1" "Group 2")
|
||
(`"ac1" "Group 3")
|
||
(`"ac2" "Group 3")))))
|
||
(category . unicode-name))
|
||
(complete-with-action action '("aa1" "aa2" "aa3" "aa4" "ab1" "ac1" "ac2")
|
||
string pred)))
|
||
(insert "a")
|
||
(minibuffer-completion-help)
|
||
(switch-to-completions)
|
||
(should (equal "aa1" (get-text-property (point) 'completion--string)))
|
||
(let ((completion-auto-wrap t))
|
||
(next-completion 7))
|
||
(should (equal "aa1" (get-text-property (point) 'completion--string)))
|
||
(let ((completion-auto-wrap nil))
|
||
(next-completion 7))
|
||
(should (equal "ac2" (get-text-property (point) 'completion--string)))
|
||
|
||
(let ((completion-auto-wrap t))
|
||
;; First column
|
||
(first-completion)
|
||
(next-line-completion 1)
|
||
(should (equal "aa4" (get-text-property (point) 'completion--string)))
|
||
(next-line-completion 3)
|
||
(should (equal "aa1" (get-text-property (point) 'completion--string)))
|
||
(previous-line-completion 2)
|
||
(should (equal "ab1" (get-text-property (point) 'completion--string)))
|
||
|
||
;; Second column
|
||
(first-completion)
|
||
(next-completion 1)
|
||
(should (equal "aa2" (get-text-property (point) 'completion--string)))
|
||
(next-line-completion 1)
|
||
(should (equal "ac2" (get-text-property (point) 'completion--string)))
|
||
(next-line-completion 1)
|
||
(should (equal "aa2" (get-text-property (point) 'completion--string)))
|
||
(previous-line-completion 1)
|
||
(should (equal "ac2" (get-text-property (point) 'completion--string)))
|
||
(previous-line-completion 1)
|
||
(should (equal "aa2" (get-text-property (point) 'completion--string)))
|
||
|
||
;; Third column
|
||
(first-completion)
|
||
(next-completion 2)
|
||
(should (equal "aa3" (get-text-property (point) 'completion--string)))
|
||
(next-line-completion 1)
|
||
(should (equal "aa3" (get-text-property (point) 'completion--string))))
|
||
|
||
(let ((completion-auto-wrap nil))
|
||
(first-completion)
|
||
(next-line-completion 7)
|
||
(should (equal "ac2" (get-text-property (point) 'completion--string)))
|
||
(previous-line-completion 7)
|
||
(should (equal "aa1" (get-text-property (point) 'completion--string))))))
|
||
|
||
(ert-deftest completion-cycle ()
|
||
(completing-read-with-minibuffer-setup '("aaa" "bbb" "ccc")
|
||
(let ((completion-cycle-threshold t))
|
||
(execute-kbd-macro (kbd "TAB TAB TAB"))
|
||
(should (equal (minibuffer-contents) "ccc")))))
|
||
|
||
(ert-deftest minibuffer-next-completion ()
|
||
(let ((default-directory (ert-resource-directory)))
|
||
(completing-read-with-minibuffer-setup #'read-file-name-internal
|
||
(insert "d/")
|
||
(execute-kbd-macro (kbd "M-<down> M-<down> M-<down>"))
|
||
(should (equal "data/minibuffer-test-cttq$$tion" (minibuffer-contents))))))
|
||
|
||
(provide 'minibuffer-tests)
|
||
;;; minibuffer-tests.el ends here
|