mirror of
git://git.sv.gnu.org/emacs.git
synced 2025-12-05 22:20:24 -08:00
e10c4982dc
The core of the problem is that `completion-pcm--prepare-delim-re` is designed to match a "delimiter" in the pattern but was misused to match a sequence of delimiter chars in the completions. * lisp/minibuffer.el (completion-pcm--delim-re): Rename from `completion-pcm--prepare-delim-re` and change its calling convention. (completion-pcm--segments->regex): Use it. (completion-pcm-word-delimiters): Adjust accordingly. * test/lisp/minibuffer-tests.el (completion-pcm--test-zerowidth-delim): New test.
1209 lines
52 KiB
EmacsLisp
1209 lines
52 KiB
EmacsLisp
;;; minibuffer-tests.el --- Tests for completion functions -*- lexical-binding: t; -*-
|
||
|
||
;; Copyright (C) 2013-2025 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-c" "lisp/c${CTTQ1}et/semantic-utest-c.test")
|
||
("lisp/ced${CTTQ2}se-u-c" "lisp/ced${CTTQ2}semantic-utest-c.test")
|
||
;; Test that env-vars don't prevent partial-completion.
|
||
("lis/c${CTTQ1}/se-u-c" "lisp/c${CTTQ1}et/semantic-utest-c.test")
|
||
))
|
||
(should (equal (completion-try-completion input
|
||
#'completion--file-name-table
|
||
nil (length input))
|
||
(cons output (length output)))))
|
||
;; Everything also works with `completion-ignore-case'.
|
||
(let ((completion-ignore-case t))
|
||
(pcase-dolist (`(,input ,output)
|
||
'(
|
||
("data/M-CTTQ" "data/minibuffer-test-cttq$$tion")
|
||
("data/M-CTTQ$$t" "data/minibuffer-test-cttq$$tion")
|
||
;; When an env var is in the completion bounds, try-completion
|
||
;; won't change letter case.
|
||
("lisp/c${CTTQ1}E" "lisp/c${CTTQ1}Et/")
|
||
("lisp/ced${CTTQ2}SE-U-c" "lisp/ced${CTTQ2}SEmantic-utest-c.test")
|
||
;; If the env var is before the completion bounds, try-completion
|
||
;; *will* change letter case.
|
||
("lisp/c${CTTQ1}et/SE-U-c" "lisp/c${CTTQ1}et/semantic-utest-c.test")
|
||
("lis/c${CTTQ1}/SE-U-c" "lisp/c${CTTQ1}et/semantic-utest-c.test")
|
||
))
|
||
(should (equal (car (completion-try-completion input
|
||
#'completion--file-name-table
|
||
nil (length input)))
|
||
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" . 7)))
|
||
(should (equal
|
||
(let ((completion-ignore-case t))
|
||
(completion-pcm-try-completion "tes" '("Testing" "testing") nil 3))
|
||
'("testing" . 7))))
|
||
|
||
(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)))))
|
||
(should (equal
|
||
(completion--pcm-first-difference-pos
|
||
(car (completion-pcm-all-completions
|
||
"a*" '("ab" "ac") nil 2)))
|
||
1))
|
||
(should (equal
|
||
(completion--pcm-first-difference-pos
|
||
(car (completion-pcm-all-completions
|
||
"a*" '("ab" "ac") nil 1)))
|
||
1))
|
||
(should (equal
|
||
(completion--pcm-first-difference-pos
|
||
(car (completion-pcm-all-completions
|
||
"a*x" '("abx" "acx") nil 2)))
|
||
1))
|
||
(should (equal
|
||
(completion--pcm-first-difference-pos
|
||
(car (completion-pcm-all-completions
|
||
"a*x" '("abxd" "acxe") nil 3)))
|
||
;; FIXME: the highlighting should start at the 4th character
|
||
;; rather than the third.
|
||
3)))
|
||
|
||
(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-pcm-test-7 ()
|
||
;; Wildcards are preserved even when right before a delimiter.
|
||
(should (equal
|
||
(completion-pcm-try-completion
|
||
"x*/"
|
||
'("x1/y1" "x2/y2")
|
||
nil 3)
|
||
'("x*/y" . 4)))
|
||
;; Or around point.
|
||
(should (equal
|
||
(completion-pcm--merge-try
|
||
'(point star "foo") '("xxfoo" "xyfoo") "" "")
|
||
'("x*foo" . 1)))
|
||
(should (equal
|
||
(completion-pcm--merge-try
|
||
'(star point "foo") '("xxfoo" "xyfoo") "" "")
|
||
'("x*foo" . 2)))
|
||
;; This is important if the wildcard is at the start of a component.
|
||
(should (equal
|
||
(completion-pcm-try-completion
|
||
"*/minibuf"
|
||
'("lisp/minibuffer.el" "src/minibuf.c")
|
||
nil 9)
|
||
'("*/minibuf" . 9)))
|
||
;; A series of wildcards is preserved (for now), along with point's position.
|
||
(should (equal
|
||
(completion-pcm--merge-try
|
||
'(star star point star "foo") '("xxfoo" "xyfoo") "" "")
|
||
'("x***foo" . 3)))
|
||
;; The series of wildcards is considered together; if any of them wants the common suffix, it's generated.
|
||
(should (equal
|
||
(completion-pcm--merge-try
|
||
'(prefix any) '("xfoo" "yfoo") "" "")
|
||
'("foo" . 0)))
|
||
;; We consider each series of wildcards separately: if one series
|
||
;; wants the common suffix, but the next one does not, it doesn't get
|
||
;; the common suffix.
|
||
(should (equal
|
||
(completion-pcm--merge-try
|
||
'(prefix any "bar" any) '("xbarxfoo" "ybaryfoo") "" "")
|
||
'("bar" . 3))))
|
||
|
||
(ert-deftest completion-pcm-test-8 ()
|
||
;; try-completion inserts the common prefix and suffix at point.
|
||
(should (equal (completion-pcm-try-completion
|
||
"r" '("fooxbar" "fooybar") nil 0)
|
||
'("foobar" . 3)))
|
||
;; Even if point is at the end of the minibuffer.
|
||
(should (equal (completion-pcm-try-completion
|
||
"" '("fooxbar" "fooybar") nil 0)
|
||
'("foobar" . 3))))
|
||
|
||
(ert-deftest completion-pcm-test-anydelim ()
|
||
;; After each delimiter is a special wildcard which matches any
|
||
;; sequence of delimiters.
|
||
(should (equal (completion-pcm-try-completion
|
||
"-x" '("-_.x" "-__x") nil 2)
|
||
'("-_x" . 3))))
|
||
|
||
(ert-deftest completion-pcm-test-pattern->regex ()
|
||
(should (equal (completion-pcm--pattern->regex
|
||
'("A" any prefix "B" point "C"))
|
||
"\\`A[^z-a]*?B[^z-a]*?C"))
|
||
(should (equal (completion-pcm--pattern->regex
|
||
'(any any-delim prefix "A" "B" "C"))
|
||
"\\`[^z-a]*?ABC"))
|
||
(should (equal (completion-pcm--pattern->regex
|
||
'(any-delim "A" "B" star "C"))
|
||
"\\`[-_./:| *]*?AB[^z-a]*?C"))
|
||
(should (equal (completion-pcm--pattern->regex
|
||
'(any "A" any-delim "B" any-delim "C" any))
|
||
"\\`[^z-a]*?A[-_./:| *]*?B[-_./:| *]*?C[^z-a]*?")))
|
||
|
||
(ert-deftest completion-pcm--test-zerowidth-delim ()
|
||
(let ((completion-pcm--delim-wild-regex ; Let "u8" complete to "utf-8".
|
||
(concat "\\(?:" completion-pcm--delim-wild-regex
|
||
"\\|\\([[:alpha:]]\\)[[:digit:]]\\)")))
|
||
(should (equal (car (completion-try-completion
|
||
"u8-d" '("utf-8-dos" "utf-8-foo-dos" "utf-8-unix")
|
||
nil 4))
|
||
"utf-8-dos"))))
|
||
|
||
(ert-deftest completion-pcm-bug4219 ()
|
||
;; With `completion-ignore-case', try-completion should change the
|
||
;; case of existing text when the completions have different casing.
|
||
(should (equal
|
||
(let ((completion-ignore-case t))
|
||
(completion-pcm-try-completion "a" '("ABC" "ABD") nil 1))
|
||
'("AB" . 2)))
|
||
;; Even when the text isn't growing.
|
||
(should (equal
|
||
(let ((completion-ignore-case t))
|
||
(completion-pcm-try-completion "ab" '("ABC" "ABD") nil 2))
|
||
'("AB" . 2)))
|
||
;; Or when point is in the middle of the region changing case.
|
||
(should (equal
|
||
(let ((completion-ignore-case t))
|
||
(completion-pcm-try-completion "ab" '("ABC" "ABD") nil 1))
|
||
'("AB" . 2)))
|
||
;; Even when the existing minibuffer contents has mixed case.
|
||
(should (equal
|
||
(let ((completion-ignore-case t))
|
||
(completion-pcm-try-completion "Ab" '("ABC" "ABD") nil 1))
|
||
'("AB" . 2)))
|
||
;; But not if the completions don't actually all have the same case.
|
||
(should (equal
|
||
(let ((completion-ignore-case t))
|
||
(completion-pcm-try-completion "Ab" '("abc" "ABD") nil 1))
|
||
'("Ab" . 2)))
|
||
;; We don't change case if it doesn't match all of the completions, though.
|
||
(should (equal
|
||
(let ((completion-ignore-case t)) (try-completion "a" '("ax" "Ay")))
|
||
"a"))
|
||
(should (equal
|
||
(let ((completion-ignore-case t)) (try-completion "a" '("Ay" "ax")))
|
||
"a")))
|
||
|
||
(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 ()
|
||
;; Normally a `prefix' wildcard ignores the common prefix to its
|
||
;; left, since it only grows the common suffix; but if that common
|
||
;; prefix is also a common suffix, it should be included.
|
||
(should (equal
|
||
(completion-pcm--merge-try '(prefix "b") '("ab" "sab") "" "")
|
||
'("ab" . 2)))
|
||
(should (equal
|
||
(completion-pcm--merge-try '(prefix "b") '("ab" "ab") "" "")
|
||
'("ab" . 2)))
|
||
;; When there's a fixed string before `prefix', that fixed string
|
||
;; should always be included.
|
||
(should (equal
|
||
(completion-pcm--merge-try '("a" prefix "b") '("axb" "ayb") "" "")
|
||
'("ab" . 2)))
|
||
;; Letter-casing from the completions on the common prefix is still applied.
|
||
(should (equal
|
||
(let ((completion-ignore-case t))
|
||
(completion-pcm--merge-try '("a" prefix "b") '("Axb" "Ayb") "" ""))
|
||
'("Ab" . 2)))
|
||
(should (equal
|
||
(let ((completion-ignore-case t))
|
||
(completion-pcm--merge-try '("a" prefix "b") '("AAxb" "AAyb") "" ""))
|
||
'("Ab" . 2)))
|
||
;; 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 with-minibuffer-setup (completing-read &rest body)
|
||
(declare (indent 1) (debug t))
|
||
`(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))))
|
||
|
||
(defmacro completing-read-with-minibuffer-setup (collection &rest body)
|
||
(declare (indent 1) (debug t))
|
||
`(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 (minibuffer--completions-visible))
|
||
(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 (minibuffer--completions-visible))
|
||
(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 (minibuffer--completions-visible))
|
||
(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 (minibuffer--completions-visible)
|
||
(eq (current-buffer) (get-buffer "*Completions*"))))
|
||
(execute-kbd-macro (kbd "TAB TAB TAB"))
|
||
(should (and (minibuffer--completions-visible)
|
||
(eq (current-buffer) (get-buffer " *Minibuf-1*"))))
|
||
(execute-kbd-macro (kbd "S-TAB"))
|
||
(should (and (minibuffer--completions-visible)
|
||
(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 (minibuffer--completions-visible)
|
||
(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)
|
||
(minibuffer-completion-auto-choose t)
|
||
(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 "ac1" (get-text-property (point) 'completion--string)))
|
||
(previous-line-completion 7)
|
||
(should (equal "aa1" (get-text-property (point) 'completion--string))))))
|
||
|
||
(defun completions-format-navigation--tests (n)
|
||
"Make tests for navigating buffer of N completion candidate.
|
||
The tests check expected results of navigating with and without wrapping
|
||
for combinations of the values of `completion-auto-wrap' and
|
||
`completions-format' (see bug#78959 for motivation and discussion of the
|
||
expected behavior). The tests are actually run by calling this
|
||
function, with specific values of N (> 1 to have a \"*Completions*\"
|
||
buffer), from functions defined by `ert-deftest.'"
|
||
(let* (
|
||
;; Make list of N unique completions.
|
||
(letters (mapcar 'string (number-sequence 97 122)))
|
||
(gen-compl (lambda (x)
|
||
(let (comps)
|
||
(dotimes (_ x)
|
||
(push (concat (car comps) (pop letters)) comps))
|
||
(nreverse comps))))
|
||
(completions (funcall gen-compl n))
|
||
|
||
;; Navigation tests.
|
||
;; (i) For both horizontal and vertical formats.
|
||
(all-completions
|
||
(lambda (type)
|
||
(let ((next-fn (pcase type
|
||
('any 'next-completion)
|
||
('column 'next-column-completion)
|
||
('line 'next-line-completion)))
|
||
(prev-fn (pcase type
|
||
('any 'previous-completion)
|
||
('column 'previous-column-completion)
|
||
('line 'previous-line-completion))))
|
||
(completing-read-with-minibuffer-setup completions
|
||
(insert (car completions))
|
||
(minibuffer-completion-help)
|
||
(switch-to-completions)
|
||
;; Sanity check that we're on first completion candidate.
|
||
(should
|
||
(equal (car completions)
|
||
(get-text-property (point) 'completion--string)))
|
||
;; Double check.
|
||
(first-completion)
|
||
(should
|
||
(equal (car completions)
|
||
(get-text-property (point) 'completion--string)))
|
||
;; Test moving from first to Ith next completion
|
||
;; candidate (0<I<N-1).
|
||
(dolist (i (number-sequence 1 (1- n)))
|
||
(funcall next-fn i)
|
||
(should
|
||
(equal (nth i completions)
|
||
(get-text-property (point) 'completion--string)))
|
||
(if (< i (1- n))
|
||
(first-completion)
|
||
(last-completion)
|
||
(should
|
||
(equal (nth i completions)
|
||
(get-text-property (point) 'completion--string)))
|
||
(funcall next-fn 1)
|
||
(if completion-auto-wrap
|
||
;; Wrap around to first completion candidate.
|
||
(should
|
||
(equal (car completions)
|
||
(get-text-property (point) 'completion--string)))
|
||
;; No wrapping.
|
||
(should
|
||
(equal (nth i completions)
|
||
(get-text-property (point) 'completion--string))))))
|
||
(last-completion)
|
||
;; Test moving from last to Ith previous completion
|
||
;; candidate (0<I<N-1).
|
||
(dolist (i (number-sequence 1 (1- n)))
|
||
(funcall prev-fn i)
|
||
(should
|
||
(equal (nth (- n i 1) completions)
|
||
(get-text-property (point) 'completion--string)))
|
||
(if (< i (1- n))
|
||
(last-completion)
|
||
(first-completion)
|
||
(should
|
||
(equal (car completions)
|
||
(get-text-property (point) 'completion--string)))
|
||
(funcall prev-fn 1)
|
||
(if completion-auto-wrap
|
||
;; Wrap around to last completion candidate.
|
||
(should
|
||
(equal (nth (1- n) completions)
|
||
(get-text-property (point) 'completion--string)))
|
||
;; No wrapping.
|
||
(should
|
||
(equal (car completions)
|
||
(get-text-property (point)
|
||
'completion--string))))))))))
|
||
|
||
;; (ii) Only for horizontal format.
|
||
(within-column
|
||
(lambda ()
|
||
(completing-read-with-minibuffer-setup completions
|
||
(insert (car completions))
|
||
(minibuffer-completion-help)
|
||
(switch-to-completions)
|
||
(while (not (eolp))
|
||
(completion--move-to-candidate-start)
|
||
(let* ((first (get-text-property (point) 'completion--string))
|
||
(pos (point))
|
||
(i 0)
|
||
last1 last2)
|
||
;; Keep moving to next completion candidate in this
|
||
;; column until we reach the last one, and then wrap
|
||
;; back to the first candidate, if
|
||
;; `completion-auto-wrap' is non-nil, otherwise stay
|
||
;; on the last one.
|
||
(while (or (and completion-auto-wrap
|
||
(not (equal last1 first)))
|
||
(not (equal last1
|
||
(get-text-property
|
||
(point) 'completion--string))))
|
||
(setq last2 last1)
|
||
(next-line-completion 1)
|
||
(incf i)
|
||
;; Set `last1' to either the first or last
|
||
;; candidate, depending on the value of
|
||
;; `completion-auto-wrap'.
|
||
(setq last1 (get-text-property (point) 'completion--string)))
|
||
(setq last1 last2
|
||
last2 nil)
|
||
(decf i)
|
||
(when completion-auto-wrap
|
||
(should (equal (get-text-property (point) 'completion--string)
|
||
first))
|
||
;; Test wrapping from last to first line in this column.
|
||
(next-line-completion i) ; Move to last candidate.
|
||
(should (equal (get-text-property (point) 'completion--string)
|
||
last1)))
|
||
;; Now keeping move from last to first completion
|
||
;; candidate in this column.
|
||
(while (or (not (equal last2 first))
|
||
(not (equal last2
|
||
(get-text-property
|
||
(point) 'completion--string))))
|
||
(previous-line-completion 1)
|
||
(setq last2 (get-text-property (point) 'completion--string)))
|
||
;; Test wrapping from first to last line in this column.
|
||
(when completion-auto-wrap
|
||
(should (equal (get-text-property (point) 'completion--string)
|
||
first))
|
||
(next-line-completion i)
|
||
(should (equal (get-text-property (point) 'completion--string)
|
||
last1)))
|
||
;; Move to first candidate in next column to continue loop
|
||
(completion--move-to-candidate-end)
|
||
(unless (eolp)
|
||
(goto-char pos)
|
||
(next-column-completion 1)))))))
|
||
|
||
;; (iii) Only for vertical format.
|
||
(within-line
|
||
(lambda ()
|
||
(completing-read-with-minibuffer-setup completions
|
||
(insert (car completions))
|
||
(minibuffer-completion-help)
|
||
(switch-to-completions)
|
||
(let ((one-col (save-excursion
|
||
(first-completion)
|
||
(completion--move-to-candidate-end)
|
||
(eolp))))
|
||
(while (not (eobp))
|
||
(let ((first (get-text-property (point) 'completion--string))
|
||
last pos)
|
||
;; Test moving to next column in this line.
|
||
(while (not (eolp))
|
||
(next-column-completion 1)
|
||
(let ((next (get-text-property (point) 'completion--string)))
|
||
(should
|
||
;; FIXME: tautology?
|
||
(equal (nth (seq-position completions next) completions)
|
||
next)))
|
||
;; If this is the last completion in this line,
|
||
;; exit the loop.
|
||
(when (or (> (current-column) 0)
|
||
(save-excursion (and (forward-line) (eobp)))
|
||
(unless one-col
|
||
(save-excursion
|
||
(and (progn
|
||
(completion--move-to-candidate-start)
|
||
(bolp))
|
||
(progn
|
||
(completion--move-to-candidate-end)
|
||
(eolp))))))
|
||
(completion--move-to-candidate-end)))
|
||
(backward-char)
|
||
(completion--move-to-candidate-start)
|
||
(setq last (get-text-property (point) 'completion--string)
|
||
pos (point))
|
||
;; We're on the last column, so next move either
|
||
;; wraps or stays put.
|
||
(next-column-completion 1)
|
||
(if completion-auto-wrap
|
||
;; We wrapped around to first candidate in this line.
|
||
(progn
|
||
(should (bolp))
|
||
(should
|
||
(equal (get-text-property (point) 'completion--string)
|
||
first))
|
||
;; Go back to last completion in this line for next test.
|
||
(goto-char (if one-col pos (pos-eol)))
|
||
(backward-char))
|
||
(should
|
||
(equal (get-text-property (point) 'completion--string)
|
||
last)))
|
||
;; Test moving to previous column in this line.
|
||
(while (if one-col
|
||
(save-excursion
|
||
(forward-line -1)
|
||
(get-text-property (point) 'completion--string))
|
||
(not (bolp)))
|
||
(previous-column-completion 1)
|
||
(let ((prev (get-text-property (point) 'completion--string)))
|
||
(should
|
||
;; FIXME: tautology?
|
||
(equal (nth (seq-position completions prev) completions)
|
||
prev))))
|
||
;; We're on the first column, so next move either
|
||
;; wraps or stay put.
|
||
(previous-column-completion 1)
|
||
(if completion-auto-wrap
|
||
;; We wrapped around to last candidate in this line.
|
||
(progn
|
||
(completion--move-to-candidate-end)
|
||
(should (eolp))
|
||
(backward-char)
|
||
(should
|
||
(equal (get-text-property (point) 'completion--string)
|
||
last)))
|
||
;; We stayed on the first candidate.
|
||
(should
|
||
(equal (get-text-property (point) 'completion--string)
|
||
first)))
|
||
(if one-col
|
||
(goto-char (point-max))
|
||
(forward-line)))))))))
|
||
|
||
;; Run tests.
|
||
;; Test navigation with wrapping...
|
||
(let ((completion-auto-wrap t))
|
||
;; ...in horizontal format,
|
||
(let ((completions-format 'horizontal))
|
||
(funcall all-completions 'any)
|
||
(funcall all-completions 'column)
|
||
(funcall within-column))
|
||
;; ...in vertical format.
|
||
(let ((completions-format 'vertical))
|
||
(funcall all-completions 'any)
|
||
(funcall all-completions 'line)
|
||
(funcall within-line)))
|
||
;; Test navigation without wrapping...
|
||
(let ((completion-auto-wrap nil))
|
||
;; ...in horizontal format,
|
||
(let ((completions-format 'horizontal))
|
||
(funcall all-completions 'any)
|
||
(funcall all-completions 'column)
|
||
(funcall within-column))
|
||
;; ...in vertical format.
|
||
(let ((completions-format 'vertical))
|
||
(funcall all-completions 'any)
|
||
(funcall all-completions 'line)
|
||
(funcall within-line)))))
|
||
|
||
;; (ert-deftest completions-format-navigation-test-1 ()
|
||
;; (completions-format-navigation--tests 1))
|
||
|
||
(ert-deftest completions-format-navigation-test-2 ()
|
||
(completions-format-navigation--tests 2))
|
||
|
||
(ert-deftest completions-format-navigation-test-3 ()
|
||
(completions-format-navigation--tests 3))
|
||
|
||
(ert-deftest completions-format-navigation-test-4 ()
|
||
(completions-format-navigation--tests 4))
|
||
|
||
(ert-deftest completions-format-navigation-test-5 ()
|
||
(completions-format-navigation--tests 5))
|
||
|
||
(ert-deftest completions-format-navigation-test-9 ()
|
||
(completions-format-navigation--tests 9))
|
||
|
||
(ert-deftest completions-format-navigation-test-10 ()
|
||
(completions-format-navigation--tests 10))
|
||
|
||
(ert-deftest completions-format-navigation-test-15 ()
|
||
(completions-format-navigation--tests 15))
|
||
|
||
(ert-deftest completions-format-navigation-test-16 ()
|
||
(completions-format-navigation--tests 16))
|
||
|
||
(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))
|
||
(minibuffer-completion-auto-choose t))
|
||
(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))))))
|
||
|
||
(ert-deftest minibuffer-completion-RET-prefix ()
|
||
;; REQUIRE-MATCH=nil
|
||
(with-minibuffer-setup
|
||
(completing-read ":" '("aaa" "bbb" "ccc") nil nil)
|
||
(execute-kbd-macro (kbd "M-<down> M-<down> C-u RET"))
|
||
(should (equal "bbb" (minibuffer-contents))))
|
||
;; REQUIRE-MATCH=t
|
||
(with-minibuffer-setup
|
||
(completing-read ":" '("aaa" "bbb" "ccc") nil t)
|
||
(execute-kbd-macro (kbd "M-<down> M-<down> C-u RET"))
|
||
(should (equal "bbb" (minibuffer-contents)))))
|
||
|
||
(defun test/completion-at-point ()
|
||
(list (point-min) (point) '("test:a" "test:b")))
|
||
|
||
(ert-deftest completion-in-region-next-completion ()
|
||
(with-current-buffer (get-buffer-create "*test*")
|
||
;; Put this buffer in the selected window so
|
||
;; `minibuffer--completions-visible' works.
|
||
(pop-to-buffer (current-buffer))
|
||
(setq-local completion-at-point-functions (list #'test/completion-at-point))
|
||
(insert "test:")
|
||
(completion-help-at-point)
|
||
(should (minibuffer--completions-visible))
|
||
;; C-u RET and RET have basically the same behavior for
|
||
;; completion-in-region-mode, since they both dismiss *Completions*
|
||
;; while leaving completion-in-region-mode still active.
|
||
(execute-kbd-macro (kbd "M-<down>"))
|
||
(should (equal (completion--selected-candidate) "test:a"))
|
||
(execute-kbd-macro (kbd "C-u RET"))
|
||
(should (equal (buffer-string) "test:a"))
|
||
(delete-char -1)
|
||
(completion-help-at-point)
|
||
(execute-kbd-macro (kbd "M-<down> M-<down>"))
|
||
(should (equal (completion--selected-candidate) "test:b"))
|
||
(execute-kbd-macro (kbd "RET"))
|
||
(should (equal (buffer-string) "test:b"))))
|
||
|
||
(ert-deftest completion-category-inheritance ()
|
||
(let ((completion-category-defaults
|
||
'((cat (display-sort-function . foo))
|
||
(dog (display-sort-function . bar)
|
||
(group-function . baz)
|
||
(annotation-function . qux)
|
||
(styles basic))
|
||
(fel (annotation-function . spam))
|
||
(testtesttest (styles substring))))
|
||
(origt (get 'testtesttest 'completion-category-parents))
|
||
(origc (get 'cat 'completion-category-parents)))
|
||
(unwind-protect
|
||
(progn
|
||
(put 'testtesttest 'completion-category-parents '(cat dog))
|
||
(put 'cat 'completion-category-parents '(fel))
|
||
;; Value from first parent.
|
||
(should (eq
|
||
(completion-metadata-get '((category . testtesttest))
|
||
'display-sort-function)
|
||
'foo))
|
||
;; Value from parent of first parent, not from second parent.
|
||
(should (eq
|
||
(completion-metadata-get '((category . testtesttest))
|
||
'annotation-function)
|
||
'spam))
|
||
;; Value from second parent.
|
||
(should (eq
|
||
(completion-metadata-get '((category . testtesttest))
|
||
'group-function)
|
||
'baz))
|
||
;; Property specified directly, takes precedence.
|
||
(should (equal
|
||
(completion-metadata-get '((category . testtesttest))
|
||
'styles)
|
||
'(substring)))
|
||
;; Not specified and not inherited.
|
||
(should-not (completion-metadata-get '((category . testtesttest))
|
||
'affixation-function)))
|
||
(put 'cat 'completion-category-parents origc)
|
||
(put 'testtesttest 'completion-category-parents origt))))
|
||
|
||
(provide 'minibuffer-tests)
|
||
;;; minibuffer-tests.el ends here
|