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

From: Jim Porter <[email-masked]>
Date: Sat, 13 Nov 2021 18:10:50 -0800

On 11/7/2021 10:37 AM, Michael Albinus wrote:
> Nice. I've pushed them to the emacs-28 branch in your name, merged also
> to the master branch. Maybe you could also add a test for quoted file
> names, i.e. a file name "/:/home/albinus/" should *not* be
> abbreviated. See files-tests-file-name-non-special-* tests in
> files-tests.el.

Ok, I added a test for this in the first patch.

>> +** Tramp
>> +
>> ++++
>> +*** Tramp supports abbreviating remote home directories now.
>> +When calling 'abbreviate-file-name' on a Tramp filename, the result
>> +will abbreviate the home directory to "~".
> 
> You made it under the Tramp heading. I believe there shall be a more
> general entry, that 'abbreviate-file-name' respects file name handlers
> now. The entry in the Tramp section can be kept, but in a more general
> sense. We don't abbreviate only to "~", but also to "~user", see below.

I added a NEWS entry to mention that `abbreviate-file-name' respects 
file name handlers now. I didn't update the Tramp entry though since I 
haven't added "~user" support (at least, not yet...). See below for some 
explanation.

> Tramp can more. If there are two remote users "jim" and "micha", then
> you have
> 
> (expand-file-name "/ssh:jim@host:~/") => "/ssh:jim@host:/home/jim/"
> (expand-file-name "/ssh:jim@host:~micha/") => "/ssh:jim@host:/home/micha/"
> 
> abbreviate-file-name is somehow the reverse function of
> expand-file-name. So it would be great, if we could have
> 
> (abbreviate-file-name "/ssh:jim@host:/home/micha/") => "/ssh:jim@host:~micha/"
> 
> Of course, we cannot check for any remote user's home directory. But we
> have the Tramp cache. expand-file-name adds connection properties for
> home directories, like ("~" . "/home/jim") and ("~micha" . "/home/micha")
> in the above examples. If somebody has already used
> "/ssh:jim@host:~micha/", and this is cached as ("~micha" . "/home/micha"),
> then abbreviate-file-name shall do such an abbreviation. WDYT?

I looked at doing this, but it was a bit more complex than I thought it 
would be initially, so I've held off for now. This does seem like a 
useful feature though, and would probably be nice to have for local 
paths too. It should be possible to enhance `expand-file-name' to cache 
the "~user" -> "/home/user" mapping similarly to how 
`tramp-sh-handle-expand-file-name' does.

I could keep working on this patch to add "~user" support, or maybe that 
could be a followup for later. Incidentally, another interesting feature 
would be abbreviating default methods/users. That's probably easy when 
Tramp has filled in those values since the file name has `tramp-default' 
properties set. I'm not sure how tricky it would be to do without those 
properties though.

>> +    ;; If any elt of directory-abbrev-alist matches this name or the
>> +    ;; home dir, abbreviate accordingly.
>> +    (dolist (dir-abbrev directory-abbrev-alist)
>> +      (when (string-match (car dir-abbrev) filename)
>> +        (setq filename
>> +              (concat (cdr dir-abbrev)
>> +                      (substring filename (match-end 0)))))
>> +      (when (string-match (car dir-abbrev) home-dir)
>> +        (setq home-dir
>> +              (concat (cdr dir-abbrev)
>> +                      (substring home-dir (match-end 0))))))
> 
> Well, this is copied code from abbreviate-file-name. Usually I try to
> avoid such code duplication, it's hard to maintain when it changes in
> the first place . Instead, I call the original function via
> tramp-run-real-handler, and use the result for further changes.
> 
> But abbreviate-file-name does much more than handling
> directory-abbrev-alist. Hmm.

I've tried to reduce as much duplication as possible here by creating 
two new functions: `directory-abbrev-make-regexp' and 
`directory-abbrev-apply'. The former just takes a directory and returns 
a regexp that would match it, and the latter loops over 
`directory-abbrev-alist' and applies the transformations.

I tried to do this via `(tramp-run-real-handler #'abbreviate-file-name 
...)', but it ended up being simpler (and faster to execute) this way.

