Improve env var handling in read-file-name

Fix various bugs, including bug#77718, by rewriting the way file
name completion handles environment variable expansion.  Instead
of using completion-table-with-quoting to manipulate the string
being completed on, simply make the completion table itself
understand substitute-in-file-name.

Tests are updated: partial-completion now preserves unexpanded
environment variables.  However, partial-completion no longer
works across environment variables containing delimiters; that's
an acceptable sacrifice.

* lisp/minibuffer.el (completion--sifn-boundaries): Add.
(completion--file-name-table): Rewrite to use
substitute-in-file-name explicitly. (bug#77718)
* test/lisp/minibuffer-tests.el (completion-table-test-quoting):
Update.

(cherry picked from commit 509cbe1c35b3dd005a53ac041f9c87ee53b8e115)

diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index b6ff6c43edef391858221048fae6f9b0cbeb06ff..65057533b997694afaaeb21fa4ea0258516e7eb5 100644 (file)
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -3765,13 +3765,66 @@ strings in `completion-ignored-extensions'."
           (setq qpos (1- qpos)))
         (cons qpos #'minibuffer-maybe-quote-filename)))))
 
-(defalias 'completion--file-name-table
-  (completion-table-with-quoting #'completion-file-name-table
-                                 #'substitute-in-file-name
-                                 #'completion--sifn-requote)
+(defun completion--sifn-boundaries (string table pred suffix)
+  "Return completion boundaries on file name STRING.
+
+Runs `substitute-in-file-name' on STRING first, but returns completion
+boundaries for the original string."
+  ;; We want to compute the start boundary on the result of
+  ;; `substitute-in-file-name' (since that's what we use for actual completion),
+  ;; and then transform that into an offset in STRING instead.  We can't do this
+  ;; if we expand environment variables, so double the $s to prevent that.
+  (let* ((doubled-string (replace-regexp-in-string "\\$" "$$" string t t))
+         ;; sifn will change $$ back into $, so the result is a suffix of STRING
+         ;; (in fact, it's the last absolute file name in STRING).
+         (last-file-name (substitute-in-file-name doubled-string))
+         (bounds (completion-boundaries last-file-name table pred suffix)))
+    (cl-assert (string-suffix-p last-file-name string) t)
+    ;; BOUNDS contains the start boundary in LAST-FILE-NAME; adjust it to be an
+    ;; offset in STRING instead.
+    (cons (+ (- (length string) (length last-file-name)) (car bounds))
+          ;; No special processing happens on SUFFIX and the end boundary.
+          (cdr bounds))))
+
+(defun completion--file-name-table (orig pred action)
   "Internal subroutine for `read-file-name'.  Do not call this.
 This is a completion table for file names, like `completion-file-name-table'
-except that it passes the file name through `substitute-in-file-name'.")
+except that it passes the file name through `substitute-in-file-name'."
+  (let ((table #'completion-file-name-table))
+    (if (eq (car-safe action) 'boundaries)
+        (cons 'boundaries (completion--sifn-boundaries orig table pred (cdr action)))
+      (let* ((sifned (substitute-in-file-name orig))
+             (result
+              (let ((completion-regexp-list
+                     ;; Regexps are matched against the real file names after
+                     ;; expansion, so regexps containing $ won't work.  Drop
+                     ;; them; we'll return more completions, but callers need to
+                     ;; handle that anyway.
+                     (cl-remove-if (lambda (regexp) (string-search "$" regexp))
+                                   completion-regexp-list)))
+                (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)))
+            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 "")))))
+             ;; 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)))))
+           result))
+         (t result))))))
 
 (defalias 'read-file-name-internal
   (completion-table-in-turn #'completion--embedded-envvar-table

diff --git a/test/lisp/minibuffer-tests.el b/test/lisp/minibuffer-tests.el
index ea4a64be3995a1dc4535baf5741a1d57803dd1cf..5c41a80824b05cc6005cf07fbf5d6c17e4a32bbf 100644 (file)
--- a/test/lisp/minibuffer-tests.el
+++ b/test/lisp/minibuffer-tests.el
@@ -104,8 +104,7 @@
                      ("lisp/c${CTTQ1}et/se-u" "lisp/c${CTTQ1}et/semantic-utest")
                      ("lisp/ced${CTTQ2}se-u" "lisp/ced${CTTQ2}semantic-utest")
                      ;; Test that env-vars don't prevent partial-completion.
-                     ;; FIXME: Ideally we'd like to keep the ${CTTQ}!
-                     ("lis/c${CTTQ1}/se-u" "lisp/cedet/semantic-utest")
+                     ("lis/c${CTTQ1}/se-u" "lisp/c${CTTQ1}et/semantic-utest")
                      ))
       (should (equal (completion-try-completion input
                                                 #'completion--file-name-table