From d7377eb6abfc57552f43687aec358934b33707e6 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.  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.  The additional optimization should also improve
performance.

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--optimize-pattern): Add
more optimizations. (bug#74420)
(completion-pcm--find-all-completions): Optimize the pattern
after concatenating two subpatterns.
* test/lisp/minibuffer-tests.el (completion-pcm--optimize-pattern)
(completion-pcm-test-7): Add tests.
---
 lisp/minibuffer.el            | 20 ++++++++++++++++----
 test/lisp/minibuffer-tests.el | 30 +++++++++++++++++++++++++++++-
 2 files changed, 45 insertions(+), 5 deletions(-)

diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 5f3f5d3ead1..e48d85b777d 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -4073,8 +4073,18 @@ completion-pcm--optimize-pattern
   (let ((n '()))
     (while p
       (pcase p
-        (`(,(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)))
+        ;; 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)))
         ;; This is not just a performance improvement: it turns a
         ;; terminating `point' into an implicit `any', which affects
         ;; the final position of point (because `point' gets turned
@@ -4445,8 +4455,10 @@ completion-pcm--find-all-completions
               ;;   (dolist (submatch suball)
               ;;     (push (concat submatch between newsubstring) all)))
               ))
-          (setq pattern (append subpat (list 'any (string sep))
-                                (if between (list between)) pattern))
+          (setq pattern
+                (completion-pcm--optimize-pattern
+                 (append subpat (list 'any (string sep))
+                         (if between (list between)) pattern)))
           (setq prefix subprefix)))
       (if (and (null all) firsterror)
           (signal (car firsterror) (cdr firsterror))
diff --git a/test/lisp/minibuffer-tests.el b/test/lisp/minibuffer-tests.el
index 38c2b8c4552..d988a2007cb 100644
--- a/test/lisp/minibuffer-tests.el
+++ b/test/lisp/minibuffer-tests.el
@@ -133,7 +133,19 @@ completion-pcm--optimize-pattern
   (should (equal (completion-pcm--optimize-pattern '("buf" point "f"))
                  '("buf" point "f")))
   (should (equal (completion-pcm--optimize-pattern '(any "" any))
-                 '(any))))
+                 '(any)))
+  (should (equal (completion-pcm--optimize-pattern '(any-delim "" any))
+                 '(any)))
+  (should (equal (completion-pcm--optimize-pattern '(prefix "" prefix))
+                 '(prefix)))
+  (should (equal (completion-pcm--optimize-pattern '(prefix star any))
+                 '(star)))
+  (should (equal (completion-pcm--optimize-pattern '(any point prefix "foo"))
+                 '(point "foo")))
+  ;; The `any' and `prefix' are erased because they're next to `point',
+  ;; then `point' is erased because it's at the end.
+  (should (equal (completion-pcm--optimize-pattern '(any point prefix))
+                 '())))
 
 (defun test-completion-all-sorted-completions (base def history-var history-list)
   (with-temp-buffer
@@ -258,6 +270,22 @@ 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)))
+  ;; 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