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

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

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

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.



















[-- Attachment #2: move-file-to-trash-freedesktop_r1.diff --]
[-- Type: text/x-patch, Size: 7475 bytes --]

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)))

[-- Attachment #3: ChangeLog.move-file-to-trash-freedesktop_r1 --]
[-- Type: text/plain, Size: 176 bytes --]

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.).