[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
A Windows style file deletion system
From: |
Davin Pearson |
Subject: |
A Windows style file deletion system |
Date: |
27 May 2006 02:04:19 -0700 |
User-agent: |
G2/0.2 |
;;; 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
- A Windows style file deletion system,
Davin Pearson <=