summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMichael Albinus <michael.albinus@gmx.de>2021-11-15 17:50:15 +0100
committerMichael Albinus <michael.albinus@gmx.de>2021-11-15 17:50:15 +0100
commit5b250ca79b9aeeeea0b521db9645882240f08c9f (patch)
treed1f3ae462fb3f57b0379a905e784ad6a07bd7f7d
parent83023117de77c3c41286b0eeb56e2e5417080c43 (diff)
downloademacs-5b250ca79b9aeeeea0b521db9645882240f08c9f.tar.gz
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'.
-rw-r--r--lisp/net/tramp-adb.el3
-rw-r--r--lisp/net/tramp-archive.el3
-rw-r--r--lisp/net/tramp-cache.el4
-rw-r--r--lisp/net/tramp-crypt.el3
-rw-r--r--lisp/net/tramp-gvfs.el3
-rw-r--r--lisp/net/tramp-rclone.el3
-rw-r--r--lisp/net/tramp-sshfs.el3
-rw-r--r--lisp/net/tramp.el31
-rw-r--r--test/lisp/net/tramp-tests.el24
9 files changed, 48 insertions, 29 deletions
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index 895543d6db9..341357d404c 100644
--- 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 3e0d876dd9e..efd38e6b4b7 100644
--- 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 5e7d24ff72b..f2be297d59c 100644
--- 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 42b67ac7a8e..f60841cf8c1 100644
--- 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 220ce63c0f7..a4a7bacd8ac 100644
--- 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 28a1c01aa61..09862c6a04c 100644
--- 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 a9d8dc933b3..a19c99316e6 100644
--- 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 d314df7b00a..26425199bfa 100644
--- 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 698d18b5282..150ea29838c 100644
--- 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))))