From: Michael Albinus Date: Mon, 15 Nov 2021 16:50:15 +0000 (+0100) Subject: Fix minor problems resulting from Tramp regression tests X-Git-Tag: emacs-29.0.90~2852^2~270 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=5b250ca79b9aeeeea0b521db9645882240f08c9f;p=emacs.git 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 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))))