Fix minor problems resulting from Tramp regression tests

* lisp/net/tramp-adb.el (tramp-adb-file-name-handler-alist):
* lisp/net/tramp-archive.el (tramp-archive-file-name-handler-alist):
* lisp/net/tramp-crypt.el (tramp-crypt-file-name-handler-alist):
* lisp/net/tramp-gvfs.el (tramp-gvfs-file-name-handler-alist):
* lisp/net/tramp-rclone.el (tramp-rclone-file-name-handler-alist):
* lisp/net/tramp-sshfs.el (tramp-sshfs-file-name-handler-alist):
Add comment.

* lisp/net/tramp-cache.el (tramp-flush-file-upper-properties):
FILE can be "~".

* lisp/net/tramp.el ('tramp-ensure-dissected-file-name):
Add `tramp-suppress-trace' property.
(tramp-get-debug-buffer): Add local key for debugging.
(tramp-handle-abbreviate-file-name): Adapt implementation.

* test/lisp/net/tramp-tests.el
(tramp-test07-abbreviate-file-name):
Adapt test.
(tramp-test17-insert-directory-one-file)
(tramp--test-check-files): Use proper `no-dir' argument for
`dired-get-filename'.

diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index 895543d6db92758982db0544b64c244189aab1f6..341357d404c390433eef8745a51249d4f5ca5d2e 100644 (file)
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -107,7 +107,8 @@ It is used for TCP/IP devices."
 
 ;;;###tramp-autoload
 (defconst tramp-adb-file-name-handler-alist
-  '((access-file . tramp-handle-access-file)
+  '(;; `abbreviate-file-name' performed by default handler.
+    (access-file . tramp-handle-access-file)
     (add-name-to-file . tramp-handle-add-name-to-file)
     ;; `byte-compiler-base-file-name' performed by default handler.
     (copy-directory . tramp-handle-copy-directory)

diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el
index 3e0d876dd9ef504489492c4d48b8f2ffac7834fd..efd38e6b4b7822dda4ee5f72d0315d2268946fe7 100644 (file)
--- a/lisp/net/tramp-archive.el
+++ b/lisp/net/tramp-archive.el
@@ -211,7 +211,8 @@ It must be supported by libarchive(3).")
 ;; New handlers should be added here.
 ;;;###tramp-autoload
 (defconst tramp-archive-file-name-handler-alist
-  '((access-file . tramp-archive-handle-access-file)
+  '(;; `abbreviate-file-name' performed by default handler.
+    (access-file . tramp-archive-handle-access-file)
     (add-name-to-file . tramp-archive-handle-not-implemented)
     ;; `byte-compiler-base-file-name' performed by default handler.
     ;; `copy-directory' performed by default handler.

diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el
index 5e7d24ff72b897a763e301784f7d9f4a59831ac8..f2be297d59c2436060205f54120df9bd1f33ca50 100644 (file)
--- a/lisp/net/tramp-cache.el
+++ b/lisp/net/tramp-cache.el
@@ -224,7 +224,9 @@ Return VALUE."
 (defun tramp-flush-file-upper-properties (key file)
   "Remove some properties of FILE's upper directory."
   (when (file-name-absolute-p file)
-    (let ((file (directory-file-name (file-name-directory file))))
+    ;; `file-name-directory' can return nil, for example for "~".
+    (when-let ((file (file-name-directory file))
+              (file (directory-file-name file)))
       ;; Unify localname.  Remove hop from `tramp-file-name' structure.
       (setq file (tramp-compat-file-name-unquote file)
            key (copy-tramp-file-name key))

diff --git a/lisp/net/tramp-crypt.el b/lisp/net/tramp-crypt.el
index 42b67ac7a8e33e3aafe2e14e13d11c821b4a6d7d..f60841cf8c19910647904bd5ef0cfd20347a202d 100644 (file)
--- a/lisp/net/tramp-crypt.el
+++ b/lisp/net/tramp-crypt.el
@@ -157,7 +157,8 @@ If NAME doesn't belong to a crypted remote directory, retun nil."
 ;; New handlers should be added here.
 ;;;###tramp-autoload
 (defconst tramp-crypt-file-name-handler-alist
-  '((access-file . tramp-crypt-handle-access-file)
+  '(;; `abbreviate-file-name' performed by default handler.
+    (access-file . tramp-crypt-handle-access-file)
     (add-name-to-file . tramp-handle-add-name-to-file)
     ;; `byte-compiler-base-file-name' performed by default handler.
     (copy-directory . tramp-handle-copy-directory)

diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index 220ce63c0f7daca49aa5b1c1e5e653f86c9bcb6c..a4a7bacd8ac888a46654a5ca92b8d719328cd1ba 100644 (file)
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -744,7 +744,8 @@ It has been changed in GVFS 1.14.")
 ;; New handlers should be added here.
 ;;;###tramp-autoload
 (defconst tramp-gvfs-file-name-handler-alist
-  '((access-file . tramp-handle-access-file)
+  '(;; `abbreviate-file-name' performed by default handler.
+    (access-file . tramp-handle-access-file)
     (add-name-to-file . tramp-handle-add-name-to-file)
     ;; `byte-compiler-base-file-name' performed by default handler.
     (copy-directory . tramp-handle-copy-directory)

diff --git a/lisp/net/tramp-rclone.el b/lisp/net/tramp-rclone.el
index 28a1c01aa61ff3d7950c92859a37a26bdf7f93bc..09862c6a04c637b208d7510be3c930ddd65d62bf 100644 (file)
--- a/lisp/net/tramp-rclone.el
+++ b/lisp/net/tramp-rclone.el
@@ -71,7 +71,8 @@
 ;; New handlers should be added here.
 ;;;###tramp-autoload
 (defconst tramp-rclone-file-name-handler-alist
-  '((access-file . tramp-handle-access-file)
+  '(;; `abbreviate-file-name' performed by default handler.
+    (access-file . tramp-handle-access-file)
     (add-name-to-file . tramp-handle-add-name-to-file)
     ;; `byte-compiler-base-file-name' performed by default handler.
     (copy-directory . tramp-handle-copy-directory)

diff --git a/lisp/net/tramp-sshfs.el b/lisp/net/tramp-sshfs.el
index a9d8dc933b3b9c28d996cf5bfce79aafea95fb84..a19c99316e62acbbfb9eebc5466309eb290225b5 100644 (file)
--- a/lisp/net/tramp-sshfs.el
+++ b/lisp/net/tramp-sshfs.el
@@ -71,7 +71,8 @@
 ;; New handlers should be added here.
 ;;;###tramp-autoload
 (defconst tramp-sshfs-file-name-handler-alist
-  '((access-file . tramp-handle-access-file)
+  '(;; `abbreviate-file-name' performed by default handler.
+    (access-file . tramp-handle-access-file)
     (add-name-to-file . tramp-handle-add-name-to-file)
     ;; `byte-compiler-base-file-name' performed by default handler.
     (copy-directory . tramp-handle-copy-directory)

diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index d314df7b00add35a9d9e4059a00f188f93a2363e..26425199bfa4e193e6c6cfc6637337eaada3a772 100644 (file)
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -1677,6 +1677,8 @@ If it's not a Tramp filename, return nil."
    ((tramp-tramp-file-p vec-or-filename)
     (tramp-dissect-file-name vec-or-filename))))
 
+(put #'tramp-ensure-dissected-file-name 'tramp-suppress-trace t)
+
 (defun tramp-dissect-hop-name (name &optional nodefault)
   "Return a `tramp-file-name' structure of `hop' part of NAME.
 See `tramp-dissect-file-name' for details."
@@ -1924,7 +1926,9 @@ The outline level is equal to the verbosity of the Tramp message."
                   `(t (eval ,tramp-debug-font-lock-keywords t)
                       ,(eval tramp-debug-font-lock-keywords t)))
       ;; Do not edit the debug buffer.
-      (use-local-map special-mode-map))
+      (use-local-map special-mode-map)
+      ;; For debugging purposes.
+      (define-key (current-local-map) "\M-n" 'clone-buffer))
     (current-buffer)))
 
 (put #'tramp-get-debug-buffer 'tramp-suppress-trace t)
@@ -3284,21 +3288,26 @@ User is always nil."
 (defvar tramp-handle-write-region-hook nil
   "Normal hook to be run at the end of `tramp-*-handle-write-region'.")
 
+;; `directory-abbrev-apply' and `directory-abbrev-make-regexp' exists
+;; since Emacs 29.1.  Since this handler isn't called for older
+;; Emacsen, it is save to invoke them via `tramp-compat-funcall'.
 (defun tramp-handle-abbreviate-file-name (filename)
   "Like `abbreviate-file-name' for Tramp files."
   (let* ((case-fold-search (file-name-case-insensitive-p filename))
+        (vec (tramp-dissect-file-name 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,
+          (with-tramp-connection-property vec "home-directory"
+            (tramp-compat-funcall
+            'directory-abbrev-apply
+            (expand-file-name (tramp-make-tramp-file-name vec "~"))))))
+    ;; 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)))))
+    (setq filename (tramp-compat-funcall 'directory-abbrev-apply filename))
+    ;; Abbreviate home directory.
+    (if (string-match
+        (tramp-compat-funcall 'directory-abbrev-make-regexp home-dir) filename)
+        (tramp-make-tramp-file-name
+        vec (concat "~" (substring filename (match-beginning 1))))
       filename)))
 
 (defun tramp-handle-access-file (filename string)

diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 698d18b528272bb7000fa116cdb5583d3e6003f3..150ea29838ca8173d8affd659c2b4461f5403963 100644 (file)
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -2297,11 +2297,13 @@ This checks also `file-name-as-directory', `file-name-directory',
   (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")))
+    (unless (string-suffix-p "~" home-dir)
+      (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")
@@ -2310,8 +2312,8 @@ This checks also `file-name-as-directory', `file-name-directory',
               . ,(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"))
+      (should (equal (abbreviate-file-name
+                     (concat remote-host "/nowhere/special"))
                      (concat remote-host "/nw/special"))))))
 
 (ert-deftest tramp-test07-file-exists-p ()
@@ -3327,7 +3329,7 @@ This tests also `file-directory-p' and `file-accessible-directory-p'."
              (goto-char (point-min))
              (while (not (or (eobp)
                              (string-equal
-                              (dired-get-filename 'localp 'no-error)
+                              (dired-get-filename 'no-dir 'no-error)
                               (file-name-nondirectory tmp-name2))))
                (forward-line 1))
              (should-not (eobp))
@@ -3337,14 +3339,14 @@ This tests also `file-directory-p' and `file-accessible-directory-p'."
              ;; Point shall still be the recent file.
              (should
               (string-equal
-               (dired-get-filename 'localp 'no-error)
+               (dired-get-filename 'no-dir 'no-error)
                (file-name-nondirectory tmp-name2)))
              (should-not (re-search-forward "dired" nil t))
              ;; The copied file has been inserted the line before.
              (forward-line -1)
              (should
               (string-equal
-               (dired-get-filename 'localp 'no-error)
+               (dired-get-filename 'no-dir 'no-error)
                (file-name-nondirectory tmp-name3))))
            (kill-buffer buffer))
 
@@ -6329,7 +6331,7 @@ This requires restrictions of file name syntax."
                (setq buffer (dired-noselect tmp-name1 "--dired -al"))
              (goto-char (point-min))
              (while (not (eobp))
-               (when-let ((name (dired-get-filename 'localp 'no-error)))
+               (when-let ((name (dired-get-filename 'no-dir 'no-error)))
                  (unless
                      (string-match-p name directory-files-no-dot-files-regexp)
                    (should (member name files))))