mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2026-01-06 03:40:56 -08:00
Code Issues Projects Releases Wiki Activity

Fix completion boundaries for TRAMP file names

Browse source 
Previously, we assumed (roughly) that substitute-in-file-name
always returns a suffix of the original string.  But
substitute-in-file-name on "/ssh:user@host:/~/" returns
"/ssh:user@host:~/", preserving the TRAMP magic prefix.  Weaken
the assertion in completion--sifn-boundaries to allow this; the
new assertion is more clear about the property we care about,
anyway.

* lisp/minibuffer.el (completion--sifn-boundaries): Weaken
assertion slightly.

* test/lisp/net/tramp-tests.el (tramp--test-emacs31-p)
(tramp--split-on-boundary)
(tramp-test51-file-name-completion-boundaries): Add.
This commit is contained in:
Spencer Baugh 2025-05-02 14:47:37 +02:00 • committed by Michael Albinus
parent 3f8f738d1d
commit d56d7ca35c
2 changed files with 36 additions and 10 deletions
Download patch file Download diff file Expand all files Collapse all files

23
lisp/minibuffer.el
View file

@ -3514,16 +3514,19 @@ boundaries for the original string."
;; 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))))
;; sifn will change $$ back into $, so SIFNED is mostly the
;; same as STRING, with some text deleted.
(sifned (substitute-in-file-name doubled-string))
(bounds (completion-boundaries sifned table pred suffix))
(sifned-start (car bounds))
;; Adjust SIFNED-START to be an offset in STRING instead of in SIFNED.
(string-start (+ (- sifned-start (length sifned)) (length string))))
;; The text within the boundaries should be identical.
(cl-assert
(eq t (compare-strings sifned sifned-start nil string string-start nil))
t)
;; No special processing happens on SUFFIX and the end boundary.
(cons string-start (cdr bounds))))
(defun completion--file-name-table (orig pred action)
"Internal subroutine for `read-file-name'. Do not call this.

23
test/lisp/net/tramp-tests.el
View file

@ -8530,6 +8530,29 @@ Since it unloads Tramp, it shall be the last test to run."
(should (featurep 'tramp))
(should (featurep 'tramp-archive)))
(defun tramp--test-emacs31-p ()
"Check for Emacs version >= 31.1."
(>= emacs-major-version 31))
(defun tramp--split-on-boundary (s)
(let ((bounds (completion-boundaries s #'completion--file-name-table nil "")))
(cons (substring s nil (car bounds)) (substring s (car bounds)))))
(ert-deftest tramp-test51-file-name-completion-boundaries ()
"Test file name completion boundaries are correct in various cases."
;; `completion--file-name-table' was reworked in 31, the boundaries
;; are always incorrect before that.
(skip-unless (tramp--test-emacs31-p))
(should (equal (tramp--split-on-boundary "/ssh:user@host:foo")
'("/ssh:user@host:" . "foo")))
(should (equal (tramp--split-on-boundary "/ssh:user@host:/~/foo")
'("/ssh:user@host:/~/" . "foo")))
(should (equal (tramp--split-on-boundary "/ssh:user@host:/usr//usr/foo")
'("/ssh:user@host:/usr//usr/" . "foo")))
(should (equal (tramp--split-on-boundary "/ssh:user@host:/ssh:user@host://usr/foo")
'("/ssh:user@host:/ssh:user@host://usr/" . "foo"))))
(defun tramp-test-all (&optional interactive)
"Run all tests for \\[tramp].
If INTERACTIVE is non-nil, the tests are run interactively."