From b3cbaa4ad5d66003c53609a784e22f8c1148b674 Mon Sep 17 00:00:00 2001 From: Spencer Baugh Date: Mon, 14 Apr 2025 16:01:38 -0400 Subject: [PATCH] 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) --- lisp/minibuffer.el | 63 ++++++++++++++++++++++++++++++++--- test/lisp/minibuffer-tests.el | 3 +- 2 files changed, 59 insertions(+), 7 deletions(-) diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index b6ff6c43ede..65057533b99 100644 --- 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 ea4a64be399..5c41a80824b 100644 --- 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 -- 2.39.5