bug#973: Support for moving files to freedesktop.org-style trashcan.

[David De La Harpe Golden]

Package: emacs
Version: 23.0.60
Severity: normal
Tags: patch


delete-by-moving-to-trash was recently introduced, but doesn't
really work as expected for typical gnu+linux desktop users, and I had
some procrastination to do, so...

Attached patch adds basic support for moving files to a fd.o-style
trashcan, as used in KDE/GNOME/XFCE/etc. and documented at:
http://www.freedesktop.org/wiki/Specifications/trash-spec

Unlike "Microsoft Windows? -> use Windows Recycle Bin" or "MacOSX? ->
use MacOSX trash can", one maybe can't say "GNU/Linux/BSD? -> use
freedesktop-style Trash", so whether the freedesktop-style trashcan
should be preferred over the simple emacs fallback "trash-directory"
scheme is decided a bit roughly.

Maybe a move-file-to-trash-scheme should just be a user-visible
customisation.

... I hate trashcans anyway.


















Index: lisp/files.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/files.el,v
retrieving revision 1.995
diff -U 8 -r1.995 files.el
--- lisp/files.el       2 Sep 2008 16:10:44 -0000       1.995
+++ lisp/files.el       13 Sep 2008 03:05:31 -0000
@@ -5793,24 +5793,165 @@
 not defined.  Relative paths are interpreted relative to `default-directory'.
 See also `delete-by-moving-to-trash'."
   :type 'directory
   :group 'auto-save
   :version "23.1")
 
 (declare-function system-move-file-to-trash "w32fns.c" (filename))
 
