Preserve an explicit * in pcm-try-completion

An explicitly typed * has different semantics from automatically
inserted PCM wildcards, so it should be preserved on try-completion.  We
already do this in some cases, but now we do it more.

This is especially significant for filename completion: removing an
explicit * can take us from

~/src/emacs/trunk/*/minibuf

to

~/src/emacs/trunk//minibuf

The explicit double slash is interpreted by the file name completion
table to mean "start completing from the root directory", so deleting
the * here substantially changes semantics.

* lisp/minibuffer.el (completion-pcm--merge-completions): Don't drop
important wildcards. (bug#74420)
* test/lisp/minibuffer-tests.el (completion-pcm-test-7): Add tests.
This commit is contained in:
Spencer Baugh 2024-11-18 12:26:55 -05:00 committed by Stefan Monnier
parent bec2de2046
commit 0fbba16387
2 changed files with 57 additions and 6 deletions

View file

@ -4500,12 +4500,17 @@ the same set of elements."
;; Then for each of those non-constant elements, extract the
;; commonality between them.
(let ((res ())
(fixed ""))
(fixed "")
;; Accumulate each stretch of wildcards, and process them as a unit.
(wildcards ()))
;; Make the implicit trailing `any' explicit.
(dolist (elem (append pattern '(any)))
(if (stringp elem)
(setq fixed (concat fixed elem))
(progn
(setq fixed (concat fixed elem))
(setq wildcards nil))
(let ((comps ()))
(push elem wildcards)
(dolist (cc (prog1 ccs (setq ccs nil)))
(push (car cc) comps)
(push (cdr cc) ccs))
@ -4529,14 +4534,16 @@ the same set of elements."
(push prefix res)
;; `prefix' only wants to include the fixed part before the
;; wildcard, not the result of growing that fixed part.
(when (eq elem 'prefix)
(when (seq-some (lambda (elem) (eq elem 'prefix)) wildcards)
(setq prefix fixed))
(push prefix res)
(push elem res)
;; Push all the wildcards in this stretch, to preserve `point' and
;; `star' wildcards before ELEM.
(setq res (append wildcards res))
;; Extract common suffix additionally to common prefix.
;; Don't do it for `any' since it could lead to a merged
;; completion that doesn't itself match the candidates.
(when (and (memq elem '(star point prefix))
(when (and (seq-some (lambda (elem) (memq elem '(star point prefix))) wildcards)
;; If prefix is one of the completions, there's no
;; suffix left to find.
(not (assoc-string prefix comps t)))
@ -4550,7 +4557,9 @@ the same set of elements."
comps))))))
(cl-assert (stringp suffix))
(unless (equal suffix "")
(push suffix res)))))
(push suffix res))))
;; We pushed these wildcards on RES, so we're done with them.
(setq wildcards nil))
(setq fixed "")))))
;; We return it in reverse order.
res)))))

View file

@ -258,6 +258,48 @@
(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-substring-test-1 ()
;; One third of a match!
(should (equal