Changes from Toru Tsuneyoshi for using Trash can when deleting files.

	* files.el (backup-extract-version): Handle versioned directories.
	(trash-directory): New variable.
	(move-file-to-trash): New function.

	* cus-start.el (delete-by-moving-to-trash): Declare for custom.

        * lisp.h (Qdelete_file, Qdelete_directory): Declare extern.

        * fileio.c (delete_by_moving_to_trash, Qmove_file_to_trash): New vars.
        (syms_of_fileio): Initialize and export them.
        (Fdelete_directory, Fdelete_file): Optionally delete via trash.

        * w32fns.c (FOF_NO_CONNECTED_ELEMENTS): Define if not already.
        (Fsystem_move_file_to_trash): New function.
        (syms_of_w32fns): Export it to lisp.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index fec9818..e349844 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,7 +1,15 @@
+2008-07-02  Toru Tsuneyoshi  <t_tuneyosi@hotmail.com>
+
+       * files.el (backup-extract-version): Handle versioned directories.
+       (trash-directory): New variable.
+       (move-file-to-trash): New function.
+
+       * cus-start.el (delete-by-moving-to-trash): Declare for custom.
+
 2008-07-02  Magnus Henoch  <mange@freemail.hu>
 
-       * vc-git.el (vc-git-annotate-command): Use proper option for
-       specifying revision.
+       * vc-git.el (vc-git-annotate-command): Use proper option for
+       specifying revision.
 
 2008-07-02  Francesc Rocher  <rocher@member.fsf.org>
 

diff --git a/lisp/cus-start.el b/lisp/cus-start.el
index a30abc9..17828bc 100644 (file)
--- a/lisp/cus-start.el
+++ b/lisp/cus-start.el
@@ -164,6 +164,8 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of
                                            :value (nil)
                                            (symbol :format "%v"))
                                    (const :tag "always" t)))
+             ;; fileio.c
+             (delete-by-moving-to-trash auto-save boolean "23.1")
             ;; fns.c
             (use-dialog-box menu boolean "21.1")
             (use-file-dialog menu boolean "22.1")

diff --git a/lisp/files.el b/lisp/files.el
index b388710..cb9720d 100644 (file)
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -31,7 +31,6 @@
 
 (defvar font-lock-keywords)
 
-
 (defgroup backup nil
   "Backups of edited data files."
   :group 'files)
@@ -3693,7 +3692,7 @@ You may need to redefine `file-name-sans-versions' as well."
   "Given the name of a numeric backup file, FN, return the backup number.
 Uses the free variable `backup-extract-version-start', whose value should be
 the index in the name where the version number begins."
-  (if (and (string-match "[0-9]+~$" fn backup-extract-version-start)
+  (if (and (string-match "[0-9]+~/?$" fn backup-extract-version-start)
           (= (match-beginning 0) backup-extract-version-start))
       (string-to-number (substring fn backup-extract-version-start -1))
       0))
@@ -5783,6 +5782,48 @@ ORIG-FILE is the original file of which modes will be change."
        (file-modes-symbolic-to-number value modes)))))
 
 \f