+(defun move-file-to-trash-freedesktop (filename)
+  "Attempt to move file/dir to trash the freedesktop.org way (like e.g. GNOME,
+KDE and XFCE desktop environment trash facilities). Usually called 
automatically
+by `move-file-to-trash'.
+
+Only moves to 'home trash', per-volume trash storage areas are never used, as
+permitted by freedesktop.org trash-spec 0.7."
+
+  (interactive "fMove file to trash: ")
+  (let* ((saved-default-file-modes (default-file-modes))
+        (xdg-data-home-dir (directory-file-name (expand-file-name
+                                                 (or (getenv "XDG_DATA_HOME")
+                                                     "~/.local/share"))))
+        (trash-dir (concat xdg-data-home-dir "/Trash"))
+        (trash-files-dir (concat trash-dir "/files"))
+        (trash-info-dir (concat trash-dir "/info"))
+        (fn (directory-file-name (expand-file-name filename)))
+        (fn-nondir (file-name-nondirectory fn)))
+
+    ;; trash-spec 0.7 says to check if we have permissions to
+    ;; delete before attempting to delete.
+    (unless (file-writable-p (directory-file-name (file-name-directory fn)))
+      (error "Cannot move file `%s' to Trash, insufficient permissions" 
filename))
+
+    ;; stop processing if fn is same or parent directory of trash-dir.
+    (when (or (string-match fn trash-files-dir)
+             (string-match fn trash-info-dir)
+             (string-match fn trash-dir))
+      (error "Filename `%s' is same or parent directory of Trash."
+            filename))
+
+    ;; ensure trash directory exists, using appropriate permissions if 
creating it.
+    (set-default-file-modes #o700)
+    (make-directory trash-files-dir t)
+    (make-directory trash-info-dir t)
+    (set-default-file-modes saved-default-file-modes)
+
+    ;; try to move to trash with associated .trashinfo undo information
+    (save-excursion
+      (with-temp-buffer
+       (set-buffer-file-coding-system 'utf-8-unix)
+       ;; url-encode path, though allow literal "/" for path separators.
+       ;; trash-spec 0.7 is slightly confusing on that point. At time of 
writing,
+       ;; KDE Konqueror accepts both literal and %2f-encoded slashes, XFCE 
Thunar
+       ;; only literal slashes.
+       ;; Using / makes .trashinfo files much more readable, and while / is a
+       ;; reserved character in url components, it is a valid separator in 
urls,
+       ;; so the intent was likely to allow it.
+       ;; yes, this is lifted from url-hexify-string
+       ;; but don't want to pull in url/*.el , and it's not quite the same due 
to /
+       (insert "[Trash Info]\n"
+               "Path=" (mapconcat
+                        (lambda (byte)
+                          (if (memq byte
+                                    '(?/ ?a ?b ?c ?d ?e ?f ?g ?h ?i ?j
+                                         ?k ?l ?m ?n ?o ?p ?q ?r ?s ?t
+                                         ?u ?v ?w ?x ?y ?z ?A ?B ?C ?D
+                                         ?E ?F ?G ?H ?I ?J ?K ?L ?M ?N
+                                         ?O ?P ?Q ?R ?S ?T ?U ?V ?W ?X
+                                         ?Y ?Z ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7
+                                         ?8 ?9 ?- ?_ ?. ?! ?~ ?* ?' ?\( ?\)))
+                              (char-to-string byte)
+                            (format "%%%02x" byte)))
+                        (if (multibyte-string-p fn)
+                            (encode-coding-string fn 'utf-8)
+                          fn)
+                        "")
+               "\nDeletionDate=" (format-time-string "%Y-%m-%dT%T") "\n")
+       (let* ((maxtries 5)
+              (tries maxtries)
+              (success nil)
+              (base-fn (expand-file-name fn-nondir trash-files-dir))
+              (new-fn base-fn)
+              (info-fn (concat new-fn ".trashinfo")))
+         ;; attempt to make .trashinfo file, retries up to 5
+         ;; times (arbitrarily chosen, spec just says "pick
+         ;; another filename"). .trashinfo file opened o_excl _is_
+         ;; lock as per trash-spec 0.7 (even if that can be a
+         ;; problem on old NFS versions...)
+         (while (and (not success) (> tries 0))
+           ;; make new-fn unique.
+           ;; Unfortunately, contemporary file managers with fd.o trashcan 
support
+           ;; do not like emacs backup file naming scheme here (as used in 
default emacs
+           ;; trash implementation) - see  bug 4381 in XFCE Thunar bug tracker,
+           ;; bug 170956 in KDE Konqueror bug tracker.
+           ;;  (let ((version-control t))
+           ;;   (setq new-fn (car (find-backup-file-name base-fn))))
+           (when (< tries maxtries)
+             (setq new-fn (make-temp-name (concat base-fn "_"))))
+           (setq info-fn (concat (expand-file-name (file-name-nondirectory 
new-fn)
+                                                   trash-info-dir)
+                                 ".trashinfo"))
+           (unless (condition-case nil
+                       (progn
+                         (write-region nil nil info-fn nil 'quiet info-fn 
'excl)
+                         (setq success t))
+                     (file-already-exists nil))
+             (setq tries (- tries 1))
+             (sleep-for 0.1)))
+         (unless success (error "Failed to lock Trash for filename `%s'" 
filename))
+         ;; Finally... if we've got this far, let's
+         ;; try to actually move the file to the trashcan.
+         (let ((delete-by-moving-to-trash nil))
+           (rename-file fn new-fn)))))))
+
+(defvar move-file-to-trash--freedesktop-p-memo nil)
+(defun move-file-to-trash--freedesktop-p ()
+  "Guess if the system should be considered freedesktop.org -oid
+for `move-file-to-trash' purposes. Only used in absence of
+overriding `system-move-file-to-trash' "
+  ;; presumably constant throughout an emacs session.
+  (or move-file-to-trash--freedesktop-p-memo
+      (setq move-file-to-trash--freedesktop-p-memo
+           (if (and
+                ;; assume macosx and windows folk are going to want their own
+                ;; trashcans even though people might sometimes compile
+                ;; and run freedesktop.org apps on them.
+                (not (eq system-type 'darwin))
+                (not (eq system-type 'windows))
+                (or
+                 ;; dead giveaway.
+                 (file-exists-p "~/.local/share/Trash")
+                 (getenv "XDG_DATA_HOME")
+                 (getenv "XDG_CONFIG_HOME")
+                 (getenv "XDG_DATA_DIRS")
+                 (getenv "XDG_CONFIG_DIRS")
+                 (getenv "XDG_CACHE_HOME")
+                 (file-exists-p "/etc/xdg")
+                 (file-exists-p "~/.local")
+                 (file-exists-p "~/.config")))
+               t
+             nil))))
+
 (defun move-file-to-trash (filename)
   "Move file (or directory) name FILENAME to the trash.
 This function is called by `delete-file' and `delete-directory' when
 `delete-by-moving-to-trash' is non-nil.  On platforms that define
 `system-move-file-to-trash', that function is used to move FILENAME to the
-system trash, otherwise FILENAME is moved to `trash-directory'.
+system trash, otherwise on systems that appear to be using a
+freedesktop.org compliant trashcan `move-file-to-trash-freedesktop'
+is used (and bound to `system-move-file-to-trash'), otherwise
+FILENAME is moved to `trash-directory'.
 Returns nil on success."
   (interactive "fMove file to trash: ")
+  (unless (fboundp 'system-move-file-to-trash)
+    (when (move-file-to-trash--freedesktop-p)
+      (fset 'system-move-file-to-trash
+           (lambda (filename)
+             (move-file-to-trash-freedesktop filename)))))
   (cond
    ((fboundp 'system-move-file-to-trash)
     (system-move-file-to-trash filename))
    (t
     (let* ((trash-dir   (expand-file-name trash-directory))
            (fn          (directory-file-name (expand-file-name filename)))
            (fn-nondir   (file-name-nondirectory fn))
            (new-fn      (expand-file-name fn-nondir trash-dir)))

2008-09-13  David De La Harpe Golden  <david@harpegolden.net>

        * files.el: Add basic support for moving files to freedesktop.org
        Trash cans (as used by KDE/GNOME/XFCE/etc.).