summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--lisp/files.el5
-rw-r--r--lisp/net/ange-ftp.el118
-rw-r--r--lisp/net/tramp-compat.el27
-rw-r--r--lisp/net/tramp-gvfs.el2
-rw-r--r--lisp/net/tramp-sh.el3
-rw-r--r--lisp/net/tramp.el6
-rw-r--r--test/lisp/net/tramp-tests.el23
7 files changed, 118 insertions, 66 deletions
diff --git a/lisp/files.el b/lisp/files.el
index e55552a2d9a..deb878cf418 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -5867,10 +5867,7 @@ RECURSIVE if DIRECTORY is nonempty."
;; case, where the operation fails in delete-directory-internal.
;; As `move-file-to-trash' trashes directories (empty or
;; otherwise) as a unit, we do not need to recurse here.
- (if (and (not recursive)
- ;; Check if directory is empty apart from "." and "..".
- (directory-files
- directory 'full directory-files-no-dot-files-regexp))
+ (if (not (or recursive (directory-empty-p directory)))
(error "Directory is not empty, not moving to trash")
(move-file-to-trash directory)))
;; Otherwise, call ourselves recursively if needed.
diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el
index 15322219eff..e0c162df577 100644
--- a/lisp/net/ange-ftp.el
+++ b/lisp/net/ange-ftp.el
@@ -3536,20 +3536,22 @@ system TYPE.")
(setq file (expand-file-name file))
(let ((parsed (ange-ftp-ftp-name file)))
(if parsed
- (let* ((host (nth 0 parsed))
- (user (nth 1 parsed))
- (name (ange-ftp-quote-string (nth 2 parsed)))
- (abbr (ange-ftp-abbreviate-filename file))
- (result (ange-ftp-send-cmd host user
- (list 'delete name)
- (format "Deleting %s" abbr))))
- (or (car result)
- (signal 'ftp-error
- (list
- "Removing old name"
- (format "FTP Error: \"%s\"" (cdr result))
- file)))
- (ange-ftp-delete-file-entry file))
+ (if (and delete-by-moving-to-trash trash)
+ (move-file-to-trash file)
+ (let* ((host (nth 0 parsed))
+ (user (nth 1 parsed))
+ (name (ange-ftp-quote-string (nth 2 parsed)))
+ (abbr (ange-ftp-abbreviate-filename file))
+ (result (ange-ftp-send-cmd host user
+ (list 'delete name)
+ (format "Deleting %s" abbr))))
+ (or (car result)
+ (signal 'ftp-error
+ (list
+ "Removing old name"
+ (format "FTP Error: \"%s\"" (cdr result))
+ file)))
+ (ange-ftp-delete-file-entry file)))
(ange-ftp-real-delete-file file trash))))
(defun ange-ftp-file-modtime (file)
@@ -4163,45 +4165,55 @@ directory, so that Emacs will know its current contents."
(defun ange-ftp-delete-directory (dir &optional recursive trash)
(if (file-directory-p dir)
- (let ((parsed (ange-ftp-ftp-name dir)))
- (if recursive
- (mapc
- (lambda (file)
- (if (file-directory-p file)
- (ange-ftp-delete-directory file recursive trash)
- (delete-file file trash)))
- (directory-files dir 'full directory-files-no-dot-files-regexp)))
- (if parsed
- (let* ((host (nth 0 parsed))
- (user (nth 1 parsed))
- ;; Some ftp's on unix machines (at least on Suns)
- ;; insist that rmdir take a filename, and not a
- ;; directory-name name as an arg. Argh!! This is a bug.
- ;; Non-unix machines will probably always insist
- ;; that rmdir takes a directory-name as an arg
- ;; (as the ftp man page says it should).
- (name (ange-ftp-quote-string
- (if (eq (ange-ftp-host-type host) 'unix)
- (ange-ftp-real-directory-file-name
- (nth 2 parsed))
- (ange-ftp-real-file-name-as-directory
- (nth 2 parsed)))))
- (abbr (ange-ftp-abbreviate-filename dir))
- (result
- (progn
- ;; CWD must not in this directory.
- (ange-ftp-cd host user "/" 'noerror)
- (ange-ftp-send-cmd host user
- (list 'rmdir name)
- (format "Removing directory %s"
- abbr)))))
- (or (car result)
- (ange-ftp-error host user
- (format "Could not remove directory %s: %s"
- dir
- (cdr result))))
- (ange-ftp-delete-file-entry dir t))
- (ange-ftp-real-delete-directory dir recursive trash)))
+ ;; Trashing directories does not work yet, because
+ ;; `rename-file', called in `move-file-to-trash', does not
+ ;; handle directories.
+ (if nil ; (and delete-by-moving-to-trash trash)
+ ;; Move non-empty dir to trash only if recursive deletion was
+ ;; requested.
+ (if (not (or recursive (directory-empty-p dir)))
+ (signal 'ftp-error
+ (list "Directory is not empty, not moving to trash"))
+ (move-file-to-trash dir))
+ (let ((parsed (ange-ftp-ftp-name dir)))
+ (if recursive
+ (mapc
+ (lambda (file)
+ (if (file-directory-p file)
+ (ange-ftp-delete-directory file recursive)
+ (delete-file file)))
+ (directory-files dir 'full directory-files-no-dot-files-regexp)))
+ (if parsed
+ (let* ((host (nth 0 parsed))
+ (user (nth 1 parsed))
+ ;; Some ftp's on unix machines (at least on Suns)
+ ;; insist that rmdir take a filename, and not a
+ ;; directory-name name as an arg. Argh!! This is a bug.
+ ;; Non-unix machines will probably always insist
+ ;; that rmdir takes a directory-name as an arg
+ ;; (as the ftp man page says it should).
+ (name (ange-ftp-quote-string
+ (if (eq (ange-ftp-host-type host) 'unix)
+ (ange-ftp-real-directory-file-name
+ (nth 2 parsed))
+ (ange-ftp-real-file-name-as-directory
+ (nth 2 parsed)))))
+ (abbr (ange-ftp-abbreviate-filename dir))
+ (result
+ (progn
+ ;; CWD must not in this directory.
+ (ange-ftp-cd host user "/" 'noerror)
+ (ange-ftp-send-cmd host user
+ (list 'rmdir name)
+ (format "Removing directory %s"
+ abbr)))))
+ (or (car result)
+ (ange-ftp-error host user
+ (format "Could not remove directory %s: %s"
+ dir
+ (cdr result))))
+ (ange-ftp-delete-file-entry dir t))
+ (ange-ftp-real-delete-directory dir recursive trash))))
(error "Not a directory: %s" dir)))
;; Make a local copy of FILE and return its name.
diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el
index c554a8d0c2d..9a4e16efe20 100644
--- a/lisp/net/tramp-compat.el
+++ b/lisp/net/tramp-compat.el
@@ -309,6 +309,30 @@ A nil value for either argument stands for the current time."
(lambda (filename &optional timestamp _flag)
(set-file-times filename timestamp))))
+;; `directory-files' and `directory-files-and-attributes' got argument
+;; COUNT in Emacs 28.1.
+(defalias 'tramp-compat-directory-files
+ (if (equal (tramp-compat-funcall 'func-arity #'directory-files) '(1 . 5))
+ #'directory-files
+ (lambda (directory &optional full match nosort _count)
+ (directory-files directory full match nosort))))
+
+(defalias 'tramp-compat-directory-files-and-attributes
+ (if (equal (tramp-compat-funcall 'func-arity #'directory-files-and-attributes)
+ '(1 . 6))
+ #'directory-files-and-attributes
+ (lambda (directory &optional full match nosort id-format _count)
+ (directory-files-and-attributes directory full match nosort id-format))))
+
+;; `directory-empty-p' is new in Emacs 28.1.
+(defalias 'tramp-compat-directory-empty-p
+ (if (fboundp 'directory-empty-p)
+ #'directory-empty-p
+ (lambda (dir)
+ (and (file-directory-p dir)
+ (null (tramp-compat-directory-files
+ dir nil directory-files-no-dot-files-regexp t 1))))))
+
(add-hook 'tramp-unload-hook
(lambda ()
(unload-feature 'tramp-loaddefs 'force)
@@ -322,5 +346,8 @@ A nil value for either argument stands for the current time."
;;
;; * Starting with Emacs 27.1, there's no need to escape open
;; parentheses with a backslash in docstrings anymore.
+;;
+;; * Starting with Emacs 27.1, there's `make-empty-file'. Could be
+;; used instead of `write-region'.
;;; tramp-compat.el ends here
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index bf55777e335..86fb45a43b7 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -1088,7 +1088,7 @@ file names."
(delete-file file)))
(directory-files
directory 'full directory-files-no-dot-files-regexp))
- (when (directory-files directory nil directory-files-no-dot-files-regexp)
+ (unless (tramp-compat-directory-empty-p directory)
(tramp-error
v 'file-error "Couldn't delete non-empty %s" directory)))
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 915ce2f6a65..655949a79b8 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -1738,6 +1738,9 @@ 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)))
+
(or (if nosort
result
(sort result (lambda (x y) (string< (car x) (car y)))))
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index ce0a2b54ff5..1859e843758 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -3145,7 +3145,7 @@ User is always nil."
(lambda (x)
(cons x (file-attributes
(if full x (expand-file-name x directory)) id-format)))
- (directory-files directory full match nosort count)))
+ (tramp-compat-directory-files directory full match nosort count)))
(defun tramp-handle-dired-uncache (dir)
"Like `dired-uncache' for Tramp files."
@@ -5346,9 +5346,7 @@ BODY is the backend specific code."
(if (and delete-by-moving-to-trash ,trash)
;; Move non-empty dir to trash only if recursive deletion was
;; requested.
- (if (and (not ,recursive)
- (directory-files
- ,directory nil directory-files-no-dot-files-regexp))
+ (if (not (or ,recursive (tramp-compat-directory-empty-p ,directory)))
(tramp-error
v 'file-error "Directory is not empty, not moving to trash")
(move-file-to-trash ,directory))
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 50db55ebb4f..2670723ecdc 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -2783,8 +2783,9 @@ This tests also `file-directory-p' and `file-accessible-directory-p'."
(should-not (file-directory-p tmp-name1))
;; Trashing directories works only since Emacs 27.1. It doesn't
- ;; work for crypted remote directories.
- (when (and (not (tramp--test-crypt-p)) (tramp--test-emacs27-p))
+ ;; work for crypted remote directories and for ange-ftp.
+ (when (and (not (tramp--test-crypt-p)) (not (tramp--test-ftp-p))
+ (tramp--test-emacs27-p))
(let ((trash-directory (tramp--test-make-temp-name 'local quoted))
(delete-by-moving-to-trash t))
(make-directory trash-directory)
@@ -2925,7 +2926,15 @@ This tests also `file-directory-p' and `file-accessible-directory-p'."
'("bla" "foo")))
(should (equal (directory-files
tmp-name1 'full directory-files-no-dot-files-regexp)
- `(,tmp-name2 ,tmp-name3))))
+ `(,tmp-name2 ,tmp-name3)))
+ ;; Check the COUNT arg. It exists since Emacs 28.
+ (when (tramp--test-emacs28-p)
+ (with-no-warnings
+ (should
+ (= 1 (length
+ (directory-files
+ tmp-name1 nil directory-files-no-dot-files-regexp
+ nil 1)))))))
;; Cleanup.
(ignore-errors (delete-directory tmp-name1 'recursive))))))
@@ -3443,7 +3452,13 @@ They might differ only in time attributes or directory size."
(file-attributes (car elt)) (cdr elt))))
(setq attr (directory-files-and-attributes tmp-name2 nil "\\`b"))
- (should (equal (mapcar #'car attr) '("bar" "boz"))))
+ (should (equal (mapcar #'car attr) '("bar" "boz")))
+
+ ;; 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)))))))
;; Cleanup.
(ignore-errors (delete-directory tmp-name1 'recursive))))))
generated by cgit v1.2.3 (git 2.39.1) at 2025-04-08 10:57:48 +0000