Subject: bug#79265: [PATCH] Treat point more consistently in PCM completion, [PATCH] Treat point more consistently in PCM completion

From: Spencer Baugh <[email-masked]>
Date: Mon, 25 Aug 2025 14:39:55 -0400

Stefan Monnier <[email-masked]> writes:

>> Two things:
>>
>> - It should have somewhat better performance because we're running
>> try-completion on smaller strings and therefore doing less string
>> comparison and work.
>
> Do we have concrete evidence to believe this?

No evidence.  So nevermind the performance argument, I suppose.

>> CCS previously contained, for each completion, a list containing one
>> element for each wildcard element of PATTERN.
>>
>> Now CCS contains, for each completion, a list containing one element for
>> each element of PATTERN, both fixed strings and wildcards.
>
> Exactly: that means CCS is more costly to build and AFAICT it also
> implies correspondingly more calls to `try-completion`.
>
> I don't find it obvious that the new code will be more efficient.
> Barring any clear evidence that one of the two versions is noticeably
> more efficient than the other, I'd recommend we stick to the code we
> happen to have.
>
> From where I stand, my impression is that neither version is terribly
> better nor terribly worse than the other, in terms of clarity,
> simplicity, and efficiency.

That's fair, that patch alone is not worth much.

Attached is a patch (which applies on master) which does most of the
rest of the refactoring that I wanted to do; it makes the dolist over
the pattern into a simple mapcan over the pattern, with no state
preserved between elements of the pattern.  IMO, this is much easier to
follow (and I think it would make the various bugs I've fixed in the
last couple years in merge-completions, easier to catch).  What do you
think?

> PS: BTW, there's currently a limit of 255 subgroups in regexps, which
> for `flex` currently implies a limit of 254 chars and with your patch
> that limit would be halved.

Oh, I didn't realize that.  I could definitely lift that limit on flex
with my design, though, so that it's not limited to 254 chars.  We can
just do repeated string-searches instead for each of the fixed elements,
which won't have this limitation.

>From 54857fe2fb0ed033afcba231f920f8f7fa185333 Mon Sep 17 00:00:00 2001
From: Spencer Baugh <[email-masked]>
Date: Mon, 25 Aug 2025 14:27:19 -0400
Subject: [PATCH] Refactor completion-pcm--merge-completions

Further simplify completion-pcm--merge-completions.  Also fix a
bug I introduced in b511c38bba5354ff21c697e4d27279bf73e4d3cf
which made it no longer change the case of text to match the
completions.

