diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi index 6a9103d3a09..42e252c417b 100644 --- a/doc/emacs/files.texi +++ b/doc/emacs/files.texi @@ -1888,6 +1888,11 @@ following in the Trash directory: liable to also delete this @code{.dir-locals.el} file, so this should only be done if you delete files from the Trash directory manually. +@vindex remote-file-name-inhibit-delete-by-moving-to-trash + If the variable @code{remote-file-name-inhibit-delete-by-moving-to-trash} +is non-@code{nil}, remote files are never moved to the Trash. They +are deleted instead. + @ifnottex If a file is under version control (@pxref{Version Control}), you should delete it using @kbd{M-x vc-delete-file} instead of @kbd{M-x diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index 91643530f7f..5cc4c1e7ddf 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi @@ -1871,6 +1871,11 @@ no prefix argument is given, and @code{nil} otherwise. See also @code{delete-directory} in @ref{Create/Delete Dirs}. @end deffn +@defopt remote-file-name-inhibit-delete-by-moving-to-trash +If this variable is non-@code{nil}, remote files are never moved to +the Trash. They are deleted instead. +@end defopt + @cindex file permissions, setting @cindex permissions, file @cindex file modes, setting diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 7f66dc9e849..a8a59f982fc 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -5215,9 +5215,10 @@ them, @ref{Misc File Ops, Trashing , , emacs}. @ifnotinfo them. @end ifnotinfo -Remote files are always trashed to the local trash, except remote -encrypted files (@pxref{Keeping files encrypted}), which are deleted -anyway. +Remote files are always trashed to the local trash, except the user +option @code{remote-file-name-inhibit-delete-by-moving-to-trash} is +non-@code{nil}, or it is a remote encrypted file (@pxref{Keeping files +encrypted}), which are deleted anyway. If Emacs is configured to use the XDG conventions for the trash directory, remote files cannot be restored with the respective tools, diff --git a/etc/NEWS b/etc/NEWS index 690e9c3faa9..60dab575da6 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -45,6 +45,11 @@ example, as part of preview for iconified frames. ** 'write-region-inhibit-fsync' now defaults to t in interactive mode, as it has in batch mode since Emacs 24. ++++ +** New user option 'remote-file-name-inhibit-delete-by-moving-to-trash'. +When non-nil, this option suppresses moving remote files to the local +trash when deleting. Default is nil. + * Editing Changes in Emacs 30.1 diff --git a/lisp/files.el b/lisp/files.el index e1b7a990b15..d0167bf3814 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -6336,6 +6336,12 @@ RECURSIVE if DIRECTORY is nonempty." directory-exists)) (files--force recursive #'delete-directory-internal directory)))))) +(defcustom remote-file-name-inhibit-delete-by-moving-to-trash nil + "Whether remote files shall be moved to the Trash. +This overrules any setting of `delete-by-moving-to-trash'." + :version "30.1" + :type 'boolean) + (defun file-equal-p (file1 file2) "Return non-nil if files FILE1 and FILE2 name the same file. If FILE1 or FILE2 does not exist, the return value is unspecified." diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el index 41c28672aae..a14122f815a 100644 --- a/lisp/net/ange-ftp.el +++ b/lisp/net/ange-ftp.el @@ -3534,7 +3534,8 @@ system TYPE.") (setq file (expand-file-name file)) (let ((parsed (ange-ftp-ftp-name file))) (if parsed - (if (and delete-by-moving-to-trash trash) + (if (and delete-by-moving-to-trash trash + (not remote-file-name-inhibit-delete-by-moving-to-trash)) (move-file-to-trash file) (let* ((host (nth 0 parsed)) (user (nth 1 parsed)) diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 619d29bb4d6..493a9fb39a9 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -424,14 +424,10 @@ Emacs dired can't find files." (defun tramp-adb-handle-delete-file (filename &optional trash) "Like `delete-file' for Tramp files." - (setq filename (expand-file-name filename)) - (with-parsed-tramp-file-name filename nil - (tramp-flush-file-properties v localname) - (if (and delete-by-moving-to-trash trash) - (move-file-to-trash filename) - (tramp-adb-barf-unless-okay - v (format "rm %s" (tramp-shell-quote-argument localname)) - "Couldn't delete %s" filename)))) + (tramp-skeleton-delete-file filename trash + (tramp-adb-barf-unless-okay + v (format "rm %s" (tramp-shell-quote-argument localname)) + "Couldn't delete %s" filename))) (defun tramp-adb-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for Tramp files." diff --git a/lisp/net/tramp-crypt.el b/lisp/net/tramp-crypt.el index 61d1c529619..507fd432419 100644 --- a/lisp/net/tramp-crypt.el +++ b/lisp/net/tramp-crypt.el @@ -689,17 +689,17 @@ absolute file names." (directory &optional recursive _trash) "Like `delete-directory' for Tramp files." (with-parsed-tramp-file-name (expand-file-name directory) nil - (tramp-flush-directory-properties v localname) (let (tramp-crypt-enabled) - (delete-directory (tramp-crypt-encrypt-file-name directory) recursive)))) + (delete-directory (tramp-crypt-encrypt-file-name directory) recursive)) + (tramp-flush-directory-properties v localname))) ;; Encrypted files won't be trashed. (defun tramp-crypt-handle-delete-file (filename &optional _trash) "Like `delete-file' for Tramp files." (with-parsed-tramp-file-name (expand-file-name filename) nil - (tramp-flush-file-properties v localname) (let (tramp-crypt-enabled) - (delete-file (tramp-crypt-encrypt-file-name filename))))) + (delete-file (tramp-crypt-encrypt-file-name filename))) + (tramp-flush-file-properties v localname))) (defun tramp-crypt-handle-directory-files (directory &optional full match nosort count) diff --git a/lisp/net/tramp-fuse.el b/lisp/net/tramp-fuse.el index c8754e2b03d..b846caadc18 100644 --- a/lisp/net/tramp-fuse.el +++ b/lisp/net/tramp-fuse.el @@ -34,15 +34,13 @@ (defun tramp-fuse-handle-delete-directory (directory &optional recursive trash) "Like `delete-directory' for Tramp files." - (with-parsed-tramp-file-name (expand-file-name directory) nil - (tramp-flush-directory-properties v localname) + (tramp-skeleton-delete-directory directory recursive trash (delete-directory (tramp-fuse-local-file-name directory) recursive trash))) (defun tramp-fuse-handle-delete-file (filename &optional trash) "Like `delete-file' for Tramp files." - (with-parsed-tramp-file-name (expand-file-name filename) nil - (delete-file (tramp-fuse-local-file-name filename) trash) - (tramp-flush-file-properties v localname))) + (tramp-skeleton-delete-file filename trash + (delete-file (tramp-fuse-local-file-name filename) trash))) (defvar tramp-fuse-remove-hidden-files nil "Remove hidden files from directory listings.") diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index bb81b3eb66c..cca7a5fe247 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -1139,18 +1139,15 @@ file names." (defun tramp-gvfs-handle-delete-file (filename &optional trash) "Like `delete-file' for Tramp files." - (with-parsed-tramp-file-name (expand-file-name filename) nil - (tramp-flush-file-properties v localname) - (if (and delete-by-moving-to-trash trash) - (move-file-to-trash filename) - (unless (and (tramp-gvfs-send-command - v "gvfs-rm" (tramp-gvfs-url-file-name filename)) - (not (tramp-gvfs-info filename))) - ;; Propagate the error. - (with-current-buffer (tramp-get-connection-buffer v) - (goto-char (point-min)) - (tramp-error-with-buffer - nil v 'file-error "Couldn't delete %s" filename)))))) + (tramp-skeleton-delete-file filename trash + (unless (and (tramp-gvfs-send-command + v "gvfs-rm" (tramp-gvfs-url-file-name filename)) + (not (tramp-gvfs-info filename))) + ;; Propagate the error. + (with-current-buffer (tramp-get-connection-buffer v) + (goto-char (point-min)) + (tramp-error-with-buffer + nil v 'file-error "Couldn't delete %s" filename))))) (defun tramp-gvfs-handle-expand-file-name (name &optional dir) "Like `expand-file-name' for Tramp files." diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index fbdd40dd1d2..4647600071c 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -2567,14 +2567,10 @@ The method used must be an out-of-band method." (defun tramp-sh-handle-delete-file (filename &optional trash) "Like `delete-file' for Tramp files." - (setq filename (expand-file-name (expand-file-name filename))) - (with-parsed-tramp-file-name filename nil - (if (and delete-by-moving-to-trash trash) - (move-file-to-trash filename) - (tramp-barf-unless-okay - v (format "rm -f %s" (tramp-shell-quote-argument localname)) - "Couldn't delete %s" filename)) - (tramp-flush-file-properties v localname))) + (tramp-skeleton-delete-file filename trash + (tramp-barf-unless-okay + v (format "rm -f %s" (tramp-shell-quote-argument localname)) + "Couldn't delete %s" filename))) ;; Dired. diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index f31865d498d..d6f3cca9733 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -695,24 +695,17 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (defun tramp-smb-handle-delete-file (filename &optional trash) "Like `delete-file' for Tramp files." - (setq filename (expand-file-name filename)) - (when (file-exists-p filename) - (with-parsed-tramp-file-name filename nil - ;; We must also flush the cache of the directory, because - ;; `file-attributes' reads the values from there. - (tramp-flush-file-properties v localname) - (if (and delete-by-moving-to-trash trash) - (move-file-to-trash filename) - (unless (tramp-smb-send-command - v (format - "%s %s" - (if (tramp-smb-get-cifs-capabilities v) "posix_unlink" "rm") - (tramp-smb-shell-quote-localname v))) - ;; Error. - (with-current-buffer (tramp-get-connection-buffer v) - (goto-char (point-min)) - (search-forward-regexp tramp-smb-errors nil t) - (tramp-error v 'file-error "%s `%s'" (match-string 0) filename))))))) + (tramp-skeleton-delete-file filename trash + (unless (tramp-smb-send-command + v (format + "%s %s" + (if (tramp-smb-get-cifs-capabilities v) "posix_unlink" "rm") + (tramp-smb-shell-quote-localname v))) + ;; Error. + (with-current-buffer (tramp-get-connection-buffer v) + (goto-char (point-min)) + (search-forward-regexp tramp-smb-errors nil t) + (tramp-error v 'file-error "%s `%s'" (match-string 0) filename))))) (defun tramp-smb-handle-expand-file-name (name &optional dir) "Like `expand-file-name' for Tramp files." diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el index c4e1d32f525..2660dbb1fac 100644 --- a/lisp/net/tramp-sudoedit.el +++ b/lisp/net/tramp-sudoedit.el @@ -347,17 +347,14 @@ absolute file names." (defun tramp-sudoedit-handle-delete-file (filename &optional trash) "Like `delete-file' for Tramp files." - (with-parsed-tramp-file-name (expand-file-name filename) nil - (tramp-flush-file-properties v localname) - (if (and delete-by-moving-to-trash trash) - (move-file-to-trash filename) - (unless (tramp-sudoedit-send-command - v "rm" "-f" (file-name-unquote localname)) - ;; Propagate the error. - (with-current-buffer (tramp-get-connection-buffer v) - (goto-char (point-min)) - (tramp-error-with-buffer - nil v 'file-error "Couldn't delete %s" filename)))))) + (tramp-skeleton-delete-file filename trash + (unless (tramp-sudoedit-send-command + v "rm" "-f" (file-name-unquote localname)) + ;; Propagate the error. + (with-current-buffer (tramp-get-connection-buffer v) + (goto-char (point-min)) + (tramp-error-with-buffer + nil v 'file-error "Couldn't delete %s" filename))))) (defun tramp-sudoedit-handle-expand-file-name (name &optional dir) "Like `expand-file-name' for Tramp files. diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 4bf0fdefc0b..b8475b7cb48 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -3399,15 +3399,35 @@ BODY is the backend specific code." BODY is the backend specific code." (declare (indent 3) (debug t)) `(with-parsed-tramp-file-name (expand-file-name ,directory) nil - (if (and delete-by-moving-to-trash ,trash) - ;; Move non-empty dir to trash only if recursive deletion was - ;; requested. - (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)) - ,@body) - (tramp-flush-directory-properties v localname))) + (let ((delete-by-moving-to-trash + (and delete-by-moving-to-trash + ;; This variable exists since Emacs 30.1. + (not (bound-and-true-p + remote-file-name-inhibit-delete-by-moving-to-trash))))) + (if (and delete-by-moving-to-trash ,trash) + ;; Move non-empty dir to trash only if recursive deletion was + ;; requested. + (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)) + ,@body) + (tramp-flush-directory-properties v localname)))) + +(defmacro tramp-skeleton-delete-file (filename &optional trash &rest body) + "Skeleton for `tramp-*-handle-delete-file'. +BODY is the backend specific code." + (declare (indent 2) (debug t)) + `(with-parsed-tramp-file-name (expand-file-name ,filename) nil + (let ((delete-by-moving-to-trash + (and delete-by-moving-to-trash + ;; This variable exists since Emacs 30.1. + (not (bound-and-true-p + remote-file-name-inhibit-delete-by-moving-to-trash))))) + (if (and delete-by-moving-to-trash ,trash) + (move-file-to-trash ,filename) + ,@body) + (tramp-flush-file-properties v localname)))) (defmacro tramp-skeleton-directory-files (directory &optional full match nosort count &rest body) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 90f6fcd6b15..dd3de27d3b9 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -80,6 +80,9 @@ (defvar remote-file-name-inhibit-locks) (defvar dired-copy-dereference) +;; Declared in Emacs 30. +(defvar remote-file-name-inhibit-delete-by-moving-to-trash) + ;; `ert-resource-file' was introduced in Emacs 28.1. (unless (macrop 'ert-resource-file) (eval-and-compile @@ -2345,7 +2348,24 @@ This checks also `file-name-as-directory', `file-name-directory', (expand-file-name (file-name-nondirectory tmp-name) trash-directory)))) (delete-directory trash-directory 'recursive) - (should-not (file-exists-p trash-directory))))))) + (should-not (file-exists-p trash-directory)))) + + ;; Setting `remote-file-name-inhibit-delete-by-moving-to-trash' + ;; prevents trashing remote files. + (let ((trash-directory (tramp--test-make-temp-name 'local quoted)) + (delete-by-moving-to-trash t) + (remote-file-name-inhibit-delete-by-moving-to-trash t)) + (make-directory trash-directory) + (should-not (file-exists-p tmp-name)) + (write-region "foo" nil tmp-name) + (should (file-exists-p tmp-name)) + (delete-file tmp-name 'trash) + (should-not (file-exists-p tmp-name)) + (should-not + (file-exists-p + (expand-file-name (file-name-nondirectory tmp-name) trash-directory))) + (delete-directory trash-directory 'recursive) + (should-not (file-exists-p trash-directory)))))) (ert-deftest tramp-test08-file-local-copy () "Check `file-local-copy'." @@ -2953,7 +2973,23 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." "%s/%s/%s/bla" trash-directory (file-name-nondirectory tmp-name1) (file-name-nondirectory tmp-name2)))) (delete-directory trash-directory 'recursive) - (should-not (file-exists-p trash-directory))))))) + (should-not (file-exists-p trash-directory)))) + + ;; Setting `remote-file-name-inhibit-delete-by-moving-to-trash' + ;; prevents trashing remote files. + (let ((trash-directory (tramp--test-make-temp-name 'local quoted)) + (delete-by-moving-to-trash t) + (remote-file-name-inhibit-delete-by-moving-to-trash t)) + (make-directory trash-directory) + (make-directory tmp-name1) + (should (file-directory-p tmp-name1)) + (delete-directory tmp-name1 nil 'trash) + (should-not (file-exists-p tmp-name1)) + (should-not + (file-exists-p + (expand-file-name (file-name-nondirectory tmp-name1) trash-directory))) + (delete-directory trash-directory 'recursive) + (should-not (file-exists-p trash-directory)))))) (ert-deftest tramp-test15-copy-directory () "Check `copy-directory'." @@ -7518,6 +7554,8 @@ Since it unloads Tramp, it shall be the last test to run." ;; `tramp-register-archive-file-name-handler' is autoloaded ;; in Emacs < 29.1. (not (eq 'tramp-register-archive-file-name-handler x)) + ;; `tramp-compat-rx' is autoloaded in Emacs 29.1. + (not (eq 'tramp-compat-rx x)) (not (string-match-p (rx bol "tramp" (? "-archive") (** 1 2 "-") "test") (symbol-name x))) @@ -7577,6 +7615,8 @@ If INTERACTIVE is non-nil, the tests are run interactively." ;; * file-equal-p (partly done in `tramp-test21-file-links') ;; * file-in-directory-p ;; * file-name-case-insensitive-p +;; * memory-info +;; * tramp-get-home-directory ;; * tramp-get-remote-gid ;; * tramp-get-remote-groups ;; * tramp-get-remote-uid