> I prefer to keep things together. So I would like to see
> tramp-testNN-abbreviate-file-name closed to
> tramp-test05-expand-file-name. Could we call the new function
> tramp-test07-abbreviate-file-name? I know it will be a lot of work to
> rename all the other test functions, and I herewith volunteer to do this
> dirty task.

Ok, fixed.

>> +  (let ((home-dir (expand-file-name "/mock:localhost:~")))
> 
> You hard-code the mock method. But this is available only if
> $REMOTE_TEMPORARY_FILE_DIRECTORY is not set; I'd prefer to run
> tramp-tests.el in many different environments. So please use something
> like
> 
> (let ((home-dir (expand-file-name (concat (file-remote-p tramp-test-temporary-file-directory) "~")))))

Fixed this too.

I also attached a slightly-updated benchmark script as well as new 
results. Performance on local file names is the same as before the 
patch, and just slightly faster than before with Tramp file names. (Most 
of the performance improvements here happened in bug#51699, so I mainly 
wanted to maintain the current performance in this patch.)
From 003d012adc7671f9f0ad42cf9aca5f147a8d0c0c Mon Sep 17 00:00:00 2001
From: Jim Porter <[email-masked]>
Date: Sat, 13 Nov 2021 17:38:36 -0800
Subject: [PATCH 1/2] ; Add another 'abbreviate-file-name' test

* test/lisp/files-tests.el
(files-tests-abbreviate-file-name-non-special): New test.
---
 test/lisp/files-tests.el | 9 +++++++++
 1 file changed, 9 insertions(+)

diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el
index d00f1ce326..df57d78fca 100644
--- a/test/lisp/files-tests.el
+++ b/test/lisp/files-tests.el
@@ -1364,6 +1364,15 @@ files-tests-abbreviate-file-name-directory-abbrev-alist
                      (abbreviate-file-name
                       (concat homedir "nowhere/special/here"))))))
 
