Subject: 29.0.50; [PATCH] Abbreviate remote home directories in `abbreviate-file-name'

From: Jim Porter <[email-masked]>
Date: Fri, 5 Nov 2021 20:44:44 -0700

Currently, `abbreviate-file-name' abbreviates home directories, but only 
for the local system. For example:

    $ emacs -Q
    M-: (abbreviate-file-name "/home/jim/src") RET
    ;;  => "~/src"
    M-: (abbreviate-file-name "/sshx:localhost:/home/jim/src") RET
    ;;  => "/sshx:localhost:/home/jim/src"

It'd be nice to abbreviate TRAMP home dirs, especially for the buffer 
list, where the long length of TRAMP paths means that I often just see 
the same leading bits of the paths repeated in the File column. As a 
result, it can be hard to tell the exact file it refers to. (Of course, 
as a workaround, I could just widen the window.)

Attached is a patch series to do this, but the patches probably warrant 
some explanation. First, I removed `automount-dir-prefix'; it's been 
obsolete since 24.3, and it would have made implementation of the second 
part more complex.

Second, I removed the caching of the abbreviated home dir. Since adding 
TRAMP support means there are multiple home dirs (one per host), keeping 
the caching would have been fairly complex, and it's already the source 
of potential bugs (e.g. when temporarily setting HOME to something 
else). I did some benchmarking on this (see attached), and while it is 
indeed slower without the caching, I don't think it's worth keeping the 
caching around. The real performance cost comes from calling 
`abbreviate-file-name' with a TRAMP file (even before my patch), but 
abbreviating a local file is quite fast, even with a pathologically 
large `directory-abbrev-alist'. I also wrote a couple of unit tests to 
make sure this function works correctly.

Finally, I added the actual TRAMP support. This has a pretty significant 
   performance hit to TRAMP files. Looking at profiles, this appears to 
be because my patch calls both `file-name-case-insensitive-p' and 
`file-remote-p' on the TRAMP path, and these duplicate quite a bit of 
work. Is there a way to make this more efficient (e.g. by getting the 
file handler just once instead of twice)? It might also be useful to add 
some unit tests here, but I wasn't 100% sure how to do that with TRAMP 
paths (the tests in my benchmark actually open an SSH connection, so 
that probably won't work on all systems).

In addition to the patches, I've also attached a simple benchmark script 
that I used to measure the performance of these patches as well as the 
results from my system. The performance for local paths is still quite 
good I think, and even the worst-case scenario for TRAMP paths 
(abbreviating with a 500-item `directory-abbrev-alist') clocks in at 
4.6ms per call. It'd be nice to make that faster, but maybe that's the 
best we can do if we want this feature.

From 1b6d76d60929a10e13fbfe1d9b4286bbd0aebb58 Mon Sep 17 00:00:00 2001
From: Jim Porter <[email-masked]>
Date: Thu, 4 Nov 2021 20:14:00 -0700
Subject: [PATCH 1/3] Remove 'automount-dir-prefix'

* lisp/file.el (automount-dir-prefix): Remove it.
* etc/NEWS: Mention the removal.
---
 etc/NEWS      |  5 +++++
 lisp/files.el | 15 +--------------
 2 files changed, 6 insertions(+), 14 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index 211d943a14..ee96876ff9 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 obsolete variable 'automount-dir-prefix' has been removed.
+In Emacs 24.3, the variable 'automount-dir-prefix' was made obsolete.
+For similar functionality, use 'directory-abbrev-alist' instead.
+
 
 * Lisp Changes in Emacs 29.1
 
diff --git a/lisp/files.el b/lisp/files.el
index 173198a424..995f0cf97a 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -1990,12 +1990,6 @@ create-file-buffer
 			     (concat "|" lastname)
 			   lastname))))
 
-(defcustom automount-dir-prefix (purecopy "^/tmp_mnt/")
-  "Regexp to match the automounter prefix in a directory name."
-  :group 'files
-  :type 'regexp)
-(make-obsolete-variable 'automount-dir-prefix 'directory-abbrev-alist "24.3")
-
 (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'.")
@@ -2003,21 +1997,14 @@ abbreviated-home-dir
 (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) and removes automounter prefixes
-\(see the variable `automount-dir-prefix').
+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)."
-  ;; Get rid of the prefixes added by the automounter.
   (save-match-data                      ;FIXME: Why?
-    (if (and automount-dir-prefix
-	     (string-match automount-dir-prefix filename)
-	     (file-exists-p (file-name-directory
-			     (substring filename (1- (match-end 0))))))
-	(setq filename (substring filename (1- (match-end 0)))))
     ;; Avoid treating /home/foo as /home/Foo during `~' substitution.
     (let ((case-fold-search (file-name-case-insensitive-p filename)))
       ;; If any elt of directory-abbrev-alist matches this name,
-- 
2.25.1

From cdca6502cc08dfea9b7c728606ab29b84129f23a Mon Sep 17 00:00:00 2001
From: Jim Porter <[email-masked]>
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 <https://debbugs.gnu.org/19657#20>."
+(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

From 0a4fb38555646226dc45ed6c86e3bae2d108bf6b Mon Sep 17 00:00:00 2001
From: Jim Porter <[email-masked]>
Date: Fri, 5 Nov 2021 20:11:04 -0700
Subject: [PATCH 3/3] Abbreviate home directory for remote files

* lisp/files.el (abbreviate-file-name): Support homedir abbreviation
of remote files.
---
 lisp/files.el | 11 ++++++-----
 1 file changed, 6 insertions(+), 5 deletions(-)

diff --git a/lisp/files.el b/lisp/files.el
index 94b78df40c..aa230dc0c6 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -2001,8 +2001,9 @@ abbreviate-file-name
 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))
-          (home-dir (expand-file-name "~")))
+    (let* ((case-fold-search (file-name-case-insensitive-p filename))
+           (remote-host (file-remote-p filename))
+           (home-dir (expand-file-name (concat remote-host "~"))))
       ;; If any elt of directory-abbrev-alist matches this name,
       ;; abbreviate accordingly.
       (dolist (dir-abbrev directory-abbrev-alist)
@@ -2039,13 +2040,13 @@ abbreviate-file-name
                 (mb1 (match-beginning 1))
                 ((and
                   ;; If the home dir is just /, don't change it.
-                  (not (and (= (match-end 0) 1)
-                            (= (aref filename 0) ?/)))
+                  (not (and (= (match-end 0) (1+ (length remote-host)))
+                            (= (aref filename (length remote-host)) ?/)))
                   ;; 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))
+          (concat remote-host "~" (substring filename mb1))
         filename))))
 
 (defun find-buffer-visiting (filename &optional predicate)
-- 
2.25.1