trashcan.el

    

;;; trashcan.el --- A recoverable file deletion system

;; Copyright (C) 2006-2016 Davin Pearson

;; Author/Maintainer: Davin Max Pearson <http://davin.50webs.com>
;; Version: 1.17
;; Package-Requires: ()
;; Keywords: Amiga MacOS Trash Can Windows Recycle Bin

;;; Commentary:

;; This file is not part of GNU Emacs.

;; The file trashcan.el contains a recoverable file deletion system
;; that behaves like the trash can or recycle bin that many operating
;; systems, present and past, show on their screens.  This system
;; creates special directories known as trashcan directories to hold
;; files that can be deleted or undeleted (restored/recovered).  On
;; Unix systems there is one trashcan in the folder HOME and in each
;; of the folders /media/[A-Za-z0-9]+/[A-Za-z0-9]+ for one trashcan
;; directory in each Lubuntu drive.  On Windows systems there are
;; trashcan directories at the following default locations:
;; a:\TRASHCAN, b:\TRASHCAN, c:\TRASHCAN etc.

;; This system changes the behaviour of the "x" key in dired mode from
;; permanently deleting files to a two stage system. If you are not in
;; a trashcan directory, then the selected files are moved into a
;; trashcan directory. If you are already in a trashcan directory, the
;; the selected files are permanently deleted. Files in a trashcan
;; directory can be restored by viewing that directory in dired mode,
;; selecting some files and executing the command M-x
;; trashcan-restore. All of the files in a trashcan directory can also
;; be permanently deleted in one hit by issuing the command M-x
;; trashcan-empty. The name "trashcan" comes from my old Amiga
;; Computer which I still have fond memories of!

;;; Limitation of Warranty

;; This program 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 3 of the License, or (at
;; your option) any later version.
;;
;; This program 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, see:
;;
;; <http://www.gnu.org/licenses/gpl-3.0.txt>.


