diff options
| author | Spencer Baugh | 2025-08-20 13:23:34 -0400 |
|---|---|---|
| committer | Dmitry Gutov | 2025-08-21 03:37:29 +0300 |
| commit | b511c38bba5354ff21c697e4d27279bf73e4d3cf (patch) | |
| tree | 79c7bbed489dbc75f8a899cb0e884ffba5874648 | |
| parent | 1bd7b6ac27c1b2baae2733e190f2b508557d5f2f (diff) | |
| download | emacs-b511c38bba5354ff21c697e4d27279bf73e4d3cf.tar.gz emacs-b511c38bba5354ff21c697e4d27279bf73e4d3cf.zip | |
Avoid duplicating strings in pcm--merge-completions
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)
| -rw-r--r-- | lisp/minibuffer.el | 39 |
1 files changed, 15 insertions, 24 deletions
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index b5060614841..2dd5e09f8bb 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el | |||
| @@ -4586,38 +4586,35 @@ the same set of elements." | |||
| 4586 | (cond | 4586 | (cond |
| 4587 | ((null (cdr strs)) (list (car strs))) | 4587 | ((null (cdr strs)) (list (car strs))) |
| 4588 | (t | 4588 | (t |
| 4589 | (let ((re (completion-pcm--pattern->regex pattern 'group)) | 4589 | (let ((re (concat |
| 4590 | (completion-pcm--pattern->regex pattern 'group) | ||
| 4591 | ;; The implicit trailing `any' is greedy. | ||
| 4592 | "\\([^z-a]*\\)")) | ||
| 4590 | (ccs ())) ;Chopped completions. | 4593 | (ccs ())) ;Chopped completions. |
| 4591 | 4594 | ||
| 4592 | ;; First chop each string into the parts corresponding to each | 4595 | ;; First match each string against PATTERN as a regex and extract |
| 4593 | ;; non-constant element of `pattern', using regexp-matching. | 4596 | ;; the text matched by each wildcard. |
| 4594 | (let ((case-fold-search completion-ignore-case)) | 4597 | (let ((case-fold-search completion-ignore-case)) |
| 4595 | (dolist (str strs) | 4598 | (dolist (str strs) |
| 4596 | (unless (string-match re str) | 4599 | (unless (string-match re str) |
| 4597 | (error "Internal error: %s doesn't match %s" str re)) | 4600 | (error "Internal error: %s doesn't match %s" str re)) |
| 4598 | (let ((chopped ()) | 4601 | (let ((chopped ()) |
| 4599 | (last 0) | ||
| 4600 | (i 1) | 4602 | (i 1) |
| 4601 | next) | 4603 | next) |
| 4602 | (while (setq next (match-end i)) | 4604 | (while (setq next (match-string i str)) |
| 4603 | (push (substring str last next) chopped) | 4605 | (push next chopped) |
| 4604 | (setq last next) | ||
| 4605 | (setq i (1+ i))) | 4606 | (setq i (1+ i))) |
| 4606 | ;; Add the text corresponding to the implicit trailing `any'. | ||
| 4607 | (push (substring str last) chopped) | ||
| 4608 | (push (nreverse chopped) ccs)))) | 4607 | (push (nreverse chopped) ccs)))) |
| 4609 | 4608 | ||
| 4610 | ;; Then for each of those non-constant elements, extract the | 4609 | ;; Then for each of those wildcards, extract the commonality between them. |
| 4611 | ;; commonality between them. | ||
| 4612 | (let ((res ()) | 4610 | (let ((res ()) |
| 4613 | (fixed "") | ||
| 4614 | ;; Accumulate each stretch of wildcards, and process them as a unit. | 4611 | ;; Accumulate each stretch of wildcards, and process them as a unit. |
| 4615 | (wildcards ())) | 4612 | (wildcards ())) |
| 4616 | ;; Make the implicit trailing `any' explicit. | 4613 | ;; Make the implicit trailing `any' explicit. |
| 4617 | (dolist (elem (append pattern '(any))) | 4614 | (dolist (elem (append pattern '(any))) |
| 4618 | (if (stringp elem) | 4615 | (if (stringp elem) |
| 4619 | (progn | 4616 | (progn |
| 4620 | (setq fixed (concat fixed elem)) | 4617 | (push elem res) |
| 4621 | (setq wildcards nil)) | 4618 | (setq wildcards nil)) |
| 4622 | (let ((comps ())) | 4619 | (let ((comps ())) |
| 4623 | (push elem wildcards) | 4620 | (push elem wildcards) |
| @@ -4628,18 +4625,13 @@ the same set of elements." | |||
| 4628 | ;; different capitalizations in different parts. | 4625 | ;; different capitalizations in different parts. |
| 4629 | ;; In practice, it doesn't seem to make any difference. | 4626 | ;; In practice, it doesn't seem to make any difference. |
| 4630 | (setq ccs (nreverse ccs)) | 4627 | (setq ccs (nreverse ccs)) |
| 4631 | ;; FIXED is a prefix of all of COMPS. Try to grow that prefix. | 4628 | (let* ((prefix (try-completion "" comps)) |
| 4632 | (let* ((prefix (try-completion fixed comps)) | 4629 | (unique (or (and (eq prefix t) (setq prefix "")) |
| 4633 | (unique (or (and (eq prefix t) (setq prefix fixed)) | ||
| 4634 | (and (stringp prefix) | 4630 | (and (stringp prefix) |
| 4635 | ;; If PREFIX is equal to all of COMPS, | 4631 | ;; If PREFIX is equal to all of COMPS, |
| 4636 | ;; then PREFIX is a unique completion. | 4632 | ;; then PREFIX is a unique completion. |
| 4637 | (seq-every-p | 4633 | (seq-every-p |
| 4638 | ;; PREFIX is still a prefix of all of | 4634 | (lambda (comp) (= (length prefix) (length comp))) |
| 4639 | ;; COMPS, so if COMP is the same length, | ||
| 4640 | ;; they're equal. | ||
| 4641 | (lambda (comp) | ||
| 4642 | (= (length prefix) (length comp))) | ||
| 4643 | comps))))) | 4635 | comps))))) |
| 4644 | ;; If there's only one completion, `elem' is not useful | 4636 | ;; If there's only one completion, `elem' is not useful |
| 4645 | ;; any more: it can only match the empty string. | 4637 | ;; any more: it can only match the empty string. |
| @@ -4654,7 +4646,7 @@ the same set of elements." | |||
| 4654 | ;; `prefix' only wants to include the fixed part before the | 4646 | ;; `prefix' only wants to include the fixed part before the |
| 4655 | ;; wildcard, not the result of growing that fixed part. | 4647 | ;; wildcard, not the result of growing that fixed part. |
| 4656 | (when (seq-some (lambda (elem) (eq elem 'prefix)) wildcards) | 4648 | (when (seq-some (lambda (elem) (eq elem 'prefix)) wildcards) |
| 4657 | (setq prefix fixed)) | 4649 | (setq prefix "")) |
| 4658 | (push prefix res) | 4650 | (push prefix res) |
| 4659 | ;; Push all the wildcards in this stretch, to preserve `point' and | 4651 | ;; Push all the wildcards in this stretch, to preserve `point' and |
| 4660 | ;; `star' wildcards before ELEM. | 4652 | ;; `star' wildcards before ELEM. |
| @@ -4678,8 +4670,7 @@ the same set of elements." | |||
| 4678 | (unless (equal suffix "") | 4670 | (unless (equal suffix "") |
| 4679 | (push suffix res)))) | 4671 | (push suffix res)))) |
| 4680 | ;; We pushed these wildcards on RES, so we're done with them. | 4672 | ;; We pushed these wildcards on RES, so we're done with them. |
| 4681 | (setq wildcards nil)) | 4673 | (setq wildcards nil)))))) |
| 4682 | (setq fixed ""))))) | ||
| 4683 | ;; We return it in reverse order. | 4674 | ;; We return it in reverse order. |
| 4684 | res))))) | 4675 | res))))) |
| 4685 | 4676 | ||