aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorMichael Albinus2020-11-05 17:36:04 +0100
committerMichael Albinus2020-11-05 17:36:04 +0100
commit334e2ab440a466a40b7c28d26dfe4207c6bb95e8 (patch)
tree8e0aae8adb25189a8a5f940b35d87f172384c5ad
parentef5211d0aa3186fffa43639072fc3325a3003623 (diff)
downloademacs-334e2ab440a466a40b7c28d26dfe4207c6bb95e8.tar.gz
emacs-334e2ab440a466a40b7c28d26dfe4207c6bb95e8.zip
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.
-rw-r--r--lisp/net/tramp-adb.el4
-rw-r--r--lisp/net/tramp-crypt.el9
-rw-r--r--lisp/net/tramp-gvfs.el2
-rw-r--r--lisp/net/tramp-integration.el2
-rw-r--r--lisp/net/tramp-rclone.el12
-rw-r--r--lisp/net/tramp-sh.el11
-rw-r--r--lisp/net/tramp-smb.el7
-rw-r--r--lisp/net/tramp.el4
-rw-r--r--test/lisp/net/tramp-tests.el27
9 files changed, 47 insertions, 31 deletions
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."
350 match (car x))) 350 match (car x)))
351 x)) 351 x))
352 result))) 352 result)))
353 (when (natnump count) 353 (when (and (natnump count) (> count 0))
354 (setq result (last result count))) 354 (setq result (nbutlast result (- (length result) count))))
355 result))))))) 355 result)))))))
356 356
357(defun tramp-adb-get-ls-command (vec) 357(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."
668 (let (tramp-crypt-enabled) 668 (let (tramp-crypt-enabled)
669 (delete-file (tramp-crypt-encrypt-file-name filename))))) 669 (delete-file (tramp-crypt-encrypt-file-name filename)))))
670 670
671(defun tramp-crypt-handle-directory-files (directory &optional full match nosort) 671(defun tramp-crypt-handle-directory-files
672 (directory &optional full match nosort count)
672 "Like `directory-files' for Tramp files." 673 "Like `directory-files' for Tramp files."
673 (unless (file-exists-p directory) 674 (unless (file-exists-p directory)
674 (tramp-error 675 (tramp-error
@@ -697,7 +698,11 @@ absolute file names."
697 (replace-regexp-in-string 698 (replace-regexp-in-string
698 (concat "^" (regexp-quote directory)) "" x)) 699 (concat "^" (regexp-quote directory)) "" x))
699 result))) 700 result)))
700 (if nosort result (sort result #'string<))))) 701 (unless nosort
702 (setq result (sort result #'string<)))
703 (when (and (natnump count) (> count 0))
704 (setq result (nbutlast result (- (length result) count))))
705 result)))
701 706
702(defun tramp-crypt-handle-file-attributes (filename &optional id-format) 707(defun tramp-crypt-handle-file-attributes (filename &optional id-format)
703 "Like `file-attributes' for Tramp files." 708 "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."
876 byte-array (car byte-array)))) 876 byte-array (car byte-array))))
877 (dbus-byte-array-to-string 877 (dbus-byte-array-to-string
878 (if (and (consp byte-array) (zerop (car (last byte-array)))) 878 (if (and (consp byte-array) (zerop (car (last byte-array))))
879 (butlast byte-array) byte-array)))) 879 (nbutlast byte-array) byte-array))))
880 880
881(defun tramp-gvfs-stringify-dbus-message (message) 881(defun tramp-gvfs-stringify-dbus-message (message)
882 "Convert a D-Bus MESSAGE into readable UTF8 strings, used for traces." 882 "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'."
132 ;; Use `path-separator' as it does eshell. 132 ;; Use `path-separator' as it does eshell.
133 (setq eshell-path-env 133 (setq eshell-path-env
134 (mapconcat 134 (mapconcat
135 #'identity (butlast (tramp-compat-exec-path)) path-separator))) 135 #'identity (nbutlast (tramp-compat-exec-path)) path-separator)))
136 136
137(with-eval-after-load 'esh-util 137(with-eval-after-load 'esh-util
138 (add-hook 'eshell-mode-hook 138 (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."
289 (directory &optional recursive trash) 289 (directory &optional recursive trash)
290 "Like `delete-directory' for Tramp files." 290 "Like `delete-directory' for Tramp files."
291 (with-parsed-tramp-file-name (expand-file-name directory) nil 291 (with-parsed-tramp-file-name (expand-file-name directory) nil
292 (delete-directory (tramp-rclone-local-file-name directory) recursive trash)
293 (tramp-flush-directory-properties v localname) 292 (tramp-flush-directory-properties v localname)
294 (tramp-rclone-flush-directory-cache v))) 293 (tramp-rclone-flush-directory-cache v)
294 (delete-directory (tramp-rclone-local-file-name directory) recursive trash)))
295 295
296(defun tramp-rclone-handle-delete-file (filename &optional trash) 296(defun tramp-rclone-handle-delete-file (filename &optional trash)
297 "Like `delete-file' for Tramp files." 297 "Like `delete-file' for Tramp files."
298 (with-parsed-tramp-file-name (expand-file-name filename) nil 298 (with-parsed-tramp-file-name (expand-file-name filename) nil
299 (tramp-rclone-flush-directory-cache v)
299 (delete-file (tramp-rclone-local-file-name filename) trash) 300 (delete-file (tramp-rclone-local-file-name filename) trash)
300 (tramp-flush-file-properties v localname) 301 (tramp-flush-file-properties v localname)))
301 (tramp-rclone-flush-directory-cache v)))
302 302
303(defun tramp-rclone-handle-directory-files 303(defun tramp-rclone-handle-directory-files
304 (directory &optional full match nosort count) 304 (directory &optional full match nosort count)
@@ -311,8 +311,8 @@ file names."
311 (setq directory (file-name-as-directory (expand-file-name directory))) 311 (setq directory (file-name-as-directory (expand-file-name directory)))
312 (with-parsed-tramp-file-name directory nil 312 (with-parsed-tramp-file-name directory nil
313 (let ((result 313 (let ((result
314 (directory-files 314 (tramp-compat-directory-files
315 (tramp-rclone-local-file-name directory) full match count))) 315 (tramp-rclone-local-file-name directory) full match nosort count)))
316 ;; Massage the result. 316 ;; Massage the result.
317 (when full 317 (when full
318 (let ((local (concat "^" (regexp-quote (tramp-rclone-mount-point v)))) 318 (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'."
1738 (setcar item (expand-file-name (car item) directory))) 1738 (setcar item (expand-file-name (car item) directory)))
1739 (push item result))) 1739 (push item result)))
1740 1740
1741 (when (natnump count) 1741 (unless nosort
1742 (setq result (last result count))) 1742 (setq result (sort result (lambda (x y) (string< (car x) (car y))))))
1743 1743
1744 (or (if nosort 1744 (when (and (natnump count) (> count 0))
1745 result 1745 (setq result (nbutlast result (- (length result) count))))
1746 (sort result (lambda (x y) (string< (car x) (car y))))) 1746
1747 (or result
1747 ;; The scripts could fail, for example with huge file size. 1748 ;; The scripts could fail, for example with huge file size.
1748 (tramp-handle-directory-files-and-attributes 1749 (tramp-handle-directory-files-and-attributes
1749 directory full match nosort id-format count))))) 1750 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."
704 (mapcar (lambda (x) (when (string-match-p match x) x)) 704 (mapcar (lambda (x) (when (string-match-p match x) x))
705 result)))) 705 result))))
706 706
707 ;; Sort them if necessary.
708 (unless nosort
709 (setq result (sort result #'string-lessp)))
710
707 ;; Return count number of results. 711 ;; Return count number of results.
708 (when (and (natnump count) (> count 0)) 712 (when (and (natnump count) (> count 0))
709 (setq result (nbutlast result (- (length result) count)))) 713 (setq result (nbutlast result (- (length result) count))))
@@ -714,8 +718,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
714 (mapcar 718 (mapcar
715 (lambda (x) (format "%s/%s" (directory-file-name directory) x)) 719 (lambda (x) (format "%s/%s" (directory-file-name directory) x))
716 result))) 720 result)))
717 ;; Sort them if necessary. 721
718 (unless nosort (setq result (sort result #'string-lessp)))
719 result)) 722 result))
720 723
721(defun tramp-smb-handle-expand-file-name (name &optional dir) 724(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."
3134 result))) 3134 result)))
3135 (unless nosort 3135 (unless nosort
3136 (setq result (sort result #'string<))) 3136 (setq result (sort result #'string<)))
3137 (when (natnump count) 3137 (when (and (natnump count) (> count 0))
3138 (setq result (last result count))) 3138 (setq result (nbutlast result (- (length result) count))))
3139 result))) 3139 result)))
3140 3140
3141(defun tramp-handle-directory-files-and-attributes 3141(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.
2169 (skip-unless (tramp--test-enabled)) 2169 (skip-unless (tramp--test-enabled))
2170 ;; The bugs are fixed in Emacs 28.1. 2170 ;; The bugs are fixed in Emacs 28.1.
2171 (skip-unless (tramp--test-emacs28-p)) 2171 (skip-unless (tramp--test-emacs28-p))
2172 ;; Methods with a share do not expand "/path/..".
2173 (skip-unless (not (tramp--test-share-p)))
2172 2174
2173 (should 2175 (should
2174 (string-equal 2176 (string-equal
@@ -2931,10 +2933,10 @@ This tests also `file-directory-p' and `file-accessible-directory-p'."
2931 (when (tramp--test-emacs28-p) 2933 (when (tramp--test-emacs28-p)
2932 (with-no-warnings 2934 (with-no-warnings
2933 (should 2935 (should
2934 (= 1 (length 2936 (equal
2935 (directory-files 2937 (directory-files
2936 tmp-name1 nil directory-files-no-dot-files-regexp 2938 tmp-name1 nil directory-files-no-dot-files-regexp nil 1)
2937 nil 1))))))) 2939 '("bla"))))))
2938 2940
2939 ;; Cleanup. 2941 ;; Cleanup.
2940 (ignore-errors (delete-directory tmp-name1 'recursive)))))) 2942 (ignore-errors (delete-directory tmp-name1 'recursive))))))
@@ -3457,8 +3459,9 @@ They might differ only in time attributes or directory size."
3457 ;; Check the COUNT arg. It exists since Emacs 28. 3459 ;; Check the COUNT arg. It exists since Emacs 28.
3458 (when (tramp--test-emacs28-p) 3460 (when (tramp--test-emacs28-p)
3459 (with-no-warnings 3461 (with-no-warnings
3460 (should (= 1 (length (directory-files-and-attributes 3462 (setq attr (directory-files-and-attributes
3461 tmp-name2 nil "\\`b" nil nil 1))))))) 3463 tmp-name2 nil "\\`b" nil nil 1))
3464 (should (equal (mapcar #'car attr) '("bar"))))))
3462 3465
3463 ;; Cleanup. 3466 ;; Cleanup.
3464 (ignore-errors (delete-directory tmp-name1 'recursive)))))) 3467 (ignore-errors (delete-directory tmp-name1 'recursive))))))
@@ -3470,10 +3473,7 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'."
3470 (skip-unless 3473 (skip-unless
3471 (or (tramp--test-sh-p) (tramp--test-sudoedit-p) 3474 (or (tramp--test-sh-p) (tramp--test-sudoedit-p)
3472 ;; Not all tramp-gvfs.el methods support changing the file mode. 3475 ;; Not all tramp-gvfs.el methods support changing the file mode.
3473 (and 3476 (tramp--test-gvfs-p "afp") (tramp--test-gvfs-p "ftp")))
3474 (tramp--test-gvfs-p)
3475 (string-match-p
3476 "ftp" (file-remote-p tramp-test-temporary-file-directory 'method)))))
3477 3477
3478 (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil))) 3478 (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
3479 (let ((tmp-name1 (tramp--test-make-temp-name nil quoted)) 3479 (let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
@@ -5705,6 +5705,13 @@ This does not support special file names."
5705 (tramp-sh-file-name-handler-p 5705 (tramp-sh-file-name-handler-p
5706 (tramp-dissect-file-name tramp-test-temporary-file-directory))) 5706 (tramp-dissect-file-name tramp-test-temporary-file-directory)))
5707 5707
5708(defun tramp--test-share-p ()
5709 "Check, whether the method needs a share."
5710 (and (tramp--test-gvfs-p)
5711 (string-match-p
5712 "^\\(afp\\|davs?\\|smb\\)$"
5713 (file-remote-p tramp-test-temporary-file-directory 'method))))
5714
5708(defun tramp--test-sudoedit-p () 5715(defun tramp--test-sudoedit-p ()
5709 "Check, whether the sudoedit method is used." 5716 "Check, whether the sudoedit method is used."
5710 (tramp-sudoedit-file-name-p tramp-test-temporary-file-directory)) 5717 (tramp-sudoedit-file-name-p tramp-test-temporary-file-directory))