;;; Install Instructions:
;; See the following URL for the latest info and a tarball:
;;
;; <http://davin.50webs.com/research/2006/mopa2e.html#trashcan>
;;
;; Then untar the tarball to a folder pointed to by the Emacs variable
;; load-path and add the following line to your ~/.emacs file.
;;
;; (require 'trashcan)

;;; Known Bugs:

;;  (1) Doesn't respect make-auto-save-file-name

;;  (2) Doesn't preserve the marked files (*) in dired buffers when files are
;;      moved in or out of a trashcan directory

;;  (3) Richard Stallman told me that code that is to be distributed with Emacs
;;      should not use the defadvice feature.   I leave the task of removing
;;      all calls to defadvice to someone else.

;;; Version History

;; Version 1.17 Added support for multiple Lubuntu drives

;; Version 1.16 Joe Bloggs - vapniks@yahoo.com improved the windows
;; detection function trashcan--is-a-windows-system by adding a call
;; to system-type

;; Version 1.15 Fixed a bug when you try to delete or restore a file
;; with a % character in it.

;; Version 1.14 Added progress messages to trashcan--rename-to-trash
;; and trashcan-restore.

;; Version 1.13 Changed it so that you can delete files from the
;; trashcan.

;; Version 1.12 Added a error message if you try to delete a file or
;; directory with an exclamation mark in the name.  Fixed a bug in the
;; documentation of trashcan.el thanks to an email from Santiago Mejia

;; Version 1.11 Fixed a bug pointed out by Alex Scherbanov where
;; "^a-zA-Z:/" should be "^[a-zA-Z]:/".

;; Version 1.10 Debugged trashcan--rename-from-trash

;; Version 1.9 Added a new safe execution comqmand
;; trashcan--safe-command and called it from
;; trashcan--rename-from-trash

;; Version 1.8 Debugged trashcan--rename-from-trash by adding and
;; calling new function trashcan--remove-exclamation

;; Version 1.7 Fixed a bug where you do the following actions:
;;
;;  1. Trashcan delete ~/foo/bar
;;  2. Trashcan delete ~/foo
;;  3. Trashcan restore ~/TRASHCAN/foo!bar
;;  4. Doesn't complain about missing directory ~/foo

;; Version 1.6 Fixed a bug running trashcan.el on GNU Emacs on Mac-OS.
;; Thanks go to Martin Buchmann for pointing out this bug to me.

;; Version 1.5 Attempted to fix a bug when running this code in XEmacs

;; Version 1.4 Added a fallback in case dired-delete-file is
;; undefined.

;; Version 1.3 Fixed a compile warning re: assignment to global variable
;; trashcan--refresh-count

;; Version 1.2 Fixed a bug in trashcan--delete-dangerous.  Fixed
;; per-buffer-code argument flag of trashcan--walk-buffers to &rest.

;; Version 1.1 Removed calls to defadvice following a discussion with
;; Richard Stallman.  Changed trashcan--walk-buffers from a function
;; into a macro for faster execution in compiled form.  Changed
;; trashcan--delete-dangerous to use dired-delete-file rather
;; than shell-command rm -rvf
;;
;; Version 1.0 First version

;;; Code:

(defun trashcan--is-a-windows-system ()
  (memq system-type '(windows-nt ms-dos)))

;;; If above function doesn't work try using the one below instead.
;; (defun trashcan--is-a-windows-system ()
;;   (file-exists-p "c:/"))

(defun trashcan--is-a-unix-system ()
  (not (trashcan--is-a-windows-system)))

(defvar trashcan-dirname (if (trashcan--is-a-windows-system) "TRASHCAN" ".Trash")
  "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, there is one trashcan directory for
each user and are located at the following places:

(concat \"~/\" trashcan-dirname)

Also there are trashcan directories in the following regexp:
\"/media/[0-9A-Za-z]+/[0-9A-Za-z]+\" for one trashcan directory
in each Lubuntu drive.

In Windows, DO NOT give this the same name as the windows RECYCLER
directory as this will confuse the hell out of Windows.

")

(defvar trashcan-patch-delete-stuff-p t
  "This variable if set causes the functions delete-file and
delete-directory to be patched to use the trashcan directories
instead of deleting files permenantely."
)

;;; (trashcan--split (setq file "d:/home/mylisp/trashcan.el"))
;;; (trashcan--split (setq file "/home/www/mylisp/trashcan.el"))
;;; (trashcan--split (setq file "/home/www/C/home/dlisp/trashcan.el"))
;;; (setq str "/media/www/\\([0-9A-Z]+/\\)")
;;; (setq file "/media/www/J600GB/log.txt")
;;; (setq file "/home/www/log.txt")
;;; (setq file "/home/www/java-projects/log.txt")
;;; (setq file "~/C/home/log.txt")
(defun trashcan--split (file)
  ;;
  ;; NOTE: this function gives meaningful results for both WINDOWS and UNIX
  ;;
  (setq file (expand-file-name file))

(if (string-match "^[a-zA-Z]:/" file)
      (cons (substring file 0 3) (substring file 3))
    (if (string-match "/home/www/C/" file)
        (setq file (cons "/media/www/C1TB/"
                         (substring file (match-end 0))))
      (if (string-match "/media/\\([0-9A-Za-z]+\\)/\\([0-9A-Za-z]+/\\)" file)
          (cons (substring file 0 (match-end 2))
                (substring file (match-end 2))
                )
        (if (string-match (concat "\\(" (expand-file-name "~/") "\\)") file)
            (cons (expand-file-name "~/")
                  (substring file (match-end 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"
;;; (trashcan--encode (setq file "/media/www/J600GB/log.txt"))
;;; (setq s (trashcan--split file))
(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"))
;;; (trashcan--decode (setq file "/media/www/J600GB/TRASHCAN/abc!log.txt"))

(defun trashcan--decode (file)

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

((string-match (concat "^/media/[A-Za-z0-9]+/\\([A-Za-z0-9]+/\\)" (regexp-quote trashcan-dirname) "/\\(.*\\)$") file)
    ;;
    ;; NOTE: we are in UNIX mode in this branch
    ;;
    ;;(assert (string-match (concat (expand-file-name "~/") (regexp-quote trashcan-dirname) "/\\(.*\\)$") file))
    (let ((y (substring file 0 (match-end 1)))
          (x (substring file (match-beginning 2) (match-end 2)))
          (i 0))
      (while (< i (length x))
        (if (eq ?! (aref x i))
            (aset x i ?/))
        (incf i))
      ;;(debug "toilet")
      (concat y x))
    )

(t
     ;;
     ;; 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))
       ;;(debug "Hot Tomales")
       (concat "~/" x))
     )
    )
  )

(defmacro trashcan--walk-buffers (sexp)
  ;;
  ;; NOTE: a long name is used here to guard against accidental aliasing
  ;;
  (save-window-excursion
    (let ((trashcan--walk-buffers--ptr (buffer-list)))
      (while trashcan--walk-buffers--ptr
        (set-buffer (car trashcan--walk-buffers--ptr))
        (eval sexp)
        (setq trashcan--walk-buffers--ptr (cdr trashcan--walk-buffers--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"
  ;;
  ;; NOTE: cannot use delete-file here because that command calls this one (i.e. an infinite loop)
  ;;
  (if (file-exists-p file-or-directory)
      (shell-command (concat "rm -rvf \"" file-or-directory "\""))
    ))

;;; (trashcan--in-windows-trashcan filename)
(defun trashcan--in-windows-trashcan (filename)
  "Returns the relevant windows trashcan directory or nil if there isn't one"
  (setq filename (expand-file-name filename))
  (let ((dirname (file-name-directory filename)))
    (if (string-match (concat "^\\([a-zA-Z]:/" (regexp-quote trashcan-dirname) "\\)") dirname)
        (substring dirname (match-beginning 1) (match-end 1)))))

;;; (setq filename "/media/www/F2TB/TRASHCAN/")
;;; (setq filename "/media/www/F2TB/TRASHCAN/")
;;; (setq filename "/media/www/C80GB/home/dlisp/")
;;; (setq dirname  (file-name-directory filename))
;;; (setq dir-regexp "/media/www/\\([A-Z0-9]+/\\)TRASHCAN/")
;;; (setq dir-regexp (concat "/media/\\([A-Za-z0-9]+/\\)\\([A-Z0-9]+/\\)" (regexp-quote trashcan-dirname) "/"))
;;; (trashcan--in-unix-trashcan filename)
(defun trashcan--in-unix-trashcan (filename)
  "Returns the relevant unix trashcan directory or nil if there isn't one"
  (setq filename (expand-file-name filename))
  (if (not (string-match "/$" filename))
      (setq filename (concat filename "/")))
  (setq filename (expand-file-name filename))
  (when (string-match "^/home/www/C/TRASHCAN/" filename)
    (setq filename (concat "/media/www/C1TB/TRASHCAN/" (substring filename (match-end 0)))))
  (let ((dirname    (file-name-directory filename))
        (dir-regexp (concat "/media/\\([A-Za-z0-9]+/\\)\\([A-Z0-9]+/\\)" (regexp-quote trashcan-dirname) "/")))
    (if (string-match dir-regexp filename)
        (progn
          (setq s (concat (substring filename 0 (match-end 2)) trashcan-dirname "/"))
          (make-directory (file-name-directory s) 'PARENTS)
          s)
      (if (string-match (concat "^" (expand-file-name "~/") (regexp-quote trashcan-dirname) "/") dirname)
          (progn
            (make-directory (concat "~/" trashcan-dirname "/") 'PARENTS)
            (concat (expand-file-name "~/") trashcan-dirname "/"))))))

;;; (setq filename "~/C/TRASHCAN")
;;; (setq filename "~/C/")
(defun trashcan--in-trashcan (filename)
  (or (trashcan--in-windows-trashcan filename)
      (trashcan--in-unix-trashcan filename)))

(defun trashcan--after-permanent-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 default-directory)))
     ((setq dirname (trashcan--in-unix-trashcan    default-directory)))
     (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)))))

(setq trashcan--global-refresh-count 1)

;;;
;;; FIXME: too slow for large amounts of files
;;;
(defun trashcan--rename-to-trash (file-list)

  ;;(debug "file-list=%s" file-list)

  (let ((dir nil))
    (let ((ptr file-list))
      (while ptr
        ;;
        ;; NOTE: Creates a trash directory if none exists, then renames the file to trash directory.
        ;;
        (let* ((new-name (trashcan--encode (car ptr)))
               (fnd      (file-name-directory new-name)))
          ;;(debug "foomatic")
          (if (not (file-exists-p fnd))
              (make-directory fnd 'PARENTS))
          (setq dir fnd)
          ;;(debug "spotty")
          (rename-file (car ptr) new-name))
        (setq ptr (cdr ptr)))

      ;;(debug "carrot")

      (setq ptr file-list)

(incf trashcan--global-refresh-count)

(if (not (boundp 'trashcan--refresh-count))
          (setq-default trashcan--refresh-count nil))

(while ptr

(trashcan--walk-buffers
         (progn
            (make-local-variable 'trashcan--refresh-count)
            (if (and (buffer-file-name)
                     (string-match (concat "^" (regexp-quote (car ptr))) (buffer-file-name))
                     (not (eq trashcan--global-refresh-count trashcan--refresh-count)))
                (set-visited-file-name (trashcan--encode (car ptr)) 'NO-QUERY))
            (setq trashcan--refresh-count trashcan--global-refresh-count)))

        ;;
        ;; NOTE: reverts all direds of the original file
        ;;
        (let ((dirname (file-name-directory (car ptr))))
          (trashcan--walk-buffers
           (progn
              (make-local-variable 'trashcan--refresh-count)
              (if (and (eq major-mode 'dired-mode)
                       (string-match (concat "^" (regexp-quote dirname) "/?$") default-directory)
                       (not (eq trashcan--global-refresh-count trashcan--refresh-count)))
                  (revert-buffer))
              (set (make-local-variable 'trashcan--refresh-count) trashcan--global-refresh-count))))

(setq ptr (cdr ptr))))

(if (trashcan--is-a-windows-system)
        (setq dir (downcase dir)))

    ;;
    ;; NOTE: deletes all dired buffers that have had their dirs deleted
    ;;
    (trashcan--walk-buffers
     (if (and (eq major-mode 'dired-mode) (not (file-exists-p (expand-file-name default-directory))))
          (kill-buffer nil)))

    ;;
    ;; NOTE: reverts trashcan buffers that have been changed
    ;;
    (trashcan--walk-buffers
     (if (and (eq major-mode 'dired-mode) (string=
                                           (if (trashcan--is-a-windows-system)
                                               (downcase default-directory)
                                             default-directory) dir))
          (revert-buffer)))))

(require 'dired)

;;;
;;; NOTE: This function advised takes two args (l arg)
;;;
;;; advised dired-internal-do-deletions (l arg)
;;;
(defadvice dired-internal-do-deletions (around trashcan-stub activate)

"This function replaces the function of the same name in the standard Emacs file dired.el"

(if (not (eq major-mode 'dired-mode))
      (error "You must be in dired mode to execute dired-internal-do-deletions"))

(if (string-match "^/[a-z0-9]*:" (car (car l)))
      ad-do-it)

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

(let ((ptr l))
    (while ptr
      (if (or (string-match (concat "^[a-zA-Z]:/" (regexp-quote trashcan-dirname) "/?$") (caar ptr))
              (string-match (concat "/media/www/\\([a-zA-Z0-9]+\\)/" (regexp-quote trashcan-dirname) "/?$") (caar ptr))
              (string-match (concat "^" (expand-file-name "~/") (regexp-quote trashcan-dirname) "/?$") (caar ptr)))

(progn
            ;;(debug)
            (error (concat "You cannot move a trashcan directory (%s) into a trashcan directory "
                           "(Try \"rm -r\" instead)")
                   trashcan-dirname)))
      (setq ptr (cdr ptr))))

(let ((in-trash (trashcan--in-trashcan default-directory))
        (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))

              ;;(debug)
              (while ptr
                (trashcan--delete-dangerous (caar ptr))
                (message "Deleted file %s " (caar ptr))
                (setq ptr (cdr ptr)))
              ;;(debug)
              (revert-buffer)
              (trashcan--after-permanent-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)
                (list nil))
            (while ptr
              (setq list (cons (caar ptr) list))
              (setq ptr (cdr ptr)))

            ;;(debug)
            (trashcan--rename-to-trash list)
            (revert-buffer))
        ))))

(defun trashcan--make-absolute (filename)
  (setq filename (expand-file-name filename))

(if (string-match "/$" filename)
      (setq filename (substring filename 0 (1- (length filename)))))

  ;;(debug)

  (if (not (or (string-match "^[a-zA-Z]:/" filename)
               (string-match "^/" filename)))
      (concat (expand-file-name default-directory) filename)
    filename))

;;
;; NOTE: This function advised takes one arg (filename)
;;
(defadvice delete-file (around trashcan-stub activate)
  "Adds trashcan functionality to delete-file.  If given an autosave
file, it behaves like the default setting of delete-file.  See the
variable trashcan-patch-delete-stuff-p"
  ;;(beeps "Calling delete-file")
  ;;(debug)
  ;;(debug)
  ;;(if (string-match

  (if (or (not trashcan-patch-delete-stuff-p)
          (string-match "^#.*#$" (file-name-nondirectory filename))
          ;; following three lines added by me (Joe Bloggs) since I have home dir in seperate partition
          ;; and it gets stuck in an infinite loop without these lines
          (and (file-name-directory filename)
               (not (or (string-match (concat "^" (expand-file-name "~") "/") (file-name-directory filename))
                        (string-match "^~/" (file-name-directory filename))))))
      (progn
        ;;(beeps "file=%s" (file-name-nondirectory filename))
        ad-do-it)
    (setq filename (trashcan--make-absolute filename))
    ;;(debug)
    (if (trashcan--in-trashcan filename)
        (progn
          ;; ad-do-it
          (trashcan--delete-dangerous filename)
          (trashcan--after-permanent-deletion))
      (trashcan--rename-to-trash (list filename)))))

;;
;; NOTE: This function advised takes one arg (directory)
;;
(defadvice delete-directory (around trashcan-stub activate)
  "Adds trashcan functionality to delete-directory.  If given an
autosave file, it behaves like the default setting of delete-file.
See the variable trashcan-patch-delete-stuff-p"
  ;;(beeps "Calling delete-directory")
  ;;(beeps "directory=%s" directory)
  (if (or (not trashcan-patch-delete-stuff-p)
          (string-match "^#.*#$" (file-name-nondirectory directory))
          ;; following three lines added by me (Joe Bloggs) since I have home dir in seperate partition
          ;; and it gets stuck in an infinite loop without these lines
          (and (file-name-directory directory)
               (not (or (string-match (concat "^" (expand-file-name "~") "/") (file-name-directory directory))
                        (string-match "^~/" (file-name-directory directory))))))
      ad-do-it
    (setq directory (trashcan--make-absolute directory))
    ;;(debug)
    (if (trashcan--in-trashcan directory)
        (progn
          ;;ad-do-it
          (trashcan--delete-dangerous directory)
          (trashcan--after-permanent-deletion))
      (trashcan--rename-to-trash (list directory)))))

(defun trashcan-restore ()
  (interactive)

(if (not (trashcan--in-trashcan default-directory))
      (error "You must be in the trashcan directory (%s) to execute this command" trashcan-dirname))

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

        ;;(debug "foomatic")
        (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 default-directory))
        (revert-buffer))))

(defun trashcan-empty ()
  "Careful when using this command as it cannot be undone"
  (interactive)
  (cond
   ((not (trashcan--in-trashcan default-directory))
    (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 default-directory)))
           ((setq dirname (trashcan--in-unix-trashcan    default-directory)))
           (t
            (error "Should never happen")))
          ;;(debug)
          (save-window-excursion
            (trashcan--delete-dangerous dirname))
          (make-directory dirname 'PARENTS)
          (revert-buffer)
          (trashcan--after-permanent-deletion))))))

(provide 'trashcan)