* lisp/minibuffer.el (completion-pcm--pattern->regex): When
GROUP is group-all, also group strings in PATTERN.
(completion-pcm--merge-completions): Preserve case from parts of
completions matching fixed strings in PATTERN. (bug#79265)
* test/lisp/minibuffer-tests.el (completion-pcm-bug4219): Add.
---
 lisp/minibuffer.el            | 165 +++++++++++++++++-----------------
 test/lisp/minibuffer-tests.el |   8 ++
 2 files changed, 90 insertions(+), 83 deletions(-)

diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 0221af5426e..462280233f1 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -4249,7 +4249,11 @@ completion-pcm--pattern->regex
                  (mapconcat
                   (lambda (x)
                     (cond
-                     ((stringp x) (regexp-quote x))
+                     ((stringp x)
+                      (let ((re (regexp-quote x)))
+                        (if (eq group 'group-all)
+                            (concat "\\(" re "\\)")
+                          re)))
                      (t
                       (let ((re (if (eq x 'any-delim)
                                     (concat completion-pcm--delim-wild-regex "*?")
@@ -4622,6 +4626,19 @@ completion--common-suffix
   "Return the common suffix of the strings STRS."
   (nreverse (try-completion "" (mapcar #'reverse strs))))
 
+(defun completion-pcm--group-pattern (pattern)
+  "Group together adjacent wildcards in PATTERN."
+  (let (ret)
+    (dolist (elem pattern)
+      (cond
+       ((or (stringp elem) (eq elem 'any-delim))
+        (push elem ret))
+       ((consp (car-safe ret))
+        (setf (car ret) (append (car ret) (list elem))))
+       (t
+        (push (list elem) ret))))
+    (nreverse ret)))
+
 (defun completion-pcm--merge-completions (strs pattern)
   "Extract the commonality in STRS, with the help of PATTERN.
 PATTERN can contain strings and symbols chosen among `star', `any', `point',
@@ -4648,93 +4665,75 @@ completion-pcm--merge-completions
   (cond
    ((null (cdr strs)) (list (car strs)))
    (t
-    (let ((re (concat
-               (completion-pcm--pattern->regex pattern 'group)
-               ;; The implicit trailing `any' is greedy.
-               "\\([^z-a]*\\)"))
-          (ccs ()))                     ;Chopped completions.
-
+    (let* ((pattern (completion-pcm--group-pattern (append pattern '(any))))
+           (re (concat
+                ;; Force matching the entire string.
+                (completion-pcm--pattern->regex pattern 'group-all) (rx eos)))
+           (pattern-and-comps (mapcar (lambda (elem) (cons elem nil)) pattern)))
       ;; First match each string against PATTERN as a regex and extract
       ;; the text matched by each wildcard.
       (let ((case-fold-search completion-ignore-case))
         (dolist (str strs)
           (unless (string-match re str)
             (error "Internal error: %s doesn't match %s" str re))
-          (let ((chopped ())
-                (i 1)
-                next)
-            (while (setq next (match-string i str))
-              (push next chopped)
-              (setq i (1+ i)))
-            (push (nreverse chopped) ccs))))
-
-      ;; Then for each of those wildcards, extract the commonality between them.
-      (let ((res ())
-            ;; 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)
-              (progn
-                (push elem res)
-                (setq wildcards nil))
-            (let ((comps ()))
-              (push elem wildcards)
-              (dolist (cc (prog1 ccs (setq ccs nil)))
-                (push (car cc) comps)
-                (push (cdr cc) ccs))
-              ;; Might improve the likelihood to avoid choosing
-              ;; different capitalizations in different parts.
-              ;; In practice, it doesn't seem to make any difference.
-              (setq ccs (nreverse ccs))
-              (let* ((prefix (try-completion "" comps))
-                     (unique (or (and (eq prefix t) (setq prefix ""))
-                                 (and (stringp prefix)
-                                      ;; If PREFIX is equal to all of COMPS,
-                                      ;; then PREFIX is a unique completion.
-                                      (seq-every-p
-                                       (lambda (comp) (= (length prefix) (length comp)))
-                                       comps)))))
-                ;; If there's only one completion, `elem' is not useful
-                ;; any more: it can only match the empty string.
-                ;; FIXME: in some cases, it may be necessary to turn an
-                ;; `any' into a `star' because the surrounding context has
-                ;; changed such that string->pattern wouldn't add an `any'
-                ;; here any more.
-                (if unique
-                    ;; If the common prefix is unique, it also is a common
-                    ;; suffix, so we should add it for `prefix' elements.
-                    (push prefix res)
-                  ;; `prefix' only wants to include the fixed part before the
-                  ;; wildcard, not the result of growing that fixed part.
-                  (when (seq-some (lambda (elem) (eq elem 'prefix)) wildcards)
-                    (setq prefix ""))
-                  (push prefix 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 (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)))
-                    (let ((suffix
-                           (completion--common-suffix
-                            (if (zerop (length prefix)) comps
-                              ;; Ignore the chars in the common prefix, so we
-                              ;; don't merge '("abc" "abbc") as "ab*bc".
-                              (let ((skip (length prefix)))
-                                (mapcar (lambda (str) (substring str skip))
-                                        comps))))))
-                      (cl-assert (stringp suffix))
-                      (unless (equal suffix "")
-                        (push suffix res))))
-                  ;; We pushed these wildcards on RES, so we're done with them.
-                  (setq wildcards nil))))))
-        ;; We return it in reverse order.
-        res)))))
+          (seq-do-indexed
+           (lambda (elem i)
+             (push (match-string (1+ i) str) (cdr elem)))
+           pattern-and-comps)))
+
+      ;; Then for each of those non-constant elements, extract the
+      ;; commonality between them.
+      (mapcan
+       (lambda (cons)
+         (let ((elem (car cons))
+               (comps (cdr cons)))
+           (if (stringp elem)
+               (let ((shared (try-completion elem comps)))
+                 ;; Use `try-completion' to merge the strings from each
+                 ;; completion, which may differ in case.
+                 (cond ((eq shared t) (list elem))
+                       ((stringp shared) (list shared))))
+             (let* ((wildcards elem)
+                    (prefix (try-completion "" comps))
+                    (unique (or (and (eq prefix t) (setq prefix ""))
+                                (and (stringp prefix)
+                                     ;; If PREFIX is equal to all of COMPS,
+                                     ;; then PREFIX is a unique completion.
+                                     (seq-every-p
+                                      (lambda (comp) (= (length prefix) (length comp)))
+                                      comps)))))
+               ;; If there's only one completion, `elem' is not useful
+               ;; any more: it can only match the empty string.
+               ;; FIXME: in some cases, it may be necessary to turn an
+               ;; `any' into a `star' because the surrounding context has
+               ;; changed such that string->pattern wouldn't add an `any'
+               ;; here any more.
+               (if unique
+                   ;; If the common prefix is unique, it also is a common
+                   ;; suffix, so we should add it for `prefix' elements.
+                   (list prefix)
+                 (delq nil
+                       (append
+                        ;; `prefix' only wants to include the fixed part before the
+                        ;; wildcard, not the result of growing that fixed part.
+                        (unless (seq-some (lambda (elem) (eq elem 'prefix)) wildcards)
+                          (list prefix))
+                        wildcards
+                        ;; 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 (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)))
+                          (list (completion--common-suffix
+                                 (if (zerop (length prefix)) comps
+                                   ;; Ignore the chars in the common prefix, so we
+                                   ;; don't merge '("abc" "abbc") as "ab*bc".
+                                   (let ((skip (length prefix)))
+                                     (mapcar (lambda (str) (substring str skip))
+                                             comps)))))))))))))
+       pattern-and-comps)))))
 
 (defun completion-pcm--pattern->string (pattern)
   (mapconcat (lambda (x) (cond
@@ -4774,7 +4773,7 @@ completion-pcm--merge-try
          (equal (completion-pcm--pattern->string pattern) (car all)))
     t)
    (t
-    (let* ((mergedpat (completion-pcm--merge-completions all pattern))
+    (let* ((mergedpat (nreverse (completion-pcm--merge-completions all pattern)))
            ;; `mergedpat' is in reverse order.  Place new point (by
            ;; order of preference) either at the old point, or at
            ;; the last place where there's something to choose, or
diff --git a/test/lisp/minibuffer-tests.el b/test/lisp/minibuffer-tests.el
index 123ca849f3b..5b2e6f96af0 100644
--- a/test/lisp/minibuffer-tests.el
+++ b/test/lisp/minibuffer-tests.el
@@ -329,6 +329,14 @@ completion-pcm-test-8
                   "" '("fooxbar" "fooybar") nil 0)
                  '("foobar" . 3))))
 
+(ert-deftest completion-pcm-bug4219 ()
+  ;; With `completion-ignore-case', try-completion should change the
+  ;; case of existing text when the completions have different casing.
+  (should (equal
+           (let ((completion-ignore-case t))
+             (completion-pcm-try-completion "a" '("ABC" "ABD") nil 1))
+           '("AB" . 2))))
+
 (ert-deftest completion-substring-test-1 ()
   ;; One third of a match!
   (should (equal
-- 
2.43.7