From: Michael Albinus Date: Sun, 1 Nov 2020 11:42:29 +0000 (+0100) Subject: Trash remote files to local trash (Bug#44216) X-Git-Tag: emacs-28.0.90~5299 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=06585bb939ed61574a4b79455c58cab02f11f0fc;p=emacs.git Trash remote files to local trash (Bug#44216) * doc/misc/tramp.texi (Frequently Asked Questions): Add trashing. * lisp/net/tramp-adb.el (tramp-adb-handle-delete-directory) (tramp-adb-handle-delete-file): * lisp/net/tramp-gvfs.el (tramp-gvfs-handle-delete-directory) (tramp-gvfs-handle-delete-file): * lisp/net/tramp-sh.el (tramp-sh-handle-delete-directory) (tramp-sh-handle-delete-file): * lisp/net/tramp-smb.el (tramp-smb-handle-delete-directory) (tramp-smb-handle-delete-file): * lisp/net/tramp-sudoedit.el (tramp-sudoedit-handle-delete-directory) (tramp-sudoedit-handle-delete-file): Implement local trash. (Bug#44216) * lisp/net/tramp-crypt.el (tramp-crypt-handle-delete-directory) (tramp-crypt-handle-delete-file): Do not trash. * lisp/net/tramp.el (tramp-skeleton-delete-directory): New defmacro. * test/lisp/net/tramp-tests.el (tramp-test07-file-exists-p) (tramp-test14-delete-directory): Add trashing. --- diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index a7339bf2988..6738ed5123d 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -4511,6 +4511,21 @@ HISTFILE=/dev/null @end example +@item +Where are remote files trashed to? + +Emacs can trash file instead of deleting them, @ref{Misc File Ops, +Trashing , , emacs}. Remote files are always trashed to the local +trash, except remote encrypted files (@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, +because those conventions don't specify remote paths. Such files must +be restored by moving them manually from +@file{$@{XDG_DATA_HOME@}/Trash/files/}, if needed. + + @item How to shorten long file names when typing in @value{tramp}? diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 49ecaa58ee8..3d3b955e8c2 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -437,27 +437,25 @@ Emacs dired can't find files." (and parents (file-directory-p dir))) (tramp-error v 'file-error "Couldn't make directory %s" dir)))) -(defun tramp-adb-handle-delete-directory (directory &optional recursive _trash) +(defun tramp-adb-handle-delete-directory (directory &optional recursive trash) "Like `delete-directory' for Tramp files." - (setq directory (expand-file-name directory)) - (with-parsed-tramp-file-name (file-truename directory) nil - (tramp-flush-directory-properties v localname)) - (with-parsed-tramp-file-name directory nil - (tramp-flush-directory-properties v localname) + (tramp-skeleton-delete-directory directory recursive trash (tramp-adb-barf-unless-okay v (format "%s %s" (if recursive "rm -r" "rmdir") (tramp-shell-quote-argument localname)) "Couldn't delete %s" directory))) -(defun tramp-adb-handle-delete-file (filename &optional _trash) +(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) - (tramp-adb-barf-unless-okay - v (format "rm %s" (tramp-shell-quote-argument localname)) - "Couldn't delete %s" filename))) + (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)))) (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 3e96daa7b1f..286b60a48c2 100644 --- a/lisp/net/tramp-crypt.el +++ b/lisp/net/tramp-crypt.el @@ -651,21 +651,22 @@ absolute file names." (list filename newname ok-if-already-exists keep-date preserve-uid-gid preserve-extended-attributes)))) +;; Crypted files won't be trashed. (defun tramp-crypt-handle-delete-directory - (directory &optional recursive trash) + (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 trash)))) + (delete-directory (tramp-crypt-encrypt-file-name directory) recursive)))) -(defun tramp-crypt-handle-delete-file (filename &optional trash) +;; Crypted 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) trash)))) + (delete-file (tramp-crypt-encrypt-file-name filename))))) (defun tramp-crypt-handle-directory-files (directory &optional full match nosort) "Like `directory-files' for Tramp files." diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 6467d8f88b4..bf55777e335 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -691,8 +691,7 @@ It has been changed in GVFS 1.14.") ("gvfs-move" . "move") ("gvfs-rename" . "rename") ("gvfs-rm" . "remove") - ("gvfs-set-attribute" . "set") - ("gvfs-trash" . "trash")) + ("gvfs-set-attribute" . "set")) "List of cons cells, mapping \"gvfs-\" to \"gio \".") ;; @@ -1080,24 +1079,21 @@ file names." (defun tramp-gvfs-handle-delete-directory (directory &optional recursive trash) "Like `delete-directory' for Tramp files." - (with-parsed-tramp-file-name directory nil + (tramp-skeleton-delete-directory directory recursive trash (if (and recursive (not (file-symlink-p directory))) (mapc (lambda (file) (if (eq t (tramp-compat-file-attribute-type (file-attributes file))) - (delete-directory file recursive trash) - (delete-file file trash))) + (delete-directory file recursive) + (delete-file file))) (directory-files directory 'full directory-files-no-dot-files-regexp)) (when (directory-files directory nil directory-files-no-dot-files-regexp) (tramp-error v 'file-error "Couldn't delete non-empty %s" directory))) - (tramp-flush-directory-properties v localname) - (unless - (tramp-gvfs-send-command - v (if (and trash delete-by-moving-to-trash) "gvfs-trash" "gvfs-rm") - (tramp-gvfs-url-file-name directory)) + (unless (tramp-gvfs-send-command + v "gvfs-rm" (tramp-gvfs-url-file-name directory)) ;; Propagate the error. (with-current-buffer (tramp-get-connection-buffer v) (goto-char (point-min)) @@ -1108,15 +1104,15 @@ file names." "Like `delete-file' for Tramp files." (with-parsed-tramp-file-name filename nil (tramp-flush-file-properties v localname) - (unless - (tramp-gvfs-send-command - v (if (and trash delete-by-moving-to-trash) "gvfs-trash" "gvfs-rm") - (tramp-gvfs-url-file-name 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))))) + (if (and delete-by-moving-to-trash trash) + (move-file-to-trash filename) + (unless (tramp-gvfs-send-command + v "gvfs-rm" (tramp-gvfs-url-file-name 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 f1b45ee851e..860641b2589 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -2523,13 +2523,10 @@ The method used must be an out-of-band method." (defun tramp-sh-handle-delete-directory (directory &optional recursive trash) "Like `delete-directory' for Tramp files." - (setq directory (expand-file-name directory)) - (with-parsed-tramp-file-name directory nil - (tramp-flush-directory-properties v localname) + (tramp-skeleton-delete-directory directory recursive trash (tramp-barf-unless-okay v (format "cd / && %s %s" - (or (and trash (tramp-get-remote-trash v)) - (if recursive "rm -rf" "rmdir")) + (if recursive "rm -rf" "rmdir") (tramp-shell-quote-argument localname)) "Couldn't delete %s" directory))) @@ -2538,11 +2535,11 @@ The method used must be an out-of-band method." (setq filename (expand-file-name filename)) (with-parsed-tramp-file-name filename nil (tramp-flush-file-properties v localname) - (tramp-barf-unless-okay - v (format "%s %s" - (or (and trash (tramp-get-remote-trash v)) "rm -f") - (tramp-shell-quote-argument localname)) - "Couldn't delete %s" filename))) + (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)))) ;; Dired. diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 1b6af2a2e33..c236e1cb65f 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -635,41 +635,39 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (file-attributes filename)) (unless ok-if-already-exists 'nofollow))))) -(defun tramp-smb-handle-delete-directory (directory &optional recursive _trash) +(defun tramp-smb-handle-delete-directory (directory &optional recursive trash) "Like `delete-directory' for Tramp files." - (setq directory (directory-file-name (expand-file-name directory))) - (when (file-exists-p directory) - (when recursive - (mapc - (lambda (file) - (if (file-directory-p file) - (delete-directory file recursive) - (delete-file file))) - ;; We do not want to delete "." and "..". - (directory-files directory 'full directory-files-no-dot-files-regexp))) - - (with-parsed-tramp-file-name directory nil + (tramp-skeleton-delete-directory directory recursive trash + (when (file-exists-p directory) + (when recursive + (mapc + (lambda (file) + (if (file-directory-p file) + (delete-directory file recursive) + (delete-file file))) + ;; We do not want to delete "." and "..". + (directory-files directory 'full directory-files-no-dot-files-regexp))) + ;; We must also flush the cache of the directory, because ;; `file-attributes' reads the values from there. (tramp-flush-directory-properties v localname) (unless (tramp-smb-send-command v (format "%s \"%s\"" - (if (tramp-smb-get-cifs-capabilities v) "posix_rmdir" "rmdir") + (if (tramp-smb-get-cifs-capabilities v) + "posix_rmdir" "rmdir") (tramp-smb-get-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) directory))) + (tramp-error v 'file-error "%s `%s'" (match-string 0) directory))) ;; "rmdir" does not report an error. So we check ourselves. (when (file-exists-p directory) - (tramp-error - v 'file-error "`%s' not removed." directory))))) + (tramp-error v 'file-error "`%s' not removed." directory))))) -(defun tramp-smb-handle-delete-file (filename &optional _trash) +(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) @@ -677,17 +675,18 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." ;; We must also flush the cache of the directory, because ;; `file-attributes' reads the values from there. (tramp-flush-file-properties v localname) - (unless (tramp-smb-send-command - v (format - "%s \"%s\"" - (if (tramp-smb-get-cifs-capabilities v) "posix_unlink" "rm") - (tramp-smb-get-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)))))) + (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-get-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-directory-files (directory &optional full match nosort) diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el index 98727dc4a87..558a57b2ead 100644 --- a/lisp/net/tramp-sudoedit.el +++ b/lisp/net/tramp-sudoedit.el @@ -321,29 +321,25 @@ absolute file names." (defun tramp-sudoedit-handle-delete-directory (directory &optional recursive trash) "Like `delete-directory' for Tramp files." - (setq directory (expand-file-name directory)) - (with-parsed-tramp-file-name directory nil - (tramp-flush-directory-properties v localname) - (unless - (tramp-sudoedit-send-command - v (or (and trash "trash") - (if recursive '("rm" "-rf") "rmdir")) - (tramp-compat-file-name-unquote localname)) + (tramp-skeleton-delete-directory directory recursive trash + (unless (tramp-sudoedit-send-command + v (if recursive '("rm" "-rf") "rmdir") + (tramp-compat-file-name-unquote localname)) (tramp-error v 'file-error "Couldn't delete %s" directory)))) (defun tramp-sudoedit-handle-delete-file (filename &optional trash) "Like `delete-file' for Tramp files." (with-parsed-tramp-file-name filename nil (tramp-flush-file-properties v localname) - (unless - (tramp-sudoedit-send-command - v (if (and trash delete-by-moving-to-trash) "trash" "rm") - (tramp-compat-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))))) + (if (and delete-by-moving-to-trash trash) + (move-file-to-trash filename) + (unless (tramp-sudoedit-send-command + v "rm" (tramp-compat-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 0c85025d542..f3966479dbf 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -3864,7 +3864,7 @@ It does not support `:stderr'." p)))))) (defun tramp-handle-make-symbolic-link - (target linkname &optional ok-if-already-exists) + (target linkname &optional ok-if-already-exists) "Like `make-symbolic-link' for Tramp files. This is the fallback implementation for backends which do not support symbolic links." @@ -3877,8 +3877,7 @@ support symbolic links." (tramp-run-real-handler #'make-symbolic-link (list target linkname ok-if-already-exists)))) -(defun tramp-handle-shell-command - (command &optional output-buffer error-buffer) +(defun tramp-handle-shell-command (command &optional output-buffer error-buffer) "Like `shell-command' for Tramp files." (let* ((asynchronous (string-match-p "[ \t]*&[ \t]*\\'" command)) (command (substring command 0 asynchronous)) @@ -4662,6 +4661,7 @@ If both files are local, the function returns t." (and (tramp-tramp-file-p file1) (tramp-tramp-file-p file2) (string-equal (file-remote-p file1) (file-remote-p file2))))) +;; See also `file-modes-symbolic-to-number'. (defun tramp-mode-string-to-int (mode-string) "Convert a ten-letter \"drwxrwxrwx\"-style MODE-STRING into mode bits." (let* (case-fold-search @@ -4741,6 +4741,7 @@ If both files are local, the function returns t." "A list of file types returned from the `stat' system call. This is used to map a mode number to a permission string.") +;; See also `file-modes-number-to-symbolic'. (defun tramp-file-mode-from-int (mode) "Turn an integer representing a file MODE into an ls(1)-like string." (let ((type (cdr @@ -5333,6 +5334,25 @@ name of a process or buffer, or nil to default to the current buffer." (lambda () (remove-hook 'interrupt-process-functions #'tramp-interrupt-process)))) +(defmacro tramp-skeleton-delete-directory (directory recursive trash &rest body) + "Skeleton for `tramp-*-handle-delete-directory'. +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 (and (not ,recursive) + (directory-files + ,directory nil directory-files-no-dot-files-regexp)) + (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))) + +(put #'tramp-skeleton-delete-directory 'tramp-suppress-trace t) + ;; Checklist for `tramp-unload-hook' ;; - Unload all `tramp-*' packages ;; - Reset `file-name-handler-alist' diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 2c5b4bf18d8..50db55ebb4f 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -2266,7 +2266,24 @@ This checks also `file-name-as-directory', `file-name-directory', (write-region "foo" nil tmp-name) (should (file-exists-p tmp-name)) (delete-file tmp-name) - (should-not (file-exists-p tmp-name))))) + (should-not (file-exists-p tmp-name)) + + ;; Trashing files doesn't work for crypted remote files. + (unless (tramp--test-crypt-p) + (let ((trash-directory (tramp--test-make-temp-name 'local quoted)) + (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 + (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'." @@ -2431,7 +2448,7 @@ This checks also `file-name-as-directory', `file-name-directory', (should-error (cl-letf (((symbol-function #'y-or-n-p) #'ignore) ;; Ange-FTP. - ((symbol-function 'yes-or-no-p) 'ignore)) + ((symbol-function #'yes-or-no-p) #'ignore)) (write-region "foo" nil tmp-name nil nil nil 'mustbenew)) :type 'file-already-exists) (should-error @@ -2763,7 +2780,52 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." (delete-directory tmp-name1) :type 'file-error) (delete-directory tmp-name1 'recursive) - (should-not (file-directory-p tmp-name1))))) + (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)) + (let ((trash-directory (tramp--test-make-temp-name 'local quoted)) + (delete-by-moving-to-trash t)) + (make-directory trash-directory) + ;; Delete empty directory. + (make-directory tmp-name1) + (should (file-directory-p tmp-name1)) + (delete-directory tmp-name1 nil 'trash) + (should-not (file-directory-p tmp-name1)) + (should + (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)) + ;; Delete non-empty directory. + (make-directory tmp-name1) + (should (file-directory-p tmp-name1)) + (write-region "foo" nil (expand-file-name "bla" tmp-name1)) + (should (file-exists-p (expand-file-name "bla" tmp-name1))) + (make-directory tmp-name2) + (should (file-directory-p tmp-name2)) + (write-region "foo" nil (expand-file-name "bla" tmp-name2)) + (should (file-exists-p (expand-file-name "bla" tmp-name2))) + (should-error + (delete-directory tmp-name1 nil 'trash) + ;; tramp-rclone.el calls the local `delete-directory'. + ;; This raises another error. + :type (if (tramp--test-rclone-p) 'error 'file-error)) + (delete-directory tmp-name1 'recursive 'trash) + (should-not (file-directory-p tmp-name1)) + (should + (file-exists-p + (format + "%s/%s/bla" trash-directory (file-name-nondirectory tmp-name1)))) + (should + (file-exists-p + (format + "%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))))))) (ert-deftest tramp-test15-copy-directory () "Check `copy-directory'."