+(ert-deftest files-tests-abbreviate-file-name-non-special ()
+  (let* ((homedir temporary-file-directory)
+         (process-environment (cons (format "HOME=%s" homedir)
+                                    process-environment))
+         (abbreviated-home-dir nil))
+    ;; Check that abbreviation doesn't occur for quoted file names.
+    (should (equal (concat "/:" homedir "foo/bar")
+                   (abbreviate-file-name (concat "/:" homedir "foo/bar"))))))
+
 (ert-deftest files-tests-abbreviated-home-dir ()
   "Test that changing HOME does not confuse `abbreviate-file-name'.
 See <https://debbugs.gnu.org/19657#20>."
-- 
2.25.1

From 5d049d9fb902819726b472782dd2d028e3d6165f Mon Sep 17 00:00:00 2001
From: Jim Porter <[email-masked]>
Date: Sat, 13 Nov 2021 17:23:42 -0800
Subject: [PATCH 2/2] Support abbreviating home directory of Tramp filenames

* lisp/files.el (directory-abbrev-make-regexp):
(directory-abbrev-apply): New functions.
(abbreviate-file-name): Check for file name handler.
(file-name-non-special):
* lisp/net/tramp.el (tramp-file-name-for-operation):
* lisp/net/tramp-sh.el (tramp-sh-file-name-handler-alist):
Add 'abbreviate-file-name'.
(tramp-sh-handle-abbreviate-file-name): New function.
* test/lisp/net/tramp-tests.el (tramp-test46-abbreviate-file-name):
New test.
* doc/lispref/files.texi (Magic File Names): Mention
'abbreviate-file-name' in the list of magic file name handlers.
* etc/NEWS: Announce the change.
---
 doc/lispref/files.texi       |   7 +-
 etc/NEWS                     |  10 +++
 lisp/files.el                | 143 ++++++++++++++++++-----------------
 lisp/net/tramp-sh.el         |  20 ++++-
 lisp/net/tramp.el            |   2 +
 test/lisp/net/tramp-tests.el |  25 ++++++
 6 files changed, 135 insertions(+), 72 deletions(-)

diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi
index d93770a0d2..4b114ba111 100644
--- a/doc/lispref/files.texi
+++ b/doc/lispref/files.texi
@@ -3308,8 +3308,8 @@ Magic File Names
 
 @ifnottex
 @noindent
-@code{access-file}, @code{add-name-to-file},
-@code{byte-compiler-base-file-name},@*
+@code{abbreviate-file-name}, @code{access-file},
+@code{add-name-to-file}, @code{byte-compiler-base-file-name},@*
 @code{copy-directory}, @code{copy-file},
 @code{delete-directory}, @code{delete-file},
 @code{diff-latest-backup-file},
@@ -3368,7 +3368,8 @@ Magic File Names
 @iftex
 @noindent
 @flushleft
-@code{access-file}, @code{add-name-to-file},
+@code{abbreviate-file-name}, @code{access-file},
+@code{add-name-to-file},
 @code{byte-com@discretionary{}{}{}piler-base-file-name},
 @code{copy-directory}, @code{copy-file},
 @code{delete-directory}, @code{delete-file},
diff --git a/etc/NEWS b/etc/NEWS
index c362e56cee..48ff06ef28 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -497,6 +497,13 @@ The newly created buffer will be displayed via 'display-buffer', which
 can be customized through the usual mechanism of 'display-buffer-alist'
 and friends.
 
+** Tramp
+
++++
+*** Tramp supports abbreviating remote home directories now.
+When calling 'abbreviate-file-name' on a Tramp filename, the result
+will abbreviate the home directory to "~".
+
 
 * New Modes and Packages in Emacs 29.1
 
@@ -632,6 +639,9 @@ This convenience function is useful when writing code that parses
 files at run-time, and allows Lisp programs to re-parse files only
 when they have changed.
 
++++
+** 'abbreviate-file-name' now respects magic file name handlers.
+
 ---
 ** New function 'font-has-char-p'.
 This can be used to check whether a specific font has a glyph for a
diff --git a/lisp/files.el b/lisp/files.el
index 3490d0428a..49bf06bfc1 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -68,6 +68,31 @@ directory-abbrev-alist
   :group 'abbrev
   :group 'find-file)
 
+(defun directory-abbrev-make-regexp (directory)
+  "Create a regexp to match DIRECTORY for `directory-abbrev-alist'."
+  (let ((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 directory) "\\(/\\|\\'\\)")))
+    ;; The value of regexp could be multibyte or unibyte.  In the
+    ;; latter case, we need to decode it.
+    (if (multibyte-string-p regexp)
+        regexp
+      (decode-coding-string regexp
+                            (if (eq system-type 'windows-nt)
+                                'utf-8
+                              locale-coding-system)))))
+
+(defun directory-abbrev-apply (filename)
+  "Apply the abbreviations in `directory-abbrev-alist' to FILENAME.
+Note that when calling this, you should set `case-fold-search' as
+appropriate for the filesystem used for FILENAME."
+  (dolist (dir-abbrev directory-abbrev-alist filename)
+    (when (string-match (car dir-abbrev) filename)
+         (setq filename (concat (cdr dir-abbrev)
+                                (substring filename (match-end 0)))))))
+
 (defcustom make-backup-files t
   "Non-nil means make a backup of a file the first time it is saved.
 This can be done by renaming the file or by copying.
@@ -2015,73 +2040,54 @@ abbreviate-file-name
 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,
-      ;; 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))))
-        filename))))
+    (if-let ((handler (find-file-name-handler filename 'abbreviate-file-name)))
+        (funcall handler 'abbreviate-file-name filename)
+      (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,
+        ;; abbreviate accordingly.
+        (setq filename (directory-abbrev-apply filename))
+
+        ;; 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.
+        (unless abbreviated-home-dir
+          (put 'abbreviated-home-dir 'home (expand-file-name "~"))
+          (setq abbreviated-home-dir
+                (directory-abbrev-make-regexp
+                 (let ((abbreviated-home-dir "\\`\\'.")) ;Impossible regexp.
+                   (abbreviate-file-name
+                    (get 'abbreviated-home-dir 'home))))))
+
+        ;; 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))))
+          filename)))))
 
 (defun find-buffer-visiting (filename &optional predicate)
   "Return the buffer visiting file FILENAME (a string).
@@ -7836,10 +7842,11 @@ file-name-non-special
 	;; Get a list of the indices of the args that are file names.
 	(file-arg-indices
 	 (cdr (or (assq operation
-			'(;; The first seven are special because they
+			'(;; The first eight are special because they
 			  ;; return a file name.  We want to include
 			  ;; the /: in the return value.  So just
 			  ;; avoid stripping it in the first place.
+                          (abbreviate-file-name)
                           (directory-file-name)
                           (expand-file-name)
                           (file-name-as-directory)
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index c61025a86b..a77ffe432b 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -942,7 +942,8 @@ tramp-vc-registered-read-file-names
 ;; New handlers should be added here.
 ;;;###tramp-autoload
 (defconst tramp-sh-file-name-handler-alist
-  '((access-file . tramp-handle-access-file)
+  '((abbreviate-file-name . tramp-sh-handle-abbreviate-file-name)
+    (access-file . tramp-handle-access-file)
     (add-name-to-file . tramp-sh-handle-add-name-to-file)
     ;; `byte-compiler-base-file-name' performed by default handler.
     (copy-directory . tramp-sh-handle-copy-directory)
@@ -1801,6 +1802,23 @@ tramp-sh-handle-file-name-all-completions
 	       (push (buffer-substring (point) (point-at-eol)) result)))
 	   result))))))
 
+(defun tramp-sh-handle-abbreviate-file-name (filename)
+  "Like `abbreviate-file-name' for Tramp files."
+  (let* ((case-fold-search (tramp-handle-file-name-case-insensitive-p filename))
+         (home-dir
+          (with-parsed-tramp-file-name filename nil
+            (with-tramp-connection-property v "home-directory"
+              (directory-abbrev-apply (tramp-sh-handle-expand-file-name
+                                       (tramp-make-tramp-file-name v "~")))))))
+    ;; If any elt of directory-abbrev-alist matches this name,
+    ;; abbreviate accordingly.
+    (setq filename (directory-abbrev-apply filename))
+    (if (string-match (directory-abbrev-make-regexp home-dir) filename)
+        (with-parsed-tramp-file-name filename nil
+          (tramp-make-tramp-file-name
+           v (concat "~" (substring filename (match-beginning 1)))))
+      filename)))
+
 ;; cp, mv and ln
 
 (defun tramp-sh-handle-add-name-to-file
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 876bbb2c54..52f39bf355 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -2495,6 +2495,8 @@ tramp-file-name-for-operation
 	      file-system-info
 	      ;; Emacs 28+ only.
 	      file-locked-p lock-file make-lock-file-name unlock-file
+	      ;; Emacs 29+ only.
+	      abbreviate-file-name
 	      ;; Tramp internal magic file name function.
 	      tramp-set-file-uid-gid))
     (if (file-name-absolute-p (nth 0 args))
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 52c6159dc1..698d18b528 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -2289,6 +2289,31 @@ tramp-test06-directory-file-name
 	  (should (string-equal (file-name-directory file) file))
 	  (should (string-equal (file-name-nondirectory file) "")))))))
 
