bug#74420: 31.0.50; PCM completion for ~/src/emacs/trunk/*/minibuf breaks

[Spencer Baugh]

Stefan Monnier <monnier@iro.umontreal.ca> writes:

>> Actually... I just realized this misses some cases, namely when we have
>> "star point" or "point star".
>
> FWIW, my local patches have included for years optimizations like the
> ones you suggested *and* they replaced `star point` and `point star`
> with just `star`.
>
> Do you think it's important to preserve `point` in those cases?

I think we can decide that question later.

>>> BTW, maybe we should go with something like
>>>
>>>        (`(,(and (pred symbolp) s1) ,(and (pred symbolp) s2) . ,rest)
>>>         (cond ((completion-pcm--<something>-p s1 s2) (setq p (cons s1 
>>> rest)))
>>>               ((completion-pcm--<something>-p s2 s1) (setq p (cons s2 
>>> rest)))
>>>               (t (push (pop p) n))))
>>>
>>> Where `completion-pcm--<something>-p` is some kind of partial ordering?
>>
>> Interesting thought.  Maybe it would make sense to have something like
>> - completion-pcm--wildcard-grows-on-left-p
>>   (non-nil for star, point, any, any-delim)
>> - completion-pcm--wildcard-grows-on-right-p
>>   (non-nil for star, point, prefix)
>> - completion-pcm--wildcard-in-text-p
>>   (non-nil for star and point)
>> Then this case would be something like "if grows-left/right-p is the
>> same, and at most one of the symbols is in-text-p, delete the
>> non-in-text-p one".
>
> But I guess your `completion-pcm--merge-completions` is still needed as
> long as we can't optimize all sequences of symbols to a single symbol.
> 🙁

Indeed.  So (my own tangents aside) I think this patch is a good fix for
this issue.  Updated it to fix a bug (fixed by using append instead of
nconc) and to add a few more tests including one covering that case.

>From ace357c47ffbb323ad461e22b2a7d92846cf630e 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 ea708fcdf30..30368996e02 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -4638,12 +4638,17 @@ completion-pcm--merge-completions
       ;; 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))
@@ -4667,14 +4672,16 @@ completion-pcm--merge-completions
                     (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)))
@@ -4688,7 +4695,9 @@ completion-pcm--merge-completions
                                         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 @@ completion-pcm-test-6
            (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
-- 
2.39.3