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

[Spencer Baugh via "Bug reports for GNU Emacs, the Swiss army knife of text editors" <bug-gnu-emacs@gnu.org>]

[-- Attachment #1: Type: text/plain, Size: 3430 bytes --]

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

>> 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.  Concretely, we do it by optimizing the PCM pattern
>> more aggressively to avoid having multiple wildcards in a row:
>> after those are removed, the existing code in
>> completion-pcm--merge-completions is able to preserve * in more
>> cases.
>
> Oh, indeed, thank you.
>
> The patch looks good to me, so if there are no objection, I'll install
> it in a few days (feel free to ping me if I forget).

Actually... I just realized this misses some cases, namely when we have
"star point" or "point star".  Attached at the end is a different patch
which takes a different approach (and which includes new tests for the
problematic cases).

The changes to optimize still seem reasonable to me, since they might
improve performance, so feel free to install it if you think it's good.
Although maybe we want to revise it with the below discussion.

> Banter follows.
>
>> * lisp/minibuffer.el (completion-pcm--optimize-pattern): Add
>> more optimizations. (bug#74420)
>
> Aha, so that's why you didn't submit the patch together with the initial
> bug report!
>
>> -        (`(,(or 'any 'any-delim) ,(or 'any 'point) . ,_)
>> -         (setq p (cdr p)))
>> +        ;; Remove duplicate `any' and `prefix'
>> +        (`(any any . ,rest)
>> +         (setq p (cons 'any rest)))
>> +        (`(prefix prefix . ,rest)
>> +         (setq p (cons 'prefix rest)))
>> +        ;; `any' matches anything `any-delim' does, and grows the same way.
>> +        (`(any-delim any . ,rest)
>> +         (setq p (cons 'any rest)))
>
> AFAICT you can still merge the `any-delim any` and `any any` cases.

True, I just thought this was a bit easier to read, since the cases are
justified as an optimization in slightly different ways.

>> +        ;; Remove other wildcards found around `star' or `point'.
>> +        ((or `(,(and keep (or 'star 'point)) ,(or 'any 'any-delim 'prefix) . ,rest)
>> +             `(,(or 'any 'any-delim 'prefix) ,(and keep (or 'star 'point)) . ,rest))
>> +         (setq p (cons keep rest)))
>
> 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".

Also, then the first two helpers could be used in
completion-pcm--merge-completions as well, which could make the wildcard
behavior easier to understand.  (I want to do a bit of refactoring in
completion-pcm--merge-completions, especially after my attached change;
I think it could all be a bit easier to understand.)


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Preserve-an-explicit-in-pcm-try-completion.patch --]
[-- Type: text/x-patch, Size: 5158 bytes --]

From 8c2ff1152800ede05cb9a9fd80deac45646ce52f 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 | 25 +++++++++++++++++++++++++
 2 files changed, 40 insertions(+), 6 deletions(-)

diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 5f3f5d3ead1..2d27fef44ab 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -4513,12 +4513,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))
@@ -4542,14 +4547,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 (nconc 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)))
@@ -4563,7 +4570,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 38c2b8c4552..c166450d87a 100644
--- a/test/lisp/minibuffer-tests.el
+++ b/test/lisp/minibuffer-tests.el
@@ -258,6 +258,31 @@ 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))))
+
 (ert-deftest completion-substring-test-1 ()
   ;; One third of a match!
   (should (equal
-- 
2.39.3