diff options
| author | Michael Albinus | 2023-10-14 09:34:40 +0200 |
|---|---|---|
| committer | Michael Albinus | 2023-10-14 09:34:40 +0200 |
| commit | dc8b336d0254d751ffcb2466a20a650ca9c5f86a (patch) | |
| tree | c2498f9aa881674609cecddd0b301791e9a4985b | |
| parent | c8ea14e7825d536f41a230fc1298341a2462635e (diff) | |
| download | emacs-dc8b336d0254d751ffcb2466a20a650ca9c5f86a.tar.gz emacs-dc8b336d0254d751ffcb2466a20a650ca9c5f86a.zip | |
* lisp/files.el (file-name-non-special): Handle quoted tilde.
(Bug#65685)
* test/lisp/files-tests.el
(files-tests-file-name-non-special-expand-file-name-tilde):
New test.
| -rw-r--r-- | lisp/files.el | 11 | ||||
| -rw-r--r-- | test/lisp/files-tests.el | 17 |
2 files changed, 26 insertions, 2 deletions
diff --git a/lisp/files.el b/lisp/files.el index b72f141c0ee..8b5cb4964cc 100644 --- a/lisp/files.el +++ b/lisp/files.el | |||
| @@ -8185,13 +8185,12 @@ arguments as the running Emacs)." | |||
| 8185 | ;; Get a list of the indices of the args that are file names. | 8185 | ;; Get a list of the indices of the args that are file names. |
| 8186 | (file-arg-indices | 8186 | (file-arg-indices |
| 8187 | (cdr (or (assq operation | 8187 | (cdr (or (assq operation |
| 8188 | '(;; The first eight are special because they | 8188 | '(;; The first seven are special because they |
| 8189 | ;; return a file name. We want to include | 8189 | ;; return a file name. We want to include |
| 8190 | ;; the /: in the return value. So just | 8190 | ;; the /: in the return value. So just |
| 8191 | ;; avoid stripping it in the first place. | 8191 | ;; avoid stripping it in the first place. |
| 8192 | (abbreviate-file-name) | 8192 | (abbreviate-file-name) |
| 8193 | (directory-file-name) | 8193 | (directory-file-name) |
| 8194 | (expand-file-name) | ||
| 8195 | (file-name-as-directory) | 8194 | (file-name-as-directory) |
| 8196 | (file-name-directory) | 8195 | (file-name-directory) |
| 8197 | (file-name-sans-versions) | 8196 | (file-name-sans-versions) |
| @@ -8200,6 +8199,10 @@ arguments as the running Emacs)." | |||
| 8200 | ;; `identity' means just return the first | 8199 | ;; `identity' means just return the first |
| 8201 | ;; arg not stripped of its quoting. | 8200 | ;; arg not stripped of its quoting. |
| 8202 | (substitute-in-file-name identity) | 8201 | (substitute-in-file-name identity) |
| 8202 | ;; `expand-file-name' shall do special case | ||
| 8203 | ;; for the first argument starting with | ||
| 8204 | ;; "/:~". (Bug#65685) | ||
| 8205 | (expand-file-name expand-file-name) | ||
| 8203 | ;; `add' means add "/:" to the result. | 8206 | ;; `add' means add "/:" to the result. |
| 8204 | (file-truename add 0) | 8207 | (file-truename add 0) |
| 8205 | ;;`insert-file-contents' needs special handling. | 8208 | ;;`insert-file-contents' needs special handling. |
| @@ -8255,6 +8258,10 @@ arguments as the running Emacs)." | |||
| 8255 | (let ((tramp-mode (and tramp-mode (eq method 'local-copy)))) | 8258 | (let ((tramp-mode (and tramp-mode (eq method 'local-copy)))) |
| 8256 | (pcase method | 8259 | (pcase method |
| 8257 | ('identity (car arguments)) | 8260 | ('identity (car arguments)) |
| 8261 | ('expand-file-name | ||
| 8262 | (when (string-prefix-p "/:~" (car arguments)) | ||
| 8263 | (setcar arguments (file-name-unquote (car arguments) t))) | ||
| 8264 | (apply operation arguments)) | ||
| 8258 | ('add (file-name-quote (apply operation arguments) t)) | 8265 | ('add (file-name-quote (apply operation arguments) t)) |
| 8259 | ('buffer-file-name | 8266 | ('buffer-file-name |
| 8260 | (let ((buffer-file-name (file-name-unquote buffer-file-name t))) | 8267 | (let ((buffer-file-name (file-name-unquote buffer-file-name t))) |
diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el index aadb60e1de7..8f6495a293c 100644 --- a/test/lisp/files-tests.el +++ b/test/lisp/files-tests.el | |||
| @@ -662,6 +662,23 @@ unquoted file names." | |||
| 662 | (files-tests--with-temp-non-special-and-file-name-handler (tmpfile nospecial) | 662 | (files-tests--with-temp-non-special-and-file-name-handler (tmpfile nospecial) |
| 663 | (should (equal (expand-file-name nospecial) nospecial)))) | 663 | (should (equal (expand-file-name nospecial) nospecial)))) |
| 664 | 664 | ||
| 665 | (ert-deftest files-tests-file-name-non-special-expand-file-name-tilde () | ||
| 666 | (let ((process-environment | ||
| 667 | (cons (format "HOME=%s" temporary-file-directory) process-environment)) | ||
| 668 | abbreviated-home-dir) | ||
| 669 | (files-tests--with-temp-non-special (tmpfile nospecial) | ||
| 670 | (let (file-name-handler-alist) | ||
| 671 | (setq nospecial (file-name-quote (abbreviate-file-name tmpfile)))) | ||
| 672 | (should (equal (expand-file-name nospecial) | ||
| 673 | (expand-file-name (file-name-unquote nospecial t))))) | ||
| 674 | (files-tests--with-temp-non-special-and-file-name-handler (tmpfile nospecial) | ||
| 675 | (let (file-name-handler-alist) | ||
| 676 | (setq nospecial (file-name-quote (abbreviate-file-name tmpfile)))) | ||
| 677 | (should-not | ||
| 678 | (equal (expand-file-name nospecial) | ||
| 679 | ;; The file name handler deletes the ".special" extension. | ||
| 680 | (expand-file-name (file-name-unquote nospecial t))))))) | ||
| 681 | |||
| 665 | (ert-deftest files-tests-file-name-non-special-file-accessible-directory-p () | 682 | (ert-deftest files-tests-file-name-non-special-file-accessible-directory-p () |
| 666 | (files-tests--with-temp-non-special (tmpdir nospecial-dir t) | 683 | (files-tests--with-temp-non-special (tmpdir nospecial-dir t) |
| 667 | (should (file-accessible-directory-p nospecial-dir))) | 684 | (should (file-accessible-directory-p nospecial-dir))) |