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)

diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 4856079ab4c734cbe9e1014691660d642effd5f2..de6d464f9b7ad843f3becd91ebaf3a8eb4383370 100644 (file)
--- 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 5c41a80824b05cc6005cf07fbf5d6c17e4a32bbf..6f55455b1e8e3e64f9f94a80323de3e4f1fd4b29 100644 (file)
--- 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