1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-15 10:30:25 -08:00

Revert "Avoid duplicating strings in pcm--merge-completions"

Revert "Avoid duplicating strings in pcm--merge-completions",
commit b511c38bba.  It broke
existing behavior, now covered by tests adding in this commit.

* lisp/minibuffer.el (completion-pcm--merge-completions):
* test/lisp/minibuffer-tests.el (completion-pcm-test-anydelim):
(completion-pcm-bug4219):
This commit is contained in:
Spencer Baugh 2025-09-01 11:43:25 -04:00 committed by Stefan Monnier
parent d2532a4ef0
commit b953dc679c
2 changed files with 39 additions and 15 deletions

View file

@ -4625,35 +4625,38 @@ the same set of elements."
(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]*\\)"))
(let ((re (completion-pcm--pattern->regex pattern 'group))
(ccs ())) ;Chopped completions.
;; First match each string against PATTERN as a regex and extract
;; the text matched by each wildcard.
;; First chop each string into the parts corresponding to each
;; non-constant element of `pattern', using regexp-matching.
(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 ())
(last 0)
(i 1)
next)
(while (setq next (match-string i str))
(push next chopped)
(while (setq next (match-end i))
(push (substring str last next) chopped)
(setq last next)
(setq i (1+ i)))
;; Add the text corresponding to the implicit trailing `any'.
(push (substring str last) chopped)
(push (nreverse chopped) ccs))))
;; Then for each of those wildcards, extract the commonality between them.
;; Then for each of those non-constant elements, extract the
;; commonality between them.
(let ((res ())
(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)
(progn
(push elem res)
(setq fixed (concat fixed elem))
(setq wildcards nil))
(let ((comps ()))
(push elem wildcards)
@ -4664,13 +4667,18 @@ the same set of elements."
;; 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 ""))
;; FIXED is a prefix of all of COMPS. Try to grow that prefix.
(let* ((prefix (try-completion fixed comps))
(unique (or (and (eq prefix t) (setq prefix fixed))
(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)))
;; PREFIX is still a prefix of all of
;; COMPS, so if COMP is the same length,
;; they're equal.
(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.
@ -4685,7 +4693,7 @@ the same set of elements."
;; `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 ""))
(setq prefix fixed))
(push prefix res)
;; Push all the wildcards in this stretch, to preserve `point' and
;; `star' wildcards before ELEM.
@ -4709,7 +4717,8 @@ the same set of elements."
(unless (equal suffix "")
(push suffix res))))
;; We pushed these wildcards on RES, so we're done with them.
(setq wildcards nil))))))
(setq wildcards nil))
(setq fixed "")))))
;; We return it in reverse order.
res)))))