Package: emacs;
Reported by: Spencer Baugh <sbaugh <at> janestreet.com>
Date: Mon, 18 Aug 2025 18:54:01 UTC
Severity: normal
Tags: patch
Done: Dmitry Gutov <dmitry <at> gutov.dev>
View this message in rfc822 format
From: Spencer Baugh <sbaugh <at> janestreet.com> To: Stefan Monnier <monnier <at> iro.umontreal.ca> Cc: Dmitry Gutov <dmitry <at> gutov.dev>, 79265 <at> debbugs.gnu.org Subject: bug#79265: [PATCH] Treat point more consistently in PCM completion, [PATCH] Treat point more consistently in PCM completion, [PATCH] Refactor completion-pcm--merge-completions Date: Thu, 28 Aug 2025 14:42:46 -0400
[Message part 1 (text/plain, inline)]
Spencer Baugh <sbaugh <at> janestreet.com> writes: > Stefan Monnier <monnier <at> iro.umontreal.ca> 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? This patch has a small bug with any-delim, here's a fixed version, now with a test for that case.
[0001-Refactor-completion-pcm-merge-completions.patch (text/x-patch, inline)]
From 8f33ad72f43f40c6613cac5d1466747c7df796c2 Mon Sep 17 00:00:00 2001
From: Spencer Baugh <sbaugh <at> janestreet.com>
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 | 15 ++++
2 files changed, 97 insertions(+), 83 deletions(-)
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 0221af5426e..7921d3ddf84 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 (ensure-list 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..bede9713aa1 100644
--- a/test/lisp/minibuffer-tests.el
+++ b/test/lisp/minibuffer-tests.el
@@ -329,6 +329,21 @@ completion-pcm-test-8
"" '("fooxbar" "fooybar") nil 0)
'("foobar" . 3))))
+(ert-deftest completion-pcm-test-anydelim ()
+ ;; After each delimiter is a special wildcard which matches any
+ ;; sequence of delimiters.
+ (should (equal (completion-pcm-try-completion
+ "-x" '("-_.x" "-__x") nil 2)
+ '("-_x" . 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
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.