mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-11-23 07:19:15 +00:00
Avoid bogus abbreviated file names if HOME changes
* lisp/files.el (abbreviate-file-name): If HOME changes, ignore `abbreviated-home-dir'. (Bug#19657#20) * test/lisp/files-tests.el (files-test-abbreviated-home-dir): New.
This commit is contained in:
parent
8d450453fa
commit
92f0c4cd56
@ -1859,9 +1859,9 @@ home directory is a root directory) and removes automounter prefixes
|
||||
|
||||
When this function is first called, it caches the user's home
|
||||
directory as a regexp in `abbreviated-home-dir', and reuses it
|
||||
afterwards. Lisp programs that temporarily set the home directory
|
||||
to a different value should let-bind `abbreviated-home-dir' for
|
||||
the modified home directory to take effect."
|
||||
afterwards (so long as the home directory does not change;
|
||||
if you want to permanently change your home directory after having
|
||||
started Emacs, set `abbreviated-home-dir' to nil so it will be recalculated)."
|
||||
;; Get rid of the prefixes added by the automounter.
|
||||
(save-match-data
|
||||
(if (and automount-dir-prefix
|
||||
@ -1883,29 +1883,37 @@ the modified home directory to take effect."
|
||||
;; give time for directory-abbrev-alist to be set properly.
|
||||
;; We include a slash at the end, to avoid spurious matches
|
||||
;; such as `/usr/foobar' when the home dir is `/usr/foo'.
|
||||
(or abbreviated-home-dir
|
||||
(setq abbreviated-home-dir
|
||||
(let ((abbreviated-home-dir "$foo"))
|
||||
(setq abbreviated-home-dir
|
||||
(concat "\\`"
|
||||
(abbreviate-file-name (expand-file-name "~"))
|
||||
"\\(/\\|\\'\\)"))
|
||||
;; Depending on whether default-directory does or
|
||||
;; doesn't include non-ASCII characters, the value
|
||||
;; of abbreviated-home-dir could be multibyte or
|
||||
;; unibyte. In the latter case, we need to decode
|
||||
;; it. Note that this function is called for the
|
||||
;; first time (from startup.el) when
|
||||
;; locale-coding-system is already set up.
|
||||
(if (multibyte-string-p abbreviated-home-dir)
|
||||
abbreviated-home-dir
|
||||
(decode-coding-string abbreviated-home-dir
|
||||
(if (eq system-type 'windows-nt)
|
||||
'utf-8
|
||||
locale-coding-system))))))
|
||||
(unless abbreviated-home-dir
|
||||
(put 'abbreviated-home-dir 'home (expand-file-name "~"))
|
||||
(setq abbreviated-home-dir
|
||||
(let ((abbreviated-home-dir "$foo"))
|
||||
(setq abbreviated-home-dir
|
||||
(concat "\\`"
|
||||
(abbreviate-file-name
|
||||
(get 'abbreviated-home-dir 'home))
|
||||
"\\(/\\|\\'\\)"))
|
||||
;; Depending on whether default-directory does or
|
||||
;; doesn't include non-ASCII characters, the value
|
||||
;; of abbreviated-home-dir could be multibyte or
|
||||
;; unibyte. In the latter case, we need to decode
|
||||
;; it. Note that this function is called for the
|
||||
;; first time (from startup.el) when
|
||||
;; locale-coding-system is already set up.
|
||||
(if (multibyte-string-p abbreviated-home-dir)
|
||||
abbreviated-home-dir
|
||||
(decode-coding-string abbreviated-home-dir
|
||||
(if (eq system-type 'windows-nt)
|
||||
'utf-8
|
||||
locale-coding-system))))))
|
||||
|
||||
;; If FILENAME starts with the abbreviated homedir,
|
||||
;; and ~ hasn't changed since abbreviated-home-dir was set,
|
||||
;; make it start with `~' instead.
|
||||
;; If ~ has changed, we ignore abbreviated-home-dir rather than
|
||||
;; invalidating it, on the assumption that a change in HOME
|
||||
;; is likely temporary (eg for testing).
|
||||
;; FIXME Is it even worth caching abbreviated-home-dir?
|
||||
;; Ref: https://debbugs.gnu.org/19657#20
|
||||
(if (and (string-match abbreviated-home-dir filename)
|
||||
;; If the home dir is just /, don't change it.
|
||||
(not (and (= (match-end 0) 1)
|
||||
@ -1914,7 +1922,9 @@ the modified home directory to take effect."
|
||||
;; Novell Netware allows drive letters beyond `Z:'.
|
||||
(not (and (memq system-type '(ms-dos windows-nt cygwin))
|
||||
(save-match-data
|
||||
(string-match "^[a-zA-`]:/$" filename)))))
|
||||
(string-match "^[a-zA-`]:/$" filename))))
|
||||
(equal (get 'abbreviated-home-dir 'home)
|
||||
(expand-file-name "~")))
|
||||
(setq filename
|
||||
(concat "~"
|
||||
(match-string 1 filename)
|
||||
|
@ -411,5 +411,19 @@ name (Bug#28412)."
|
||||
(should (file-directory-p (concat (file-name-as-directory dest2) "a")))
|
||||
(delete-directory dir 'recursive)))
|
||||
|
||||
(ert-deftest files-test-abbreviated-home-dir ()
|
||||
"Test that changing HOME does not confuse `abbreviate-file-name'.
|
||||
See <https://debbugs.gnu.org/19657#20>."
|
||||
(let* ((homedir temporary-file-directory)
|
||||
(process-environment (cons (format "HOME=%s" homedir)
|
||||
process-environment))
|
||||
(abbreviated-home-dir nil)
|
||||
(testfile (expand-file-name "foo" homedir))
|
||||
(old (file-truename (abbreviate-file-name testfile)))
|
||||
(process-environment (cons (format "HOME=%s"
|
||||
(expand-file-name "bar" homedir))
|
||||
process-environment)))
|
||||
(should (equal old (file-truename (abbreviate-file-name testfile))))))
|
||||
|
||||
(provide 'files-tests)
|
||||
;;; files-tests.el ends here
|
||||
|
Loading…
Reference in New Issue
Block a user