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:
parent
21e340494a
commit
509cbe1c35
2 changed files with 59 additions and 7 deletions
|
|
@ -3504,13 +3504,66 @@ same as `substitute-in-file-name'."
|
||||||
(setq qpos (1- qpos)))
|
(setq qpos (1- qpos)))
|
||||||
(cons qpos #'minibuffer-maybe-quote-filename)))))
|
(cons qpos #'minibuffer-maybe-quote-filename)))))
|
||||||
|
|
||||||
(defalias 'completion--file-name-table
|
(defun completion--sifn-boundaries (string table pred suffix)
|
||||||
(completion-table-with-quoting #'completion-file-name-table
|
"Return completion boundaries on file name STRING.
|
||||||
#'substitute-in-file-name
|
|
||||||
#'completion--sifn-requote)
|
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.
|
"Internal subroutine for `read-file-name'. Do not call this.
|
||||||
This is a completion table for file names, like `completion-file-name-table'
|
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
|
(defalias 'read-file-name-internal
|
||||||
(completion-table-in-turn #'completion--embedded-envvar-table
|
(completion-table-in-turn #'completion--embedded-envvar-table
|
||||||
|
|
|
||||||
|
|
@ -103,8 +103,7 @@
|
||||||
("lisp/c${CTTQ1}et/se-u" "lisp/c${CTTQ1}et/semantic-utest")
|
("lisp/c${CTTQ1}et/se-u" "lisp/c${CTTQ1}et/semantic-utest")
|
||||||
("lisp/ced${CTTQ2}se-u" "lisp/ced${CTTQ2}semantic-utest")
|
("lisp/ced${CTTQ2}se-u" "lisp/ced${CTTQ2}semantic-utest")
|
||||||
;; Test that env-vars don't prevent partial-completion.
|
;; Test that env-vars don't prevent partial-completion.
|
||||||
;; FIXME: Ideally we'd like to keep the ${CTTQ}!
|
("lis/c${CTTQ1}/se-u" "lisp/c${CTTQ1}et/semantic-utest")
|
||||||
("lis/c${CTTQ1}/se-u" "lisp/cedet/semantic-utest")
|
|
||||||
))
|
))
|
||||||
(should (equal (completion-try-completion input
|
(should (equal (completion-try-completion input
|
||||||
#'completion--file-name-table
|
#'completion--file-name-table
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue