emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

master ec105a45c9: Add remote-file-name-inhibit-delete-by-moving-to-tras


From: Michael Albinus
Subject: master ec105a45c9: Add remote-file-name-inhibit-delete-by-moving-to-trash
Date: Sun, 8 Jan 2023 13:24:31 -0500 (EST)

branch: master
commit ec105a45c9f8b56ade9e76324960a726eaf24038
Author: Michael Albinus <michael.albinus@gmx.de>
Commit: Michael Albinus <michael.albinus@gmx.de>

    Add remote-file-name-inhibit-delete-by-moving-to-trash
    
    * doc/emacs/files.texi (Misc File Ops):
    * doc/lispref/files.texi (Changing Files):
    * doc/misc/tramp.texi (Frequently Asked Questions):
    * etc/NEWS: Explain remote-file-name-inhibit-delete-by-moving-to-trash.
    
    * lisp/files.el (remote-file-name-inhibit-delete-by-moving-to-trash):
    New defcustom.  (Bug#60460)
    
    * lisp/net/ange-ftp.el (ange-ftp-delete-file):
    * lisp/net/tramp.el (tramp-skeleton-delete-directory):
    Handle `remote-file-name-inhibit-delete-by-moving-to-trash'.
    (tramp-skeleton-delete-file): New defmacro.
    
    * lisp/net/tramp-adb.el (tramp-adb-handle-delete-file):
    * lisp/net/tramp-fuse.el (tramp-fuse-handle-delete-file):
    * lisp/net/tramp-gvfs.el (tramp-gvfs-handle-delete-file):
    * lisp/net/tramp-sh.el (tramp-sh-handle-delete-file):
    * lisp/net/tramp-smb.el (tramp-smb-handle-delete-file):
    * lisp/net/tramp-sudoedit.el (tramp-sudoedit-handle-delete-file): Use it.
    
    * lisp/net/tramp-crypt.el (tramp-crypt-handle-delete-directory)
    (tramp-crypt-handle-delete-file): Rearrange.
    
    * lisp/net/tramp-fuse.el (tramp-fuse-handle-delete-directory):
    Use `tramp-skeleton-delete-directory'.
    
    * test/lisp/net/tramp-tests.el
    (remote-file-name-inhibit-delete-by-moving-to-trash): Declare.
    (tramp-test07-file-exists-p, tramp-test14-delete-directory)
    (tramp-test48-unload): Extend tests.
---
 doc/emacs/files.texi         |  5 +++++
 doc/lispref/files.texi       |  5 +++++
 doc/misc/tramp.texi          |  7 ++++---
 etc/NEWS                     |  5 +++++
 lisp/files.el                |  6 ++++++
 lisp/net/ange-ftp.el         |  3 ++-
 lisp/net/tramp-adb.el        | 12 ++++--------
 lisp/net/tramp-crypt.el      |  8 ++++----
 lisp/net/tramp-fuse.el       |  8 +++-----
 lisp/net/tramp-gvfs.el       | 21 +++++++++------------
 lisp/net/tramp-sh.el         | 12 ++++--------
 lisp/net/tramp-smb.el        | 29 +++++++++++------------------
 lisp/net/tramp-sudoedit.el   | 19 ++++++++-----------
 lisp/net/tramp.el            | 38 +++++++++++++++++++++++++++++---------
 test/lisp/net/tramp-tests.el | 44 ++++++++++++++++++++++++++++++++++++++++++--
 15 files changed, 141 insertions(+), 81 deletions(-)

diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi
index 6a9103d3a0..42e252c417 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 91643530f7..5cc4c1e7dd 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 7f66dc9e84..a8a59f982f 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 690e9c3faa..60dab575da 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 e1b7a990b1..d0167bf381 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 41c28672aa..a14122f815 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 619d29bb4d..493a9fb39a 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 61d1c52961..507fd43241 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 c8754e2b03..b846caadc1 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 bb81b3eb66..cca7a5fe24 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 fbdd40dd1d..4647600071 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 f31865d498..d6f3cca973 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 c4e1d32f52..2660dbb1fa 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 4bf0fdefc0..b8475b7cb4 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 90f6fcd6b1..dd3de27d3b 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



reply via email to

[Prev in Thread] Current Thread [Next in Thread]