+;; Trash can handling.
+(defcustom trash-directory "~/.Trash"
+  "Directory for `move-file-to-trash' to move files and directories to.
+This directory is only used when the function `system-move-file-to-trash' is
+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 (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'.
+Returns nil on success."
+  (interactive "fMove file to trash: ")
+  (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)))
+      (or (file-directory-p trash-dir)
+          (make-directory trash-dir t))
+      (and (file-exists-p new-fn)
+           ;; make new-fn unique.
+           ;; example: "~/.Trash/abc.txt" -> "~/.Trash/abc.txt.~1~"
+           (let ((version-control t))
+             (setq new-fn (car (find-backup-file-name new-fn)))))
+      ;; stop processing if fn is same or parent directory of trash-dir.
+      (and (string-match fn trash-dir)
+           (error "Filename `%s' is same or parent directory of trash-directory"
+                  filename))
+      (rename-file fn new-fn)))))
+
+\f
 (define-key ctl-x-map "\C-f" 'find-file)
 (define-key ctl-x-map "\C-r" 'find-file-read-only)
 (define-key ctl-x-map "\C-v" 'find-alternate-file)

diff --git a/src/ChangeLog b/src/ChangeLog
index fb3186d..4c3faea 100644 (file)
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,15 @@
+2008-07-02  Toru Tsuneyoshi  <t_tuneyosi@hotmail.com>
+
+        * lisp.h (Qdelete_file, Qdelete_directory): Declare extern.
+
+        * fileio.c (delete_by_moving_to_trash, Qmove_file_to_trash): New vars.
+        (syms_of_fileio): Initialize and export them.
+        (Fdelete_directory, Fdelete_file): Optionally delete via trash.
+
+        * w32fns.c (FOF_NO_CONNECTED_ELEMENTS): Define if not already.
+        (Fsystem_move_file_to_trash): New function.
+        (syms_of_w32fns): Export it to lisp.
+
 2008-07-01  Jason Rumney  <jasonr@gnu.org>
 
         * w32font.c (w32font_text_extents): Don't count overhang as part

diff --git a/src/fileio.c b/src/fileio.c
index ffb6549..abe77e2 100644 (file)
--- a/src/fileio.c
+++ b/src/fileio.c
@@ -213,6 +213,13 @@ Lisp_Object Vdirectory_sep_char;
 int write_region_inhibit_fsync;
 #endif
 
+/* Non-zero means call move-file-to-trash in Fdelete_file or
+   Fdelete_directory.  */
+int delete_by_moving_to_trash;
+
+/* Lisp function for moving files to trash.  */
+Lisp_Object Qmove_file_to_trash;
+
 extern Lisp_Object Vuser_login_name;
 
 #ifdef WINDOWSNT
@@ -2674,6 +2681,9 @@ DEFUN ("delete-directory", Fdelete_directory, Sdelete_directory, 1, 1, "FDelete
   if (!NILP (handler))
     return call2 (handler, Qdelete_directory, directory);
 
+  if (delete_by_moving_to_trash)
+    return call1 (Qmove_file_to_trash, directory);
+
   encoded_dir = ENCODE_FILE (directory);
 
   dir = SDATA (encoded_dir);
@@ -2707,6 +2717,9 @@ If file has multiple names, it continues to exist with the other names.  */)
   if (!NILP (handler))
     return call2 (handler, Qdelete_file, filename);
 
+  if (delete_by_moving_to_trash)
+    return call1 (Qmove_file_to_trash, filename);
+
   encoded_file = ENCODE_FILE (filename);
 
   if (0 > unlink (SDATA (encoded_file)))
@@ -6358,6 +6371,14 @@ A non-nil value may result in data loss!  */);
   write_region_inhibit_fsync = 0;
 #endif
 
+  DEFVAR_BOOL ("delete-by-moving-to-trash", &delete_by_moving_to_trash,
+               doc: /* Specifies whether to use the system's trash can.
+When non-nil, the function `move-file-to-trash' will be used by
+`delete-file' and `delete-directory'.  */);
+  delete_by_moving_to_trash = 0;
+  Qmove_file_to_trash = intern ("move-file-to-trash");
+  staticpro (&Qmove_file_to_trash);
+
   defsubr (&Sfind_file_name_handler);
   defsubr (&Sfile_name_directory);
   defsubr (&Sfile_name_nondirectory);

diff --git a/src/lisp.h b/src/lisp.h
index e126f57..75a0fc3 100644 (file)
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -2935,6 +2935,8 @@ extern void syms_of_fileio P_ ((void));
 extern void init_fileio_once P_ ((void));
 extern Lisp_Object make_temp_name P_ ((Lisp_Object, int));
 EXFUN (Fmake_symbolic_link, 3);
+extern Lisp_Object Qdelete_directory;
+extern Lisp_Object Qdelete_file;
 
 /* Defined in abbrev.c */
 

diff --git a/src/w32fns.c b/src/w32fns.c
index c9a9a5a..011d647 100644 (file)
--- a/src/w32fns.c
+++ b/src/w32fns.c
@@ -63,6 +63,10 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 #include "font.h"
 #include "w32font.h"
 
+#ifndef FOF_NO_CONNECTED_ELEMENTS
+#define FOF_NO_CONNECTED_ELEMENTS 0x2000
+#endif
+
 void syms_of_w32fns ();
 void globals_of_w32fns ();
 
@@ -6208,6 +6212,60 @@ If ONLY-DIR-P is non-nil, the user can only select directories.  */)
 }
 
 
+/* Moving files to the system recycle bin.
+   Used by `move-file-to-trash' instead of the default moving to ~/.Trash  */
+DEFUN ("system-move-file-to-trash", Fsystem_move_file_to_trash,
+       Ssystem_move_file_to_trash, 1, 1, 0,
+       doc: /* Move file or directory named FILENAME to the recycle bin.  */)
+     (filename)
+     Lisp_Object filename;
+{
+  Lisp_Object handler;
+  Lisp_Object encoded_file;
+  Lisp_Object operation;
+
+  operation = Qdelete_file;
+  if (!NILP (Ffile_directory_p (filename))
+      && NILP (Ffile_symlink_p (filename)))
+    {
+      operation = Qdelete_directory;
+      filename = Fdirectory_file_name (filename);
+    }
+  filename = Fexpand_file_name (filename, Qnil);
+
+  handler = Ffind_file_name_handler (filename, operation);
+  if (!NILP (handler))
+    return call2 (handler, operation, filename);
+
+  encoded_file = ENCODE_FILE (filename);
+
+  {
+    const char * path;
+    SHFILEOPSTRUCT file_op;
+    char tmp_path[MAX_PATH + 1];
+
+    path = map_w32_filename (SDATA (encoded_file), NULL);
+
+    /* On Windows, write permission is required to delete/move files.  */
+    _chmod (path, 0666);
+
+    bzero (tmp_path, sizeof (tmp_path));
+    strcpy (tmp_path, path);
+
+    bzero (&file_op, sizeof (file_op));
+    file_op.hwnd = HWND_DESKTOP;
+    file_op.wFunc = FO_DELETE;
+    file_op.pFrom = tmp_path;
+    file_op.fFlags = FOF_SILENT | FOF_NOCONFIRMATION | FOF_ALLOWUNDO
+      | FOF_NOERRORUI | FOF_NO_CONNECTED_ELEMENTS;
+    file_op.fAnyOperationsAborted = FALSE;
+
+    if (SHFileOperation (&file_op) != 0)
+      report_file_error ("Removing old name", list1 (filename));
+  }
+  return Qnil;
+}
+
 \f
 /***********************************************************************
                          w32 specialized functions
@@ -7241,6 +7299,7 @@ only be necessary if the default setting causes problems.  */);
   staticpro (&last_show_tip_args);
 
   defsubr (&Sx_file_dialog);
+  defsubr (&Ssystem_move_file_to_trash);
 }