+(ert-deftest tramp-test07-abbreviate-file-name ()
+  "Check that Tramp abbreviates file names correctly."
+  (skip-unless (tramp--test-enabled))
+  (skip-unless (tramp--test-emacs29-p))
+
+  (let* ((remote-host (file-remote-p tramp-test-temporary-file-directory))
+         (home-dir (expand-file-name (concat remote-host "~"))))
+    ;; Check home-dir abbreviation.
+    (should (equal (abbreviate-file-name (concat home-dir "/foo/bar"))
+                   (concat remote-host "~/foo/bar")))
+    (should (equal (abbreviate-file-name (concat remote-host
+                                                 "/nowhere/special"))
+                   (concat remote-host "/nowhere/special")))
+    ;; Check `directory-abbrev-alist' abbreviation.
+    (let ((directory-abbrev-alist
+           `((,(concat "\\`" (regexp-quote home-dir) "/foo")
+              . ,(concat home-dir "/f"))
+             (,(concat "\\`" (regexp-quote remote-host) "/nowhere")
+              . ,(concat remote-host "/nw")))))
+      (should (equal (abbreviate-file-name (concat home-dir "/foo/bar"))
+                     (concat remote-host "~/f/bar")))
+      (should (equal (abbreviate-file-name (concat remote-host
+                                                   "/nowhere/special"))
+                     (concat remote-host "/nw/special"))))))
+
 (ert-deftest tramp-test07-file-exists-p ()
   "Check `file-exist-p', `write-region' and `delete-file'."
   (skip-unless (tramp--test-enabled))
-- 
2.25.1