;;; trashcan.el --- Windows syle file deletion system ;; ;; Copyright (C) 2006, Davin Pearson ;; ;; Author/Maintainer: Davin Pearson ;; Keywords: Windows Recycle Bin ;; Version: 1.0
;; This file is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; This file is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Commentary: ;; ;; The file trashcan.el changes the behaviour of deleting files with ;; the "x" key in dired mode. Instead of deleting files permanently, ;; which is Emacs' default behaviour, they are either moved to a ;; Trashcan Directory (the actual directory depends on the value of ;; the string variable trashcan--dir which has a default value of ;; ".TRASHCAN") or if you are already in the trashcan directory, then ;; the files are deleted permanently. Like the Windows Recycle Bin, ;; files in the trashcan can be restored (undeleted) and in Windows ;; for efficiency each hard drive has own trashcan directory. Files ;; can be restored by viewing the trashcan directory in dired mode, ;; selecting the file(s) you wish to restore with the "m" key and then ;; executing the command M-x trashcan--restore. If no files or ;; directories have been selected, then the file or directory ;; currently pointed to by the cursor is restored. Each trashcan ;; directory can be emptied via the command M-x trashcan--empty while ;; you are viewing that directory in dired mode. The name "trashcan" ;; comes from the Amiga Computer's equivalent of the Windows Recycle ;; Bin. ;; See the following URL for the latest documentation and version: ;; ;; http://www.geocities.com/davinpearson/research/2006/mopa2e.html#trashcan ;; ;; ;;; Code: (defvar trashcan--dirname ".TRASHCAN" "This variable specifies what directory to move files into with the \"x\" key in dired mode. Do not add any prefix to the directory such as \"~/\" or \"/\". If this is a Windows system, the trashcan directories are located at the following regexp: (concat \"[a-zA-Z]:/\" (regexp-quote trashcan--dirname)) If this is a Unix system, the trashcan directory is located at the following place: (concat (expand-file-name \"~/\") trashcan--dirname) In Windows, DO NOT give this the same name as the windows RECYCLER directory as this will confuse the hell out of Windows. ") ;;; (trashcan--split (setq file "d:/home/mylisp/trashcan.el")) ;;; (trashcan--split (setq file "/home/mylisp/trashcan.el")) (defun trashcan--split (file) ;; ;; NOTE: this function gives meaningful results for both WINDOWS and UNIX ;; (if (string-match "[a-zA-Z]:/" file) (cons (substring file 0 3) (substring file 3)) (cons (expand-file-name "~/") (substring file 1)) ) ) ;;; (trashcan--encode (setq file "/home/foomatic.txt")) ;;; (trashcan--encode (setq file "d:/home/foomatic.txt")) ;;; (trashcan--encode (setq file "d:/home/mylisp")) ;;; (trashcan--encode (setq file "/home/mylisp/trashcan.el")) "d:/home/TRASHCAN/home!mylisp!trashcan.el" ;;; (trashcan--encode (setq file "d:/home/mylisp/trashcan.el")) "d:/TRASHCAN/home!mylisp!trashcan.el" (defun trashcan--encode (file) ;;(debug) (let* ((s (trashcan--split file)) (d (car s)) (f (cdr s))) ;;(debug) (let ((i 0)) (while (< i (length f)) (if (eq ?/ (aref f i)) (aset f i ?!)) (incf i))) (let ((new (concat d trashcan--dirname "/" f))) (if (file-exists-p new) (let ((count 1) (result nil)) (while (file-exists-p (setq result (concat new "." (format "%d" count)))) (incf count)) result) new)) ) ) ;;; (trashcan--split "/home/TRASHCAN/home!mylisp!trashcan.el") ;;; (trashcan--split "d:/TRASHCAN/home!mylisp!trashcan.el") ;;; (trashcan--decode (setq file "/home/TRASHCAN/home!mylisp!trashcan.el")) ;;; (trashcan--decode (setq file "d:/TRASHCAN/home!mylisp!trashcan.el")) (defun trashcan--decode (file) (if (string-match (concat "[a-zA-Z]:/" (regexp-quote trashcan--dirname)) file) ;; ;; NOTE: we are in DOS mode in this branch ;; (let ((d (substring file 0 3)) (f (substring file (+ 4 (length trashcan--dirname)))) (i 0)) (while (< i (length f)) (if (eq ?! (aref f i)) (aset f i ?/)) (incf i)) (concat d f)) (progn ;; ;; NOTE: we are in UNIX mode in this branch ;; (assert (string-match (concat (expand-file-name "~/") (regexp-quote trashcan--dirname) "/\\(.*\\)$") file)) (let ((x (substring file (match-beginning 1) (match-end 1))) (i 0)) (while (< i (length x)) (if (eq ?! (aref x i)) (aset x i ?/)) (incf i)) (concat "/" x))) ) ) (defun trashcan--walk-buffers (sexp) (save-window-excursion (let ((ptr (buffer-list))) (while ptr (set-buffer (car ptr)) (eval sexp) (setq ptr (cdr ptr)))))) ;;; (trashcan--delete-dangerous (setq file-or-directory "d:/TRASHCAN/workspace/")) ;;; (trashcan--delete-dangerous (setq file-or-directory "c:/TRASHCAN")) (defun trashcan--delete-dangerous (file-or-directory) "Is better than the built-in function delete-file in that it also deletes directories, therefore is more dangerous than delete-file" (if (file-exists-p file-or-directory) (if (file-directory-p file-or-directory) (progn ;;(sit-for 2) (shell-command (concat "rm -rf \"" file-or-directory "\"")) ;;(sit-for 2) ) (delete-file file-or-directory)))) (defun trashcan--in-windows-trashcan (&optional OR-SUBDIR) "Returns the current trashcan directory if there is one" (if OR-SUBDIR (if (string-match (concat "^\\([a-zA-Z]:/" (regexp-quote trashcan--dirname) "\\)") (expand-file-name default-directory)) (substring (expand-file-name default-directory) (match-beginning 1) (match-end 1))) (if (string-match (concat "^\\([a-zA-Z]:/" (regexp-quote trashcan--dirname) "\\)/?$") (expand-file-name default-directory)) (substring (expand-file-name default-directory) (match-beginning 1) (match-end 1))))) (defun trashcan--in-unix-trashcan (&optional OR-SUBDIR) "Returns the current trashcan directory if there is one" (if OR-SUBDIR (if (string-match (concat "^" (expand-file-name "~/") (regexp-quote trashcan--dirname)) (expand-file-name default-directory)) (concat (expand-file-name "~/") trashcan--dirname)) (if (string-match (concat "^" (expand-file-name "~/") (regexp-quote trashcan--dirname) "/?$") (expand-file-name default-directory)) (concat (expand-file-name "~/") trashcan--dirname)) ) ) (defun trashcan--in-trashcan (&optional OR-SUBDIR) (or (trashcan--in-windows-trashcan OR-SUBDIR) (trashcan--in-unix-trashcan OR-SUBDIR))) (defun trashcan--after-deletion () ;; ;; NOTE: conditionally kills file buffers that have been deleted ;; ;; NOTE: unconditionally kills dired buffers that have been deleted ;; (let (dirname) (cond ((setq dirname (trashcan--in-windows-trashcan 'OR-SUBDIR))) ((setq dirname (trashcan--in-unix-trashcan 'OR-SUBDIR))) (t (error "Should never happen"))) (trashcan--walk-buffers '(if (or (and (buffer-file-name) (string-match (concat "^" dirname) default-directory) (y-or-n-p (concat "Kill buffer " (buffer-file-name) " too? "))) (and (eq major-mode 'dired-mode) (not (file-exists-p default-directory)))) (kill-buffer nil)))) ) (require 'dired) (defun dired-internal-do-deletions (l arg) "This function replaces the function of the same name in the standard Emacs file dired.el" ;;(my-foo) (if (not (eq major-mode 'dired-mode)) (error "You must be in dired mode to do this")) (let ((ptr l)) (while ptr (if (or (string-match "/./?$" (caar ptr)) (string-match "/../?$" (caar ptr))) (error "You cannot delete the directories . or ..")) (setq ptr (cdr ptr)))) ;;(debug) (let ((in-trash (trashcan--in-trashcan 'OR-SUBDIR)) (files (mapcar (function car) l))) ;; NOTE: these two have the same result... (setq files (nreverse (mapcar (function dired-make-relative) files))) ;;(setq files (nreverse (mapcar 'dired-make-relative files))) ;;(debug) (if in-trash (if (dired-mark-pop-up " *Deletions*" 'delete files dired-deletion-confirmer (format "Permanently Delete %s " (dired-mark-prompt arg files))) (let ((ptr l)) (while ptr (trashcan--delete-dangerous (caar ptr)) (setq ptr (cdr ptr))) (revert-buffer) (trashcan--after-deletion))) (if (dired-mark-pop-up " *Deletions*" 'delete files dired-deletion-confirmer (format "Move to trashcan %s " (dired-mark-prompt arg files))) (let ((ptr l)) (while ptr ;;(message "rename-file %s -> %s" (caar ptr) "d:/eraseme/") ;;(debug) (let* ((f (caar ptr)) (e (trashcan--encode f)) (d (file-name-directory e))) ;;(debug) (if (not (file-exists-p d)) (make-directory d 'PARENTS)) ;;(debug) (rename-file f e) ;; NOTE: this is guaranteed to work (see function trashcan--encode) (trashcan--walk-buffers '(if (and (buffer-file-name) (string-match (concat "^" (regexp-quote f)) (buffer-file-name))) (let ((n (substring (buffer-file-name) (length f)))) ;;(debug) (set-visited-file-name (concat e n) 'NO-QUERY)))) (trashcan--walk-buffers '(if (and (eq major-mode 'dired-mode) (not (file-exists-p (expand-file-name default-directory)))) (kill-buffer nil))) ) (setq ptr (cdr ptr))) (revert-buffer) (trashcan--walk-buffers '(if (and (eq major-mode 'dired-mode) (trashcan--in-trashcan 'OR-SUBDIR)) (revert-buffer))) ) ) ) ) ) (defun trashcan--restore () (interactive) (let* ((list (dired-get-marked-files)) (ptr list)) (while ptr (let* ((source (car ptr)) (target (trashcan--decode source)) (fnd (file-name-directory target))) ;;(debug) (if (file-exists-p target) (error "File %s already exists" target)) (make-directory fnd 'PARENTS) (rename-file source target) ;; ;; NOTE: are we editing one of the files that we want to restore? ;; ;;(trashcan--walk-buffers ;; '(if (string= (buffer-file-name) source) ;; (set-visited-file-name target 'NO-QUERY))) ;; ;; NOTE: are we editing a files of a subdirectory that we want to restore ;; (trashcan--walk-buffers '(if (and (buffer-file-name) (string-match (concat "^" (regexp-quote source)) (buffer-file-name))) (let ((n (substring (buffer-file-name) (length source)))) ;;(debug) (set-visited-file-name (concat target n) 'NO-QUERY)))) (trashcan--walk-buffers '(if (and (eq major-mode 'dired-mode) (string= fnd (expand-file-name default-directory))) (revert-buffer))) (trashcan--walk-buffers '(if (and (eq major-mode 'dired-mode) (not (file-exists-p (expand-file-name default-directory)))) (kill-buffer nil))) ) (setq ptr (cdr ptr)))) (trashcan--walk-buffers '(if (and (eq major-mode 'dired-mode) (trashcan--in-trashcan 'OR-SUBDIR)) (revert-buffer))) ) (defun trashcan--empty () "Careful when using this command as it cannot be undone" (interactive) (cond ((not (trashcan--in-trashcan)) (error "You must be in the trashcan to execute this command")) ((not (eq major-mode 'dired-mode)) (error "You must be in dired mode to execute this command")) (t (if (yes-or-no-p "Really empty trashcan? ") (let (dirname) (cond ((setq dirname (trashcan--in-windows-trashcan))) ((setq dirname (trashcan--in-unix-trashcan))) (t (error "Should never happen"))) ;;(debug) (trashcan--delete-dangerous dirname) ;;(audible-beeps "Deleting file %s" dirname) (make-directory dirname 'PARENTS) (revert-buffer) (trashcan--after-deletion)))))) (provide 'trashcan) ;;; trashcan.el ends here _______________________________________________ gnu-emacs-sources mailing list [email protected] http://lists.gnu.org/mailman/listinfo/gnu-emacs-sources
