bug#5436: 23.1.91; Deleting directories causes unusable file layout in freedesktop trashcan

[David De La Harpe Golden <david@harpegolden.net>]

[-- Attachment #1: Type: text/plain, Size: 2478 bytes --]

Chong Yidong wrote:
> Hi David,
> 
> Could you take a look at Bug#5436?  Thanks.
> 
>> I have `delete-by-moving-to-trash' enabled.  When I delete a directory
>> with `M-x delete-directory' or using `D' in dired on a directory and say
>> that I want to delete it recursively, the freedesktop trashcan contains
>> entries for each file deleted, and not only one entry for the whole
>> directory.
>>

Please find attached small* patch that should address this (and Bug#3353).

* Given the recursively data devouring area it's in, please examine 
extra-carefully all the same...

delete-directory:

  is adjusted to call move-file-to-trash with the expectation 
move-file-to-trash can move non-empty directories to trash - which was 
already true, mostly, since it just called rename-file on them, and 
/that/ already silently worked ...so long as the source and destination 
were on the same device.

I believe, but haven't actually tested, that w32's override 
system-move-file-to-trash already works for non-empty directories too.


rename-file:

is adjusted to call copy-directory then delete-directory to emulate 
cross-device directory renames as proposed under Bug#3353

Note that rename-file's existing behaviour when FILE and NEWNAME (from 
and to) were both directories seemed problematic to me, so I adjusted it:

. existing behaviour:

Rather than moving directory FILE within directory NEWNAME, as happens
with the existing code if FILE is a regular file and NEWNAME a directory 
- if directory NEWNAME is empty, directory FILE becomes a directory 
NEWNAME, and if  NEWNAME isn't empty, the operation fails.

That means emacs without this patch acts more like raw C rename() for 
directory-to-directory, yet like shell mv (except "mv -T") for 
regular-file-to-directory.

. new behaviour:

I thought that was plain inconsistent, so made it move directory FILE 
into directory NEWNAME if NEWNAME exists and is a directory in the 
intra-device case.  That also means less messing about in the 
inter-device case to make it match the intra-device case, since 
copy-directory has 
copy-within-destination-if-destination-is-an-existing-directory
semantics. However, it is possible (though IMO unlikely) that may break 
something somewhere, so I note doing it the other way and making the 
inter-device behaviour emulate the unpatched intra-device 
directory-directory C-rename()-like behaviour would be possible - seems 
less friendly to me though.


























[-- Attachment #2: dirtrash_r1.diff --]
[-- Type: text/x-patch, Size: 9201 bytes --]

# Bazaar merge directive format 2 (Bazaar 0.90)
# revision_id: david@harpegolden.net-20100124040857-v8aqjr4myiydqj55
# target_branch: http://bzr.savannah.gnu.org/r/emacs/trunk/
# testament_sha1: 8222b7fc8a776796db7afbef784a6dbfc2c98464
# timestamp: 2010-01-24 04:09:50 +0000
# base_revision_id: rgm@gnu.org-20100123232525-hl30xzix3wevh4bn
# 
# Begin patch
=== modified file 'lisp/files.el'
--- lisp/files.el	2010-01-17 02:25:53 +0000
+++ lisp/files.el	2010-01-24 02:01:39 +0000
@@ -4667,19 +4667,32 @@
   (let ((handler (find-file-name-handler directory 'delete-directory)))
     (if handler
 	(funcall handler 'delete-directory directory recursive)
-      (if (and recursive (not (file-symlink-p directory)))
-	  (mapc
-	   (lambda (file)
-	     ;; This test is equivalent to
-	     ;; (and (file-directory-p fn) (not (file-symlink-p fn)))
-	     ;; but more efficient
-	     (if (eq t (car (file-attributes 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)))
-      (delete-directory-internal directory))))
+      ;; move-file-to-trash moves directories, empty or
+      ;; otherwise, into the trash as a unit. So if the directory is
+      ;; non-empty, only call move-file-to-trash here if recursive is non-nil,
+      ;; so that having delete-by-moving-trash non-nil doesn't cause "greedier"
+      ;; (pseudo-)deletion behaviour.
+      (if delete-by-moving-to-trash
+          (if (and (not recursive)
+                   (directory-files
+                    directory 'full directory-files-no-dot-files-regexp))
+              (error "Directory is not empty, not moving to trash.")
+            (move-file-to-trash directory))
+        (progn
+          ;; do recursion if necessary if we're not moving to trash
+          (if (and recursive (not (file-symlink-p directory)))
+              (mapc
+               (lambda (file)
+                 ;; This test is equivalent to
+                 ;; (and (file-directory-p fn) (not (file-symlink-p fn)))
+                 ;; but more efficient
+                 (if (eq t (car (file-attributes 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)))
+          (delete-directory-internal directory))))))
 
 (defun copy-directory (directory newname &optional keep-time parents)
   "Copy DIRECTORY to NEWNAME.  Both args must be strings.
@@ -6170,7 +6183,8 @@
   "Move the file (or directory) named FILENAME to the trash.
 When `delete-by-moving-to-trash' is non-nil, this function is
 called by `delete-file' and `delete-directory' instead of
-deleting files outright.
+deleting files outright. If FILENAME is a directory, it
+may be empty or non-empty.
 
 If the function `system-move-file-to-trash' is defined, call it
  with FILENAME as an argument.

=== modified file 'src/fileio.c'
--- src/fileio.c	2010-01-13 04:33:42 +0000
+++ src/fileio.c	2010-01-24 04:08:57 +0000
@@ -215,6 +215,12 @@
 /* Lisp function for moving files to trash.  */
 Lisp_Object Qmove_file_to_trash;
 
+/* Lisp function for recursively copying directories. */
+Lisp_Object Qcopy_directory;
+
+/* Lisp function for recursively deleting directories. */
+Lisp_Object Qdelete_directory;
+
 extern Lisp_Object Vuser_login_name;
 
 #ifdef WINDOWSNT
@@ -2241,7 +2247,15 @@
       && (NILP (Fstring_equal (Fdowncase (file), Fdowncase (newname))))
 #endif
       )
-    newname = Fexpand_file_name (Ffile_name_nondirectory (file), newname);
+
+    if (!NILP (Ffile_directory_p (file)))
+      {
+        newname = Fexpand_file_name (Ffile_name_nondirectory (Fdirectory_file_name (file)), newname);
+      }
+    else
+      {
+        newname = Fexpand_file_name (Ffile_name_nondirectory (file), newname);
+      }
   else
     newname = Fexpand_file_name (newname, Qnil);
 
@@ -2279,15 +2293,31 @@
                                  NILP (ok_if_already_exists) ? Qnil : Qt);
           else
 #endif
-	    Fcopy_file (file, newname,
-			/* We have already prompted if it was an integer,
-			   so don't have copy-file prompt again.  */
-			NILP (ok_if_already_exists) ? Qnil : Qt,
-			Qt, Qt);
+            {
+              if ( Ffile_directory_p (file) )
+                {
+                  call4 (Qcopy_directory, file, newname, Qt, Qnil);
+                }
+              else
+                {
+                  Fcopy_file (file, newname,
+                    /* We have already prompted if it was an integer,
+                       so don't have copy-file prompt again.  */
+                    NILP (ok_if_already_exists) ? Qnil : Qt,
+                    Qt, Qt);
+                }
+            }
 
 	  count = SPECPDL_INDEX ();
 	  specbind (Qdelete_by_moving_to_trash, Qnil);
-	  Fdelete_file (file);
+          if ( Ffile_directory_p (file) )
+            {
+              call2 (Qdelete_directory, file, Qt);
+            }
+          else
+            {
+              Fdelete_file (file);
+            }
 	  unbind_to (count, Qnil);
 	}
       else
@@ -5727,6 +5757,10 @@
   Qdelete_by_moving_to_trash = intern_c_string ("delete-by-moving-to-trash");
   Qmove_file_to_trash = intern_c_string ("move-file-to-trash");
   staticpro (&Qmove_file_to_trash);
+  Qcopy_directory = intern_c_string ("copy-directory");
+  staticpro (&Qcopy_directory);
+  Qdelete_directory = intern_c_string ("delete-directory");
+  staticpro (&Qdelete_directory);
 
   defsubr (&Sfind_file_name_handler);
   defsubr (&Sfile_name_directory);

# Begin bundle
IyBCYXphYXIgcmV2aXNpb24gYnVuZGxlIHY0CiMKQlpoOTFBWSZTWRyGQXcABef/gFVf6AB59///
9+fugL////pgCq7vdry+oPVzQFBuHtnvbVrutrOsVqtVldjhIoKZJ4ip5ptRqn+lT9NT9Unk9Jqe
0Tak8npGoA0AyP1TQPUEkgExATSbU1Q00GQ0AAAAAAAGQZTQUepqeo02iNN6o/UjI0MgAYjQADIA
ACKn6FG9UGQABoAAGgAAAAAAARUTETEBPSGmmponqP1NNR6ntU9QZBoaM1Mm0g8oHqYSQiR6Iwqn
vRPU1MjaaBNTZNQ/VPUNMgAAAMgxGViFzcr06dPOFnioFVGn3e05qhnKV1j1Trs3tGrdu82XY4A3
4B3h1TWQkKyCA4EBxU3ITIyQeH5wIBBSqJHM0JdEUqdUGLoNR6p0gngAIoEVmrDnPUGuKQoCEEe9
5sdGJmKOmACBIBYwDDs1x7zwP7Go4Zz64l+HHhMe6Hu+Cp3mYsdJklmlir0EjLlPKpK5MG20Nq/+
AZWGU1GV4sY1sUDVEZylBjigWMyy1YW9K7EeghKbTjOHv41n9htKFPQs0V3l2Zvw5lS6NEXReUYY
cj5zgyUwnN3/d7l34Rq8cV7/G7ELuq/Zsa2e6A4LVMj+pp5GhjxOFpwhwWh9WFHw1y3lLTXKBuqY
BHz5VMI6NcnGeCnOj4t6VVBgdAsNhmP7rmKup7xlIVu2RO6zkvM8C+3UX9JNVxVb19NeQ2s5EFKU
lfMTMJ2WJBBZ4x0g9D2be1x1sFI9WyOCfdEO5rpDTCCdkGO3rxyL5nG/O0SeHmzsS4XIGW08kaD5
t686uVWfPzs7NbWO2gcc6fYdAqGHV7OVaECzC62t0Bjdmi1ge01ESZDBWblJOo6xG9A551MrJIPc
m0DqhYwWIf3xSt8XDZQtJaex/NXdfaBkVhYCWKl3LcerkVXBqd3d35DLi5O28wrEqmHYTQh2ElUK
ONB3EOJLUOwLOpCuUwTTKhUPJOQl8BJhVHlI31jaUE54QQk48i4p4KpcVFnoXirkw6IYqLkjSGxT
FeXMXD1Y3aYIV3IdcaNbkqywBbnNoqhGZpg9blrMgbnvgIbVBBSZhn9iyWX+QsW5jX5ndkszKPmv
QbHLAUk2o049o5ocUy8nmTx673v2tXqkgwQY6xDiK5AxsZQz6nNmZyVizqDIhAtRO8voyaiY4w0H
4LIj0fE3JGcM301OIiIa8nmmvRzFdKOtA2GiKM+uGM+xPlZyByUfoq852fN7+uW9al3auHPZBYhA
FBRN3ScgunluH8ux1RH+0EeFV0xsXua45HKZLdaoFQVkHNk6PV+49A2OKlWELLSphYogyTncxsom
jmiMzpwy4Vs5x3L7DxZCzqOJd5ciEpbSfY7iDIWD91dnMZJmu4RXKMVeO7UDRasDHLA7ehri5dgj
GmMO21RWJ3MYD8x3PstJvBBJXkeNBSykq3vCJjzL50U6aTNC0eIc1aDZUYFmxjd65CHbKV2FPrqg
w0o0xSdWEHPfkeQ2r5W4mVmYqKCvc6RIcMNz4lKW8UjpkY00L7RYnnrWnZHBVURMRpd+cHXtS0ib
4rwLVOpsnU8IrYmRveUIG22mtqOQYoNIQrayClzMk82LjrnaWONIXGMCkthMONDcxo+4hyDwHJpw
1tVOFsmMFyWQkmVbFhRjjalkxQg1tGNBsErsYPKXCeYRs2PY/TEN9dAmHUrlvro4m24jGw0rsWBd
BT1dioBLo3T3rENAxnr2mpTWLdg3S9uGmINNL31ENyaJnvs/Tb/xWUftXAhCCU2jaa7jy8A222m2
+IhFRVy2QQEl4d8xdZTjVZHVzlCCDUTXrOwLPGrXOZcwcZ43nWaAYMikdEEaXLVku8kxfG7OBArF
khVE1B8duWlNY379itjrBd6u2GIG2cHNBxnRfM7nWCxKev1bTPsyWiJmnknxPTMiOqyXDeZEEIH9
HkpWNTt5EHEZ/A6QBlwwZblyEKKy+WLIzJagvK6jfxei+OTNva71N6r+RZjUyt4l4aPWHg9Q1hQZ
IQyhOPh1K7ivl5efDjtsvRoXSpdBWxBWHUQgeU48b3jkNuDDhwQyA4fBY6MeRfHS1aFsuD6elJLJ
pqqtvFLCGzdacxOYwyZwe8YgguZPiqpm1iR7wti+e1Bgcq87fQspzwOFa1Elr6vHpun2tSlRXCRT
19kcA0Fg23Q4WiZokEILzdny9vvvOzzG6EHAIjXVpalHGbfWw/g9tap+jI2TkwbJoOUxDIcYc+xc
Y7/SQSEVz7rtIK/ymYvQZDGpXPbCuUqDbbaGsEsqLFBuC/Fuud2fNU6JYdrIeoA7vy4PAb7zFFXf
Dx4RGiBoOmiemjyXKWf5Yqn5FKsvswQjSwYwa1RWWcFoBaAF21yZwZjwHyaDoLkLnrMo/jAYuvjO
c5IOC/q5tyN250dJmgmg+DPBWTtqOzQ73HfV1izoKiZSKmfEcvanzcoMZKMItjCAeZXKSmoHcdwx
iomwRDNBysLBf2MnIA3m5OGsSvWEl6+tlIFu6uYDUw53kqqBrBduVxRM02VXfg83CjYzDM44a8GR
JsdSEQWLl8NLGt6bt2wMyX4hs6LQ65gAXFR/QRehp7kxwwxUotWy7q6Kq3AwXRG3Oj9UEHVBuTdu
oD+BmIHtaHBvCfM8uQelDepihVz8oshHcOJ0G2wZdPVwiN/MI2d+16ua4docYh7YBS2JsATKAW3S
klmONkgXLW6RUAcXEeV58Iy2r6oWnCZRQvJlBd1hh0JaKJBgsBZ3YYmWXOWwTjMTMaGNOQcl9TIK
b8dpBZzBXFeMm8S3ClpTQMdgitXjBQQxQbjM7QvAEvzIBJC2XT5HM1YFD2RED36BmdByZtUGpowq
0Mgrd0GpOgtEY8+obX/vMPCeodGYCqMEGyB8m08KuCXnBAwCWA5MMgY9BcvJJImBDteWiJ7E6hLr
cQiqiVhnx0PWg3ZLgWJ2DE3yoRK5HwMWCHFQcjGALe68+yctJqtLWuq1aAceKCxBiKwUpjszGMDa
XR6RNIRtWvhBYhKf0TJ4gQ0LDj4TQSMiuDtahvam/TdxTYsFSUjRJ1NgyysSSzYpYoHVFW7CJsAE
QmhOcwwzVdyYQ5wOWyp4pZY4INnjMmbNPWcgTCernYyZkzX8W0xekONYgOIFhGA51zq+MzHEuyk0
seCSoNToRagUEl2zzqakvGKiNSCU2SgmReW6ZXzS6JljgmYqthVLjamQihZjZEhExEkwQxMUZDQ6
VKyygi5QQUqr5saNCCaplb9Z3+jnR0MYX6sUr9xGoXBWgaYykG5zBBFwTABwZwXbGhdq4Zi0INla
DFAykAeZVCsqTpazM4JzIdFBghkQEmcKCe0R1DgWzDY43sO1/MjEhCJ7xdyRThQkByGQXcA=