procyberian/emacs
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

* lisp/files.el (file-name-non-special): Handle quoted tilde.

Browse source 
(Bug#65685)

* test/lisp/files-tests.el
(files-tests-file-name-non-special-expand-file-name-tilde):
New test.
This commit is contained in:
Michael Albinus 2023-10-14 09:34:40 +02:00
parent c8ea14e782
commit dc8b336d02
2 changed files with 26 additions and 2 deletions
Download patch file Download diff file Expand all files Collapse all files

11
lisp/files.el
View file

@ -8185,13 +8185,12 @@ arguments as the running Emacs)."
;; Get a list of the indices of the args that are file names. ;; Get a list of the indices of the args that are file names.
(file-arg-indices (file-arg-indices
(cdr (or (assq operation (cdr (or (assq operation
'(;; The first eight are special because they '(;; The first seven are special because they
;; return a file name. We want to include ;; return a file name. We want to include
;; the /: in the return value. So just ;; the /: in the return value. So just
;; avoid stripping it in the first place. ;; avoid stripping it in the first place.
(abbreviate-file-name) (abbreviate-file-name)
(directory-file-name) (directory-file-name)
(expand-file-name)
(file-name-as-directory) (file-name-as-directory)
(file-name-directory) (file-name-directory)
(file-name-sans-versions) (file-name-sans-versions)
@ -8200,6 +8199,10 @@ arguments as the running Emacs)."
;; `identity' means just return the first ;; `identity' means just return the first
;; arg not stripped of its quoting. ;; arg not stripped of its quoting.
(substitute-in-file-name identity) (substitute-in-file-name identity)
;; `expand-file-name' shall do special case
;; for the first argument starting with
;; "/:~". (Bug#65685)
(expand-file-name expand-file-name)
;; `add' means add "/:" to the result. ;; `add' means add "/:" to the result.
(file-truename add 0) (file-truename add 0)
;;`insert-file-contents' needs special handling. ;;`insert-file-contents' needs special handling.
@ -8255,6 +8258,10 @@ arguments as the running Emacs)."
(let ((tramp-mode (and tramp-mode (eq method 'local-copy)))) (let ((tramp-mode (and tramp-mode (eq method 'local-copy))))
(pcase method (pcase method
('identity (car arguments)) ('identity (car arguments))
('expand-file-name
(when (string-prefix-p "/:~" (car arguments))
(setcar arguments (file-name-unquote (car arguments) t)))
(apply operation arguments))
('add (file-name-quote (apply operation arguments) t)) ('add (file-name-quote (apply operation arguments) t))
('buffer-file-name ('buffer-file-name
(let ((buffer-file-name (file-name-unquote buffer-file-name t))) (let ((buffer-file-name (file-name-unquote buffer-file-name t)))

17
test/lisp/files-tests.el
View file

@ -662,6 +662,23 @@ unquoted file names."
(files-tests--with-temp-non-special-and-file-name-handler (tmpfile nospecial) (files-tests--with-temp-non-special-and-file-name-handler (tmpfile nospecial)
(should (equal (expand-file-name nospecial) nospecial)))) (should (equal (expand-file-name nospecial) nospecial))))
(ert-deftest files-tests-file-name-non-special-expand-file-name-tilde ()
(let ((process-environment
(cons (format "HOME=%s" temporary-file-directory) process-environment))
abbreviated-home-dir)
(files-tests--with-temp-non-special (tmpfile nospecial)
(let (file-name-handler-alist)
(setq nospecial (file-name-quote (abbreviate-file-name tmpfile))))
(should (equal (expand-file-name nospecial)
(expand-file-name (file-name-unquote nospecial t)))))
(files-tests--with-temp-non-special-and-file-name-handler (tmpfile nospecial)
(let (file-name-handler-alist)
(setq nospecial (file-name-quote (abbreviate-file-name tmpfile))))
(should-not
(equal (expand-file-name nospecial)
;; The file name handler deletes the ".special" extension.
(expand-file-name (file-name-unquote nospecial t)))))))
(ert-deftest files-tests-file-name-non-special-file-accessible-directory-p () (ert-deftest files-tests-file-name-non-special-file-accessible-directory-p ()
(files-tests--with-temp-non-special (tmpdir nospecial-dir t) (files-tests--with-temp-non-special (tmpdir nospecial-dir t)
(should (file-accessible-directory-p nospecial-dir))) (should (file-accessible-directory-p nospecial-dir)))