1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-06 06:20:55 -08:00

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.
This commit is contained in:
Spencer Baugh 2025-04-14 16:01:38 -04:00 committed by Stefan Monnier
parent 21e340494a
commit 509cbe1c35
2 changed files with 59 additions and 7 deletions

View file

@ -3504,13 +3504,66 @@ same as `substitute-in-file-name'."
(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

View file

@ -103,8 +103,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