Github/emacs
2
0
Fork 1
mirror of git://git.sv.gnu.org/emacs.git synced 2026-02-16 17:24:23 +00:00
Code Issues Projects Releases Packages Wiki Activity

Avoid duplicating strings in pcm--merge-completions

Browse source 
Make completion-pcm--merge-completions operate only on the text
matched by the wildcards, instead of also the text in between
the wildcards.  This improves performance and simplifies the
code by removing the need for the previous mutable variable
"fixed".

* lisp/minibuffer.el (completion-pcm--merge-completions):
Operate only on text matched by wildcards. (bug#79265)
This commit is contained in:
Spencer Baugh 2025-08-20 13:23:34 -04:00 committed by Dmitry Gutov
parent 1bd7b6ac27
commit b511c38bba
1 changed files with 15 additions and 24 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

39
lisp/minibuffer.el
View file

@ -4586,38 +4586,35 @@ the same set of elements."
(cond
((null (cdr strs)) (list (car strs)))
(t
(let ((re (completion-pcm--pattern->regex pattern 'group))
(let ((re (concat
(completion-pcm--pattern->regex pattern 'group)
;; The implicit trailing `any' is greedy.
"\\([^z-a]*\\)"))
(ccs ())) ;Chopped completions.
;; First chop each string into the parts corresponding to each
;; non-constant element of `pattern', using regexp-matching.
;; 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 ())
(last 0)
(i 1)
next)
(while (setq next (match-end i))
(push (substring str last next) chopped)
(setq last next)
(while (setq next (match-string i str))
(push next chopped)
(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 non-constant elements, extract the
;; commonality between them.
;; Then for each of those wildcards, 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
(setq fixed (concat fixed elem))
(push elem res)
(setq wildcards nil))
(let ((comps ()))
(push elem wildcards)
@ -4628,18 +4625,13 @@ the same set of elements."
;; different capitalizations in different parts.
;; In practice, it doesn't seem to make any difference.
(setq ccs (nreverse ccs))
;; 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))
(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
;; 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)))
(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.
@ -4654,7 +4646,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 fixed))
(setq prefix ""))
(push prefix res)
;; Push all the wildcards in this stretch, to preserve `point' and
;; `star' wildcards before ELEM.
@ -4678,8 +4670,7 @@ 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 fixed "")))))
(setq wildcards nil))))))
;; We return it in reverse order.
res)))))