From 0fbba16387513e7692b46885833e4a9c218251f0 Mon Sep 17 00:00:00 2001
From: Spencer Baugh <sbaugh@janestreet.com>
Date: Mon, 18 Nov 2024 12:26:55 -0500
Subject: [PATCH] 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.
---
 lisp/minibuffer.el            | 21 +++++++++++++-----
 test/lisp/minibuffer-tests.el | 42 +++++++++++++++++++++++++++++++++++
 2 files changed, 57 insertions(+), 6 deletions(-)

diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 99abb70b16c..d7ee7a8205a 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -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)))))
diff --git a/test/lisp/minibuffer-tests.el b/test/lisp/minibuffer-tests.el
index e320020d28b..59ac5ab9578 100644
--- a/test/lisp/minibuffer-tests.el
+++ b/test/lisp/minibuffer-tests.el
@@ -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