From cdca6502cc08dfea9b7c728606ab29b84129f23a Mon Sep 17 00:00:00 2001 From: Jim Porter Date: Fri, 5 Nov 2021 19:25:26 -0700 Subject: [PATCH 2/3] Don't cache abbreviated homedir for 'abbreviate-file-name' This is error-prone and the performance difference is minor, especially when compared to the cost of abbreviating a TRAMP filename. * lisp/files.el (abbreviated-home-dir): Mark as obsolete. (abbreviate-file-name): Don't cache the abbreviated home directory. * test/lisp/files-tests.el (files-tests-abbreviate-file-name-homedir): (files-tests-abbreviate-file-name-directory-abbrev-alist): New functions. (files-tests-abbreviated-home-dir): Removed. * lisp/startup.el (command-line): * test/lisp/calendar/todo-mode-tests.el (with-todo-test): * test/lisp/emacs-lisp/package-tests.el (with-package-test): * test/lisp/progmodes/flymake-tests.el (ruby-backend): Don't clear 'abbreviated-home-dir'. * etc/NEWS: Announce the obsoletion of 'abbreviated-home-dir'. --- etc/NEWS | 5 ++ lisp/files.el | 108 +++++++++++--------------- lisp/startup.el | 3 - test/lisp/calendar/todo-mode-tests.el | 3 - test/lisp/emacs-lisp/package-tests.el | 1 - test/lisp/files-tests.el | 36 ++++++--- test/lisp/progmodes/flymake-tests.el | 5 +- 7 files changed, 76 insertions(+), 85 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index ee96876ff9..e0dda1c2aa 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -363,6 +363,11 @@ with recent versions of Firefox. ** The function 'image-dired-get-exif-data' is now obsolete. Use 'exif-parse-file' and 'exif-field' instead. +--- +** The variable 'abbreviated-home-dir' is now obsolete. +'abbreviate-file-name' no longer caches the abbreviated home +directory, so this variable isn't needed anymore. + --- ** The obsolete variable 'automount-dir-prefix' has been removed. In Emacs 24.3, the variable 'automount-dir-prefix' was made obsolete. diff --git a/lisp/files.el b/lisp/files.el index 995f0cf97a..94b78df40c 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -1993,79 +1993,59 @@ create-file-buffer (defvar abbreviated-home-dir nil "Regexp matching the user's homedir at the beginning of file name. The value includes abbreviation according to `directory-abbrev-alist'.") +(make-obsolete-variable 'abbreviated-home-dir 'nil "29.1") (defun abbreviate-file-name (filename) "Return a version of FILENAME shortened using `directory-abbrev-alist'. This also substitutes \"~\" for the user's home directory (unless the -home directory is a root directory). - -When this function is first called, it caches the user's home -directory as a regexp in `abbreviated-home-dir', and reuses it -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)." +home directory is a root directory)." (save-match-data ;FIXME: Why? ;; Avoid treating /home/foo as /home/Foo during `~' substitution. - (let ((case-fold-search (file-name-case-insensitive-p filename))) + (let ((case-fold-search (file-name-case-insensitive-p filename)) + (home-dir (expand-file-name "~"))) ;; If any elt of directory-abbrev-alist matches this name, ;; abbreviate accordingly. (dolist (dir-abbrev directory-abbrev-alist) - (if (string-match (car dir-abbrev) filename) - (setq filename - (concat (cdr dir-abbrev) - (substring filename (match-end 0)))))) - ;; Compute and save the abbreviated homedir name. - ;; We defer computing this until the first time it's needed, to - ;; 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'. - (unless abbreviated-home-dir - (put 'abbreviated-home-dir 'home (expand-file-name "~")) - (setq abbreviated-home-dir - (let* ((abbreviated-home-dir "\\`\\'.") ;Impossible regexp. - (regexp - (concat "\\`" - (regexp-quote - (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 regexp) - regexp - (decode-coding-string regexp - (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 - (let (mb1) - (if (and (string-match abbreviated-home-dir filename) - (setq mb1 (match-beginning 1)) - ;; If the home dir is just /, don't change it. - (not (and (= (match-end 0) 1) - (= (aref filename 0) ?/))) - ;; MS-DOS root directories can come with a drive letter; - ;; Novell Netware allows drive letters beyond `Z:'. - (not (and (memq system-type '(ms-dos windows-nt cygwin)) - (string-match "\\`[a-zA-`]:/\\'" filename))) - (equal (get 'abbreviated-home-dir 'home) - (expand-file-name "~"))) - (setq filename - (concat "~" - (substring filename mb1)))) + (when (string-match (car dir-abbrev) filename) + (setq filename (concat (cdr dir-abbrev) + (substring filename (match-end 0))))) + ;; Abbreviate the home directory too so that it can match the + ;; filename. + (when (string-match (car dir-abbrev) home-dir) + (setq home-dir (concat (cdr dir-abbrev) + (substring home-dir (match-end 0)))))) + ;; If FILENAME starts with the abbreviated homedir make it start + ;; with `~' instead. + (if-let* ((home-dir-regexp + ;; We include a slash at the end, to avoid spurious + ;; matches such as `/usr/foobar' when the home dir is + ;; `/usr/foo'. + (concat "\\`" (regexp-quote home-dir) "\\(/\\|\\'\\)")) + (home-dir-regexp + ;; Depending on whether default-directory does or + ;; doesn't include non-ASCII characters, the value of + ;; home-dir-regexp 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 home-dir-regexp) + home-dir-regexp + (decode-coding-string home-dir-regexp + (if (eq system-type 'windows-nt) + 'utf-8 + locale-coding-system)))) + ((string-match home-dir-regexp filename)) + (mb1 (match-beginning 1)) + ((and + ;; If the home dir is just /, don't change it. + (not (and (= (match-end 0) 1) + (= (aref filename 0) ?/))) + ;; MS-DOS root directories can come with a drive letter; + ;; Novell Netware allows drive letters beyond `Z:'. + (not (and (memq system-type '(ms-dos windows-nt cygwin)) + (string-match "\\`[a-zA-`]:/\\'" filename)))))) + (concat "~" (substring filename mb1)) filename)))) (defun find-buffer-visiting (filename &optional predicate) diff --git a/lisp/startup.el b/lisp/startup.el index 505d7b83f4..6400088c35 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -1050,9 +1050,6 @@ command-line after-init-time nil command-line-default-directory default-directory) - ;; Force recomputation, in case it was computed during the dump. - (setq abbreviated-home-dir nil) - ;; See if we should import version-control from the environment variable. (let ((vc (getenv "VERSION_CONTROL"))) (cond ((eq vc nil)) ;don't do anything if not set diff --git a/test/lisp/calendar/todo-mode-tests.el b/test/lisp/calendar/todo-mode-tests.el index 9b5d990b9b..dd8c5ec353 100644 --- a/test/lisp/calendar/todo-mode-tests.el +++ b/test/lisp/calendar/todo-mode-tests.el @@ -38,9 +38,6 @@ with-todo-test "Set up an isolated `todo-mode' test environment." (declare (debug (body))) `(let* ((todo-test-home (make-temp-file "todo-test-home-" t)) - ;; Since we change HOME, clear this to avoid a conflict - ;; e.g. if Emacs runs within the user's home directory. - (abbreviated-home-dir nil) (process-environment (cons (format "HOME=%s" todo-test-home) process-environment)) (todo-directory (ert-resource-directory)) diff --git a/test/lisp/emacs-lisp/package-tests.el b/test/lisp/emacs-lisp/package-tests.el index 1fd93bc1be..e8651a1182 100644 --- a/test/lisp/emacs-lisp/package-tests.el +++ b/test/lisp/emacs-lisp/package-tests.el @@ -122,7 +122,6 @@ with-package-test (package-gnupghome-dir (expand-file-name "gnupg" package-user-dir)) (package-archives `(("gnu" . ,(or ,location package-test-data-dir)))) (default-directory package-test-file-dir) - abbreviated-home-dir package--initialized package-alist ,@(if update-news diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el index 4b9d4e4516..6015120cf6 100644 --- a/test/lisp/files-tests.el +++ b/test/lisp/files-tests.el @@ -1342,19 +1342,35 @@ files-tests-copy-directory (should (file-directory-p (concat (file-name-as-directory dest2) "a"))) (delete-directory dir 'recursive))) -(ert-deftest files-tests-abbreviated-home-dir () - "Test that changing HOME does not confuse `abbreviate-file-name'. -See ." +(ert-deftest files-tests-abbreviate-file-name-homedir () + ;; Check homedir abbreviation. (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)))))) + (should (equal "~/foo/bar" + (abbreviate-file-name (concat homedir "foo/bar"))))) + ;; Check that homedir abbreviation doesn't occur when homedir is just /. + (let* ((homedir "/") + (process-environment (cons (format "HOME=%s" homedir) + process-environment))) + (should (equal "/foo/bar" + (abbreviate-file-name (concat homedir "foo/bar")))))) + +(ert-deftest files-tests-abbreviate-file-name-directory-abbrev-alist () + ;; Check `directory-abbrev-alist' abbreviation. + (let ((directory-abbrev-alist '(("\\`/nowhere/special" . "/nw/sp")))) + (should (equal "/nw/sp/here" + (abbreviate-file-name "/nowhere/special/here")))) + ;; Check homedir and `directory-abbrev-alist' abbreviation. + (let* ((homedir temporary-file-directory) + (process-environment (cons (format "HOME=%s" homedir) + process-environment)) + (directory-abbrev-alist + `((,(concat "\\`" (regexp-quote homedir) "nowhere/special") + . ,(concat homedir "nw/sp"))))) + (should (equal "~/nw/sp/here" + (abbreviate-file-name + (concat homedir "nowhere/special/here")))))) (ert-deftest files-tests-executable-find () "Test that `executable-find' works also with a relative or remote PATH. diff --git a/test/lisp/progmodes/flymake-tests.el b/test/lisp/progmodes/flymake-tests.el index 4c0d15d1e1..9d378f54ba 100644 --- a/test/lisp/progmodes/flymake-tests.el +++ b/test/lisp/progmodes/flymake-tests.el @@ -125,10 +125,7 @@ ruby-backend ;; Some versions of ruby fail if HOME doesn't exist (bug#29187). (let* ((tempdir (make-temp-file "flymake-tests-ruby" t)) (process-environment (cons (format "HOME=%s" tempdir) - process-environment)) - ;; And see https://debbugs.gnu.org/cgi/bugreport.cgi?bug=19657#20 - ;; for this particular yuckiness - (abbreviated-home-dir nil)) + process-environment))) (unwind-protect (let ((ruby-mode-hook (lambda () -- 2.25.1