From: Michael Albinus Date: Thu, 5 Nov 2020 16:36:04 +0000 (+0100) Subject: Still fixes for Tramp directory-files-* X-Git-Tag: emacs-28.0.90~5240 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=334e2ab440a466a40b7c28d26dfe4207c6bb95e8;p=emacs.git Still fixes for Tramp directory-files-* * lisp/net/tramp.el (tramp-handle-directory-files): * lisp/net/tramp-adb.el (tramp-adb-handle-directory-files-and-attributes): Fix COUNT. * lisp/net/tramp-crypt.el (tramp-crypt-handle-directory-files): Implement COUNT. * lisp/net/tramp-gvfs.el (tramp-gvfs-dbus-byte-array-to-string): * lisp/net/tramp-integration.el (tramp-eshell-directory-change): Use `nbutlast'. * lisp/net/tramp-rclone.el (tramp-rclone-handle-delete-directory) (tramp-rclone-handle-delete-file): Reorder cache flushing. (tramp-rclone-handle-directory-files): Use `tramp-compat-directory-files'. * lisp/net/tramp-sh.el (tramp-sh-handle-directory-files-and-attributes): Fix NOSORT and COUNT. * lisp/net/tramp-smb.el (tramp-smb-handle-directory-files): Fix NOSORT. * test/lisp/net/tramp-tests.el (tramp--test-share-p): New defun. (tramp-test05-expand-file-name-relative): Use it. (tramp-test16-directory-files) (tramp-test19-directory-files-and-attributes): Strengthen test. (tramp-test20-file-modes): Simplify check. --- diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 8ccbe412f2b..be83f670f72 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -350,8 +350,8 @@ ARGUMENTS to pass to the OPERATION." match (car x))) x)) result))) - (when (natnump count) - (setq result (last result count))) + (when (and (natnump count) (> count 0)) + (setq result (nbutlast result (- (length result) count)))) result))))))) (defun tramp-adb-get-ls-command (vec) diff --git a/lisp/net/tramp-crypt.el b/lisp/net/tramp-crypt.el index 286b60a48c2..4d34bbbeea6 100644 --- a/lisp/net/tramp-crypt.el +++ b/lisp/net/tramp-crypt.el @@ -668,7 +668,8 @@ absolute file names." (let (tramp-crypt-enabled) (delete-file (tramp-crypt-encrypt-file-name filename))))) -(defun tramp-crypt-handle-directory-files (directory &optional full match nosort) +(defun tramp-crypt-handle-directory-files + (directory &optional full match nosort count) "Like `directory-files' for Tramp files." (unless (file-exists-p directory) (tramp-error @@ -697,7 +698,11 @@ absolute file names." (replace-regexp-in-string (concat "^" (regexp-quote directory)) "" x)) result))) - (if nosort result (sort result #'string<))))) + (unless nosort + (setq result (sort result #'string<))) + (when (and (natnump count) (> count 0)) + (setq result (nbutlast result (- (length result) count)))) + result))) (defun tramp-crypt-handle-file-attributes (filename &optional id-format) "Like `file-attributes' for Tramp files." diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 86fb45a43b7..8f8e628ab9d 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -876,7 +876,7 @@ Return nil for null BYTE-ARRAY." byte-array (car byte-array)))) (dbus-byte-array-to-string (if (and (consp byte-array) (zerop (car (last byte-array)))) - (butlast byte-array) byte-array)))) + (nbutlast byte-array) byte-array)))) (defun tramp-gvfs-stringify-dbus-message (message) "Convert a D-Bus MESSAGE into readable UTF8 strings, used for traces." diff --git a/lisp/net/tramp-integration.el b/lisp/net/tramp-integration.el index 7e4a9bf05e5..f712600072e 100644 --- a/lisp/net/tramp-integration.el +++ b/lisp/net/tramp-integration.el @@ -132,7 +132,7 @@ been set up by `rfn-eshadow-setup-minibuffer'." ;; Use `path-separator' as it does eshell. (setq eshell-path-env (mapconcat - #'identity (butlast (tramp-compat-exec-path)) path-separator))) + #'identity (nbutlast (tramp-compat-exec-path)) path-separator))) (with-eval-after-load 'esh-util (add-hook 'eshell-mode-hook diff --git a/lisp/net/tramp-rclone.el b/lisp/net/tramp-rclone.el index 1a7b0600d23..4790bb453d3 100644 --- a/lisp/net/tramp-rclone.el +++ b/lisp/net/tramp-rclone.el @@ -289,16 +289,16 @@ file names." (directory &optional recursive trash) "Like `delete-directory' for Tramp files." (with-parsed-tramp-file-name (expand-file-name directory) nil - (delete-directory (tramp-rclone-local-file-name directory) recursive trash) (tramp-flush-directory-properties v localname) - (tramp-rclone-flush-directory-cache v))) + (tramp-rclone-flush-directory-cache v) + (delete-directory (tramp-rclone-local-file-name directory) recursive trash))) (defun tramp-rclone-handle-delete-file (filename &optional trash) "Like `delete-file' for Tramp files." (with-parsed-tramp-file-name (expand-file-name filename) nil + (tramp-rclone-flush-directory-cache v) (delete-file (tramp-rclone-local-file-name filename) trash) - (tramp-flush-file-properties v localname) - (tramp-rclone-flush-directory-cache v))) + (tramp-flush-file-properties v localname))) (defun tramp-rclone-handle-directory-files (directory &optional full match nosort count) @@ -311,8 +311,8 @@ file names." (setq directory (file-name-as-directory (expand-file-name directory))) (with-parsed-tramp-file-name directory nil (let ((result - (directory-files - (tramp-rclone-local-file-name directory) full match count))) + (tramp-compat-directory-files + (tramp-rclone-local-file-name directory) full match nosort count))) ;; Massage the result. (when full (let ((local (concat "^" (regexp-quote (tramp-rclone-mount-point v)))) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 655949a79b8..51e15af2ef9 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -1738,12 +1738,13 @@ ID-FORMAT valid values are `string' and `integer'." (setcar item (expand-file-name (car item) directory))) (push item result))) - (when (natnump count) - (setq result (last result count))) + (unless nosort + (setq result (sort result (lambda (x y) (string< (car x) (car y)))))) - (or (if nosort - result - (sort result (lambda (x y) (string< (car x) (car y))))) + (when (and (natnump count) (> count 0)) + (setq result (nbutlast result (- (length result) count)))) + + (or result ;; The scripts could fail, for example with huge file size. (tramp-handle-directory-files-and-attributes directory full match nosort id-format count))))) diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index a0405085537..0dd233aff09 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -704,6 +704,10 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (mapcar (lambda (x) (when (string-match-p match x) x)) result)))) + ;; Sort them if necessary. + (unless nosort + (setq result (sort result #'string-lessp))) + ;; Return count number of results. (when (and (natnump count) (> count 0)) (setq result (nbutlast result (- (length result) count)))) @@ -714,8 +718,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (mapcar (lambda (x) (format "%s/%s" (directory-file-name directory) x)) result))) - ;; Sort them if necessary. - (unless nosort (setq result (sort result #'string-lessp))) + result)) (defun tramp-smb-handle-expand-file-name (name &optional dir) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 1859e843758..55f652fa9a6 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -3134,8 +3134,8 @@ User is always nil." result))) (unless nosort (setq result (sort result #'string<))) - (when (natnump count) - (setq result (last result count))) + (when (and (natnump count) (> count 0)) + (setq result (nbutlast result (- (length result) count)))) result))) (defun tramp-handle-directory-files-and-attributes diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 2670723ecdc..7b83a8deebd 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -2169,6 +2169,8 @@ is greater than 10. (skip-unless (tramp--test-enabled)) ;; The bugs are fixed in Emacs 28.1. (skip-unless (tramp--test-emacs28-p)) + ;; Methods with a share do not expand "/path/..". + (skip-unless (not (tramp--test-share-p))) (should (string-equal @@ -2931,10 +2933,10 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." (when (tramp--test-emacs28-p) (with-no-warnings (should - (= 1 (length - (directory-files - tmp-name1 nil directory-files-no-dot-files-regexp - nil 1))))))) + (equal + (directory-files + tmp-name1 nil directory-files-no-dot-files-regexp nil 1) + '("bla")))))) ;; Cleanup. (ignore-errors (delete-directory tmp-name1 'recursive)))))) @@ -3457,8 +3459,9 @@ They might differ only in time attributes or directory size." ;; Check the COUNT arg. It exists since Emacs 28. (when (tramp--test-emacs28-p) (with-no-warnings - (should (= 1 (length (directory-files-and-attributes - tmp-name2 nil "\\`b" nil nil 1))))))) + (setq attr (directory-files-and-attributes + tmp-name2 nil "\\`b" nil nil 1)) + (should (equal (mapcar #'car attr) '("bar")))))) ;; Cleanup. (ignore-errors (delete-directory tmp-name1 'recursive)))))) @@ -3470,10 +3473,7 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'." (skip-unless (or (tramp--test-sh-p) (tramp--test-sudoedit-p) ;; Not all tramp-gvfs.el methods support changing the file mode. - (and - (tramp--test-gvfs-p) - (string-match-p - "ftp" (file-remote-p tramp-test-temporary-file-directory 'method))))) + (tramp--test-gvfs-p "afp") (tramp--test-gvfs-p "ftp"))) (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil))) (let ((tmp-name1 (tramp--test-make-temp-name nil quoted)) @@ -5705,6 +5705,13 @@ This does not support special file names." (tramp-sh-file-name-handler-p (tramp-dissect-file-name tramp-test-temporary-file-directory))) +(defun tramp--test-share-p () + "Check, whether the method needs a share." + (and (tramp--test-gvfs-p) + (string-match-p + "^\\(afp\\|davs?\\|smb\\)$" + (file-remote-p tramp-test-temporary-file-directory 'method)))) + (defun tramp--test-sudoedit-p () "Check, whether the sudoedit method is used." (tramp-sudoedit-file-name-p tramp-test-temporary-file-directory))