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

From: Jim Porter <[email-masked]>
Date: Sun, 14 Nov 2021 22:58:31 -0800

On 11/14/2021 6:43 AM, Michael Albinus wrote:
> Thanks. However, I believe this test shall be called
> `files-tests-file-name-non-special-file-abbreviate-file-name', like the
> other non-special tests. And perhaps it shall be located prior
> `files-tests-file-name-non-special-access-file'.

Ok, done.

>> 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.
> 
> You cannot trust the `tramp-default' property. It is set when a method
> or user or host name is expanded as in "/ssh::". But when the host name
> is used explicitly by the user, as in "/ssh:host:", the property is not
> set, even if "host" is the default. Same for user.
> 
> But it shouldn't be too hard to determine the defaults. We have
> tramp-default-method{-alist}, tramp-default-user{-alist}, and
> tramp-default-host{-alist}. All needed information is there.

Right, that confirms what I suspected. I'll try to look into this in 
more detail later when I get the chance.

>> 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.)
> 
> Good, no regression :-)

Fixing your comments below *did* regress performance for abbreviating 
Tramp file names compared to current master (it takes 1.47x as long now 
in the worst case), but it's still considerably faster than Emacs 28. 
I've attached updated benchmark results to show the difference.

> This shall be rather "---". We don't add documentation (yet) for this
> new Tramp feature.

Fixed.

>> +*** Tramp supports abbreviating remote home directories now.
>> +When calling 'abbreviate-file-name' on a Tramp filename, the result
>> +will abbreviate the home directory to "~".
> 
> This might be misleading. ... the result will abbreviate the remote home
> directory to "/ssh:user@host:~" (for example).

Ok, I tried to make this section clearer.

> Well, I believe we can implement abbreviation also for other Tramp
> backends, like in tramp-sudoedit.el. So it might be better to call this
> handler `tramp-handle-abbreviate-file-name'.

Done. I added this for the sudoedit and smb methods, since both support
"~" expansion in `expand-file-name'. That *should* be sufficient, but 
I've never used either of those methods, so I could be wrong...

> Please use `case-insensitive-p'. We don't know whether there will be
> other implementation for this magic function in the future. And we shall
> not bypass the checks in `tramp-file-name-handler', which are important
> for parallel invocations of Tramp handlers.

Fixed (same with `expand-file-name'). These changes slow things down a 
fair bit, but that's mostly due to checking for the right file name 
handler more often. Like I said above though, it's still a lot faster 
than Emacs 28 (thanks to bug#51699).
From 4f235215c961f7a2f1c35b1327af7794ab250e4d 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-file-name-non-special-abbreviate-file-name): 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..2c4557ead6 100644
--- a/test/lisp/files-tests.el
+++ b/test/lisp/files-tests.el
@@ -465,6 +465,15 @@ files-tests--new-name
   (let (file-name-handler-alist)
     (concat (file-name-sans-extension name) part (file-name-extension name t))))
 
+(ert-deftest files-tests-file-name-non-special-abbreviate-file-name ()
+  (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-file-name-non-special-access-file ()
   (files-tests--with-temp-non-special (tmpfile nospecial)
     ;; Both versions of the file name work.
-- 
2.25.1

From 8663a872a53f13948096a95ada92e3ac099eee5e Mon Sep 17 00:00:00 2001
From: Jim Porter <[email-masked]>
Date: Sun, 14 Nov 2021 22:41:30 -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.

* lisp/tramp.el (tramp-sh-handle-abbreviate-file-name): New function.

* lisp/files.el (file-name-non-special):
* lisp/net/tramp.el (tramp-file-name-for-operation):
* lisp/net/tramp-sh.el (tramp-sh-file-name-handler-alist):
* lisp/net/tramp-smb.el (tramp-smb-file-name-handler-alist):
* lisp/net/tramp-sudoedit.el (tramp-sudoedit-file-name-handler-alist):
Add 'abbreviate-file-name'.

* test/lisp/net/tramp-tests.el (tramp-test07-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                     |  11 +++
 lisp/files.el                | 143 ++++++++++++++++++-----------------
 lisp/net/tramp-sh.el         |   3 +-
 lisp/net/tramp-smb.el        |   3 +-
 lisp/net/tramp-sudoedit.el   |   3 +-
 lisp/net/tramp.el            |  19 +++++
 test/lisp/net/tramp-tests.el |  25 ++++++
 8 files changed, 140 insertions(+), 74 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..1738910cbc 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -497,6 +497,14 @@ 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 user's home directory, for example by abbreviating
+"/ssh:user@host:/home/user" to "/ssh:user@host:~".
+
 
 * New Modes and Packages in Emacs 29.1
 
@@ -632,6 +640,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..b83569f3de 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-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)
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index 0b25164902..24119539db 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -222,7 +222,8 @@ tramp-smb-actions-set-acl
 ;; New handlers should be added here.
 ;;;###tramp-autoload
 (defconst tramp-smb-file-name-handler-alist
-  '((access-file . tramp-handle-access-file)
+  '((abbreviate-file-name . tramp-handle-abbreviate-file-name)
+    (access-file . tramp-handle-access-file)
     (add-name-to-file . tramp-smb-handle-add-name-to-file)
     ;; `byte-compiler-base-file-name' performed by default handler.
     (copy-directory . tramp-smb-handle-copy-directory)
diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el
index 7cf0ea451d..c91bced656 100644
--- a/lisp/net/tramp-sudoedit.el
+++ b/lisp/net/tramp-sudoedit.el
@@ -63,7 +63,8 @@ tramp-sudoedit-sudo-actions
 
 ;;;###tramp-autoload
 (defconst tramp-sudoedit-file-name-handler-alist
-  '((access-file . tramp-handle-access-file)
+  '((abbreviate-file-name . tramp-handle-abbreviate-file-name)
+    (access-file . tramp-handle-access-file)
     (add-name-to-file . tramp-sudoedit-handle-add-name-to-file)
     (byte-compiler-base-file-name . ignore)
     (copy-directory . tramp-handle-copy-directory)
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 876bbb2c54..9d4fa485b5 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))
@@ -3275,6 +3277,23 @@ tramp-handle-file-local-copy-hook
 (defvar tramp-handle-write-region-hook nil
   "Normal hook to be run at the end of `tramp-*-handle-write-region'.")
 
+(defun tramp-handle-abbreviate-file-name (filename)
+  "Like `abbreviate-file-name' for Tramp files."
+  (let* ((case-fold-search (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 (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)))
+
 (defun tramp-handle-access-file (filename string)
   "Like `access-file' for Tramp files."
   (setq filename (file-truename filename))
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