From 7d7d346665024d4b3356a358ec933d74ab3175ae Mon Sep 17 00:00:00 2001 From: Spencer Baugh Date: Mon, 19 May 2025 11:35:38 -0400 Subject: [PATCH] Fix 'completion-ignore-case' with 'completion--file-name-table' 509cbe1c35b3d "Improve env var handling in read-file-name" caused 'try-completion' and 'all-completion' operations with 'completion--file-name-table' to no longer update the case of text which was already present in the input string. That is, completions would be returned ignoring case, but the completions would have letter-casing which matched the input string rather than matching the actual file names. This was caused by unnecessarily replacing text in the returned file name completions with text from the input string ORIG, which in turn was caused by the desire to preserve text from ORIG even after 'substitute-in-file-name' changed it. Fix this by detecting when ORIG was not substantially changed by 'substitute-in-file-name'; in that case, the returned file name completions also don't need substantial changes. * lisp/minibuffer.el (completion--file-name-table): Use text from the completions, not the input string. (Bug#78323) * test/lisp/minibuffer-tests.el (completion-table-test-quoting): Test with 'completion-ignore-case' as well. (cherry picked from commit cd364a2119b81f58e0d8f6579809dceb86a8f63c) --- lisp/minibuffer.el | 39 +++++++++++++++++++++++------------ test/lisp/minibuffer-tests.el | 21 ++++++++++++++++++- 2 files changed, 46 insertions(+), 14 deletions(-) diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 4856079ab4c..de6d464f9b7 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -3797,27 +3797,37 @@ except that it passes the file name through `substitute-in-file-name'." (if (eq (car-safe action) 'boundaries) (cons 'boundaries (completion--sifn-boundaries orig table pred (cdr action))) (let* ((sifned (substitute-in-file-name orig)) + (orig-start (car (completion--sifn-boundaries orig table pred ""))) + (sifned-start (car (completion-boundaries sifned table pred ""))) + (orig-in-bounds (substring orig orig-start)) + (sifned-in-bounds (substring sifned sifned-start)) + (only-need-double-dollars + ;; If true, sifn only un-doubled $s in ORIG, so we can fix a + ;; completion to match ORIG by just doubling $s again. This + ;; preserves more text from the completion, behaving better with + ;; non-nil `completion-ignore-case'. + (string-equal orig-in-bounds (minibuffer--double-dollars sifned-in-bounds))) (result (complete-with-action action table sifned pred))) (cond ((null action) ; try-completion (if (stringp result) - ;; Extract the newly added text, quote any dollar signs, - ;; and append it to ORIG. - (let ((new-text (substring result (length sifned)))) - (concat orig (minibuffer--double-dollars new-text))) + ;; Extract the newly added text, quote any dollar signs, and + ;; append it to ORIG. + (if only-need-double-dollars + (concat (substring orig nil orig-start) + (minibuffer--double-dollars (substring result sifned-start))) + (let ((new-text (substring result (length sifned)))) + (concat orig (minibuffer--double-dollars new-text)))) result)) ((eq action t) ; all-completions (mapcar - (let ((orig-prefix - (substring orig (car (completion--sifn-boundaries orig table pred "")))) - (sifned-prefix-length - (- (length sifned) - (car (completion-boundaries sifned table pred ""))))) + (if only-need-double-dollars + #'minibuffer--double-dollars ;; Extract the newly added text, quote any dollar signs, and append ;; it to the part of ORIG inside the completion boundaries. (lambda (compl) - (let ((new-text (substring compl sifned-prefix-length))) - (concat orig-prefix (minibuffer--double-dollars new-text))))) + (let ((new-text (substring compl (length sifned-in-bounds)))) + (concat orig-in-bounds (minibuffer--double-dollars new-text))))) result)) (t result)))))) @@ -5936,7 +5946,10 @@ description without prompting." (when-let ((d (alist-get 'description p))) (setq single (if single t d)))) minibuffer-completion-predicate) - (if (stringp single) single + (cond + ((null single) (user-error "No current predicate")) + ((stringp single) single) + (t (completing-read (format-prompt prompt default) (completion-table-with-metadata @@ -5953,7 +5966,7 @@ description without prompting." ;; Put latest restriction first. (reverse descs)))))) '((category . predicate-description))) - nil t nil nil default)))) + nil t nil nil default))))) (defun minibuffer-predicate-description-to-function (desc) "Return predicate function the DESC describes, or nil." diff --git a/test/lisp/minibuffer-tests.el b/test/lisp/minibuffer-tests.el index 5c41a80824b..6f55455b1e8 100644 --- a/test/lisp/minibuffer-tests.el +++ b/test/lisp/minibuffer-tests.el @@ -109,7 +109,26 @@ (should (equal (completion-try-completion input #'completion--file-name-table nil (length input)) - (cons output (length output))))))) + (cons output (length output))))) + ;; Everything also works with `completion-ignore-case'. + (let ((completion-ignore-case t)) + (pcase-dolist (`(,input ,output) + '( + ("data/M-CTTQ" "data/minibuffer-test-cttq$$tion") + ("data/M-CTTQ$$t" "data/minibuffer-test-cttq$$tion") + ;; When an env var is in the completion bounds, try-completion + ;; won't change letter case. + ("lisp/c${CTTQ1}E" "lisp/c${CTTQ1}Et/") + ("lisp/ced${CTTQ2}SE-U" "lisp/ced${CTTQ2}SEmantic-utest") + ;; If the env var is before the completion bounds, try-completion + ;; *will* change letter case. + ("lisp/c${CTTQ1}et/SE-U" "lisp/c${CTTQ1}et/semantic-utest") + ("lis/c${CTTQ1}/SE-U" "lisp/c${CTTQ1}et/semantic-utest") + )) + (should (equal (car (completion-try-completion input + #'completion--file-name-table + nil (length input))) + output)))))) (ert-deftest completion--insert-strings-faces () (with-temp-buffer -- 2.39.5