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.

(cherry picked from commit 0fbba16387513e7692b46885833e4a9c218251f0)

diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index acc1b087cba21267807b87474ae03b6ebfbd6234..cfbf3bf93c35ef5fcfb403df89f2b9dc929e8b7c 100644 (file)
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -5221,12 +5221,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))
@@ -5250,14 +5255,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)))
@@ -5271,7 +5278,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)))))

diff --git a/test/lisp/minibuffer-tests.el b/test/lisp/minibuffer-tests.el
index d4387d4403a79c98220045a1c6c179d245a87443..ea4a64be3995a1dc4535baf5741a1d57803dd1cf 100644 (file)
--- a/test/lisp/minibuffer-tests.el
+++ b/test/lisp/minibuffer-tests.el
@@ -261,6 +261,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