X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/fba2cb921827fa491868addb591f2f9c7b7152ee..8d1a26de6c716127b67d3b0c6808d5beeb13bba2:/dired-async.el

diff --git a/dired-async.el b/dired-async.el
index 9c2d10c6f..d7377a90d 100644
--- a/dired-async.el
+++ b/dired-async.el
@@ -1,10 +1,10 @@
-;;; dired-async --- Copy/move/delete asynchronously in dired
+;;; dired-async.el --- Asynchronous dired actions -*- lexical-binding: t -*-
 
-;; Copyright (C) 2012 John Wiegley
+;; Copyright (C) 2012-2016 Free Software Foundation, Inc.
+
+;; Authors: John Wiegley <jwiegley@gmail.com>
+;;          Thierry Volpiatto <thierry.volpiatto@gmail.com>
 
-;; Author: John Wiegley <jwiegley@gmail.com>
-;; Created: 14 Jun 2012
-;; Version: 1.0
 ;; Keywords: dired async network
 ;; X-URL: https://github.com/jwiegley/dired-async
 
@@ -25,248 +25,156 @@
 
 ;;; Commentary:
 
-;; The function, which must be loaded *after* dired-aux.el, performs copies,
-;; moves and deletes in the background using a slave Emacs process, by means
-;; of the async.el module.  To use it, put this in your .emacs:
-;;
-;;   (eval-after-load "dired-aux"
-;;     '(require 'dired-async))
-;;
-;; NOTE: If you have `delete-by-moving-to-trash' set to t, and you enable
-;; `dired-async-use-native-commands', you will need to install the following
-;; bash script on your system's PATH as "rmtrash".  Please edit to suit your
-;; system.  It depends on the GNU realpath
-;;
-;; #!/bin/bash
-;;
-;; function mv_to_trash {
-;;     path="$1"
-;;     trash="$2"
-;;
-;;     if test -L "$path"; then
-;;         rm -f "$path"           # don't trash symlinks, just remove them
-;;     else
-;;         target="$trash"/$(basename "$path")
-;;         if test -e "$target"; then
-;;             for (( index=$$ ; 1; index=index+1 )); do
-;;                 target="$target"-"$index"
-;;                 if ! test -e "$target"; then
-;;                     break
-;;                 fi
-;;             done
-;;         fi
-;;         mv -f "$path" "$target" # don't worry about race-condition overwrites
-;;     fi
-;; }
-;;
-;; for item in "$@"; do
-;;     if [[ -n "$item" && ${item:0:1} == '-' ]]; then
-;;         continue
-;;     elif ! test -e "$item"; then
-;;         continue
-;;     else
-;;         target=$(realpath "$item")
-;;         if [[ "$target" =~ ^/Volumes/([^/]+)/ ]]; then
-;;             mv_to_trash "$item" "/Volumes/${BASH_REMATCH[1]}/.Trashes/$EUID"
-;;         else
-;;             mv_to_trash "$item" "$HOME/.Trash"
-;;         fi
-;;     fi
-;; done
+;; This file provide a redefinition of `dired-create-file' function,
+;; performs copies, moves and all what is handled by `dired-create-file'
+;; in the background using a slave Emacs process,
+;; by means of the async.el module.
+;; To use it, put this in your .emacs:
+
+;;     (dired-async-mode 1)
+
+;; This will enable async copy/rename etc...
+;; in dired and helm.
 
 ;;; Code:
 
+(require 'cl-lib)
 (require 'dired-aux)
 (require 'async)
-(require 'async-file)
+
+(eval-when-compile
+  (defvar async-callback))
 
 (defgroup dired-async nil
-  "Copy/move/delete asynchronously in dired"
+  "Copy rename files asynchronously from dired."
   :group 'dired)
 
-(defface dired-async-in-process-face
-  '((t (:background "yellow")))
-  "Face used to show that an asynchronous operation is in progress."
+(defcustom dired-async-env-variables-regexp
+  "\\`\\(tramp-\\(default\\|connection\\|remote\\)\\|ange-ftp\\)-.*"
+  "Variables matching this regexp will be loaded on Child Emacs."
+  :type  'regexp
   :group 'dired-async)
 
-(defvar dired-async-queue nil
-  "Queue of pending asynchronous file operations.
-Each operation that succeeds will start the next member of the queue.  If an
-error occurs at any point, the rest of the queue is flushed.")
-
-(defun dired-async-highlight-file (file)
-  (save-excursion
-    (dired-goto-file file)
-    (let ((overlay (make-overlay (line-beginning-position)
-                                 (line-end-position))))
-      (overlay-put overlay 'face 'dired-async-in-process-face)
-      overlay)))
+(defcustom dired-async-message-function 'dired-async-mode-line-message
+  "Function to use to notify result when operation finish.
+Should take same args as `message'."
+  :group 'dired-async
+  :type  'function)
 
-(defun dired-async-remove-highlight (overlay)
-  (delete-overlay overlay))
+(defcustom dired-async-log-file "/tmp/dired-async.log"
+  "File use to communicate errors from Child Emacs to host Emacs."
+  :group 'dired-async
+  :type 'string)
 
-(defun dired-after-file-create (to actual-marker-char &optional overwrite)
-  (if overwrite
-      ;; If we get here, file-creator hasn't been aborted
-      ;; and the old entry (if any) has to be deleted
-      ;; before adding the new entry.
-      (dired-remove-file to))
-  (dired-add-file to actual-marker-char))
-
-(eval-when-compile
-  (defvar actual-marker-char)
-  (defvar overwrite)
-  (defvar async-callback))
-
-(defmacro dired-async-wrap-call (file callback forms)
-  `(let ((overlay (dired-async-highlight-file ,file)))
-     ,(if callback
-          `(setq ,callback `(lambda (ret)
-                              (dired-async-remove-highlight ,overlay)
-                              (funcall ,,callback ret))))
-     ,forms))
-
-(put 'dired-async-wrap-call 'lisp-indent-function 2)
+(defface dired-async-message
+    '((t (:foreground "yellow")))
+  "Face used for mode-line message."
+  :group 'dired-async)
 
-(defun dired-copy-file-recursive (from to ok-flag &optional
-                                       preserve-time top recursive)
-  (when (and (eq t (car (file-attributes from)))
-             (file-in-directory-p to from))
-    (error "Cannot copy `%s' into its subdirectory `%s'" from to))
-  (let ((attrs (file-attributes from))
-        (callback (if (boundp 'actual-marker-char)
-                      `(lambda (&optional ignore)
-                         (dired-after-file-create ,to ,actual-marker-char
-                                                  ,overwrite))
-                    (lambda (&optional ignore)))))
-    (if (and recursive
-             (eq t (car attrs))
-             (or (eq recursive 'always)
-                 (yes-or-no-p (format "Recursive copies of %s? " from))))
-        ;; This is a directory.
-        (dired-async-wrap-call from callback
-          (async-copy-file from to ok-flag preserve-time nil nil
-                           :callback callback))
-      ;; Not a directory.
-      (or top (dired-handle-overwrite to))
-      (condition-case err
-          (if (stringp (car attrs))
-              ;; It is a symlink
-              (make-symbolic-link (car attrs) to ok-flag)
-            (dired-async-wrap-call from callback
-              (async-copy-file from to ok-flag preserve-time nil nil
-                               :callback callback)))
-        (file-date-error
-         (push (dired-make-relative from)
-               dired-create-files-failures)
-         (dired-log "Can't set date on %s:\n%s\n" from err))))))
+(defface dired-async-failures
+    '((t (:foreground "red")))
+  "Face used for mode-line message."
+  :group 'dired-async)
 
-(defun dired-rename-file (file newname ok-if-already-exists)
-  (dired-handle-overwrite newname)
-  (let ((callback
-         (if (boundp 'actual-marker-char)
-             `(lambda (&optional ignore)
-                ;; Silently rename the visited file of any buffer visiting this
-                ;; file.
-                (and (get-file-buffer ,file)
-                     (with-current-buffer (get-file-buffer ,file)
-                       (set-visited-file-name ,newname nil t)))
-                (dired-remove-file ,file)
-                ;; See if it's an inserted subdir, and rename that, too.
-                (dired-rename-subdir ,file ,newname)
+(defface dired-async-mode-message
+    '((t (:foreground "Gold")))
+  "Face used for `dired-async--modeline-mode' lighter."
+  :group 'dired-async)
 
-                (dired-after-file-create ,newname ,actual-marker-char
-                                         ,overwrite))
-           (lambda (&optional ignore)))))
-    (if (and dired-async-use-native-commands
-             (not (file-remote-p file))
-             (not (file-remote-p newname)))
-        (let ((args (list "-f" file newname)))
-          (unless ok-if-already-exists
-            (setq args (cons "-n" args)))
-          (apply #'async-start-process "mv" (executable-find "mv")
-                 callback args))
-      (dired-async-wrap-call file callback
-        (async-start (apply-partially #'rename-file file newname
-                                      ok-if-already-exists)
-                     callback)))))
+(define-minor-mode dired-async--modeline-mode
+    "Notify mode-line that an async process run."
+  :group 'dired-async
+  :global t
+  :lighter (:eval (propertize (format " [%s Async job(s) running]"
+                                      (length (dired-async-processes)))
+                              'face 'dired-async-mode-message))
+  (unless dired-async--modeline-mode
+    (let ((visible-bell t)) (ding))))
 
-(defun dired-delete-file (file &optional recursive trash) "\
-Delete FILE or directory (possibly recursively if optional RECURSIVE is true.)
-RECURSIVE determines what to do with a non-empty directory.  If RECURSIVE is:
-nil, do not delete.
-`always', delete recursively without asking.
-`top', ask for each directory at top level.
-Anything else, ask for each sub-directory."
-  ;; This test is equivalent to
-  ;; (and (file-directory-p fn) (not (file-symlink-p fn)))
-  ;; but more efficient
-  (if (not (eq t (car (file-attributes file))))
-      (dired-async-wrap-call file nil
-        (cond
-         ;; How to reliably trash files on other systems?  Use Emacs to do it
-         (trash
-          (async-start-process "rmtrash" (executable-find "rmtrash")
-                               'ignore "-f" file))
-         ((and (not trash) dired-async-use-native-commands
-               (not (file-remote-p file)))
-          (async-start-process "rm" (executable-find "rm") 'ignore "-f" file))
-         (t
-          (async-start (apply-partially #'delete-file file trash)
-                       'ignore))))
-    (if (and recursive
-             (directory-files file t dired-re-no-dot) ; Not empty.
-             (or (eq recursive 'always)
-                 (yes-or-no-p (format "Recursively %s %s? "
-                                      (if (and trash
-                                               delete-by-moving-to-trash)
-                                          "trash"
-                                        "delete")
-                                      (dired-make-relative file)))))
-        (if (eq recursive 'top) (setq recursive 'always)) ; Don't ask again.
-      (setq recursive nil))
-    (dired-async-wrap-call file nil
-      (if (and dired-async-use-native-commands
-               (not (file-remote-p file)))
-          (if recursive
-              (if trash
-                  (async-start-process "rmtrash" (executable-find "rmtrash")
-                                       'ignore "-fr" file)
-                (async-start-process "rm" (executable-find "rm")
-                                     'ignore "-fr" file))
-            (async-start-process "rmdir" (executable-find "rmdir")
-                                 'ignore file))
-        (async-start (apply-partially #'delete-directory file recursive trash)
-                     'ignore)))))
+(defun dired-async-mode-line-message (text face &rest args)
+  "Notify end of operation in `mode-line'."
+  (message nil)
+  (let ((mode-line-format (concat
+                           " " (propertize
+                                (if args
+                                    (apply #'format text args)
+                                    text)
+                                'face face))))
+    (force-mode-line-update)
+    (sit-for 3)
+    (force-mode-line-update)))
 
-(defun dired-create-files (file-creator operation fn-list name-constructor
-                                        &optional marker-char)
-  "Create one or more new files from a list of existing files FN-LIST.
-This function also handles querying the user, updating Dired
-buffers, and displaying a success or failure message.
+(defun dired-async-processes ()
+  (cl-loop for p in (process-list)
+           when (cl-loop for c in (process-command p) thereis
+                         (string= "async-batch-invoke" c))
+           collect p))
 
-FILE-CREATOR should be a function.  It is called once for each
-file in FN-LIST, and must create a new file, querying the user
-and updating Dired buffers as necessary.  It should accept three
-arguments: the old file name, the new name, and an argument
-OK-IF-ALREADY-EXISTS with the same meaning as in `copy-file'.
+(defun dired-async-kill-process ()
+  (interactive)
+  (let* ((processes (dired-async-processes))
+         (proc (car (last processes))))
+    (and proc (delete-process proc))
+    (unless (> (length processes) 1)
+      (dired-async--modeline-mode -1))))
 
-OPERATION should be a capitalized string describing the operation
-performed (e.g. `Copy').  It is used for error logging.
+(defun dired-async-after-file-create (total operation failures skipped)
+  "Callback function used for operation handled by `dired-create-file'."
+  (unless (dired-async-processes)
+    ;; Turn off mode-line notification
+    ;; only when last process end.
+    (dired-async--modeline-mode -1))
+  (when operation
+    (if (file-exists-p dired-async-log-file)
+        (progn
+          (pop-to-buffer (get-buffer-create "*dired async*"))
+          (erase-buffer)
+          (insert "Error: ")
+          (insert-file-contents dired-async-log-file)
+          (delete-file dired-async-log-file))
+        (run-with-timer
+         0.1 nil
+         (lambda ()
+           ;; First send error messages.
+           (cond (failures
+                  (funcall dired-async-message-function
+                           "%s failed for %d of %d file%s"
+                           'dired-async-failures
+                           (car operation) (length failures)
+                           total (dired-plural-s total)))
+                 (skipped
+                  (funcall dired-async-message-function
+                           "%s: %d of %d file%s skipped"
+                           'dired-async-failures
+                           (car operation) (length skipped) total
+                           (dired-plural-s total))))
+           ;; Finally send the success message.
+           (funcall dired-async-message-function
+                    "Asynchronous %s of %s file(s) on %s file(s) done"
+                    'dired-async-message
+                    (car operation) (cadr operation) total))))))
 
-FN-LIST is the list of files to copy (full absolute file names).
+(defun dired-async-maybe-kill-ftp ()
+  "Return a form to kill ftp process in child emacs."
+  (quote
+   (progn
+     (require 'cl-lib)
+     (let ((buf (cl-loop for b in (buffer-list)
+                         thereis (and (string-match
+                                       "\\`\\*ftp.*"
+                                       (buffer-name b)) b))))
+       (when buf (kill-buffer buf))))))
 
-NAME-CONSTRUCTOR should be a function accepting a single
-argument, the name of an old file, and returning either the
-corresponding new file name or nil to skip.
+(defvar overwrite-query)
+(defun dired-async-create-files (file-creator operation fn-list name-constructor
+                                 &optional _marker-char)
+  "Same as `dired-create-files' but asynchronous.
 
-Optional MARKER-CHAR is a character with which to mark every
-newfile's entry, or t to use the current marker character if the
-old file was marked."
-  (let (dired-create-files-failures
-        failures skipped (success-count 0) (total (length fn-list)))
-    (let (to overwrite-query
-             overwrite-backup-query)	; for dired-handle-overwrite
+See `dired-create-files' for the behavior of arguments."
+  (setq overwrite-query nil)
+  (let ((total (length fn-list))
+        failures async-fn-list skipped callback)
+    (let (to)
       (dolist (from fn-list)
         (setq to (funcall name-constructor from))
         (if (equal to from)
@@ -276,131 +184,138 @@ old file was marked."
                          (downcase operation) from)))
         (if (not to)
             (setq skipped (cons (dired-make-relative from) skipped))
-          (let* ((overwrite (file-exists-p to))
-                 (dired-overwrite-confirmed ; for dired-handle-overwrite
-                  (and overwrite
-                       (let ((help-form '(format "\
+            (let* ((overwrite (and (null (eq file-creator 'backup-file))
+                                   (file-exists-p to)))
+                   (dired-overwrite-confirmed ; for dired-handle-overwrite
+                    (and overwrite
+                         (let ((help-form `(format "\
 Type SPC or `y' to overwrite file `%s',
 DEL or `n' to skip to next,
 ESC or `q' to not overwrite any of the remaining files,
-`!' to overwrite all remaining files with no more questions." to)))
-                         (dired-query 'overwrite-query
-                                      "Overwrite `%s'?" to))))
-                 ;; must determine if FROM is marked before file-creator
-                 ;; gets a chance to delete it (in case of a move).
-                 (actual-marker-char
-                  (cond  ((integerp marker-char) marker-char)
-                         (marker-char (dired-file-marker from)) ; slow
-                         (t nil))))
-            ;; Handle the `dired-copy-file' file-creator specially
-            ;; When copying a directory to another directory or
-            ;; possibly to itself or one of its subdirectories.
-            ;; e.g "~/foo/" => "~/test/"
-            ;; or "~/foo/" =>"~/foo/"
-            ;; or "~/foo/ => ~/foo/bar/")
-            ;; In this case the 'name-constructor' have set the destination
-            ;; TO to "~/test/foo" because the old emacs23 behavior
-            ;; of `copy-directory' was to not create the subdirectory
-            ;; and instead copy the contents.
-            ;; With the new behavior of `copy-directory'
-            ;; (similar to the `cp' shell command) we don't
-            ;; need such a construction of the target directory,
-            ;; so modify the destination TO to "~/test/" instead of
-            ;; "~/test/foo/".
-            (let ((destname (file-name-directory to)))
-              (when (and (file-directory-p from)
-                         (file-directory-p to)
-                         (eq file-creator 'dired-copy-file))
-                (setq to destname))
-              ;; If DESTNAME is a subdirectory of FROM, not a symlink,
-              ;; and the method in use is copying, signal an error.
-              (and (eq t (car (file-attributes destname)))
-                   (eq file-creator 'dired-copy-file)
-                   (file-in-directory-p destname from)
-                   (error "Cannot copy `%s' into its subdirectory `%s'"
-                          from to)))
-            (condition-case err
-                (funcall file-creator from to dired-overwrite-confirmed)
-              (file-error		; FILE-CREATOR aborted
-               (progn
-                 (push (dired-make-relative from)
-                       failures)
-                 (dired-log "%s `%s' to `%s' failed:\n%s\n"
-                            operation from to err))))))))
-    (cond
-     (dired-create-files-failures
-      (setq failures (nconc failures dired-create-files-failures))
-      (dired-log-summary
-       (format "%s failed for %d file%s in %d requests"
-               operation (length failures)
-               (dired-plural-s (length failures))
-               total)
-       failures))
-     (failures
-      (dired-log-summary
-       (format "%s failed for %d of %d file%s"
-               operation (length failures)
-               total (dired-plural-s total))
-       failures))
-     (skipped
-      (dired-log-summary
-       (format "%s: %d of %d file%s skipped"
-               operation (length skipped) total
-               (dired-plural-s total))
-       skipped))
-     (t
-      (message "%s proceeding asynchronously..." operation)))))
+`!' to overwrite all remaining files with no more questions." ,to)))
+                           (dired-query 'overwrite-query "Overwrite `%s'?" to)))))
+              ;; Handle the `dired-copy-file' file-creator specially
+              ;; When copying a directory to another directory or
+              ;; possibly to itself or one of its subdirectories.
+              ;; e.g "~/foo/" => "~/test/"
+              ;; or "~/foo/" =>"~/foo/"
+              ;; or "~/foo/ => ~/foo/bar/")
+              ;; In this case the 'name-constructor' have set the destination
+              ;; TO to "~/test/foo" because the old emacs23 behavior
+              ;; of `copy-directory' was to not create the subdirectory
+              ;; and instead copy the contents.
+              ;; With the new behavior of `copy-directory'
+              ;; (similar to the `cp' shell command) we don't
+              ;; need such a construction of the target directory,
+              ;; so modify the destination TO to "~/test/" instead of "~/test/foo/".
+              (let ((destname (file-name-directory to)))
+                (when (and (file-directory-p from)
+                           (file-directory-p to)
+                           (eq file-creator 'dired-copy-file))
+                  (setq to destname))
+                ;; If DESTNAME is a subdirectory of FROM, not a symlink,
+                ;; and the method in use is copying, signal an error.
+                (and (eq t (car (file-attributes destname)))
+                     (eq file-creator 'dired-copy-file)
+                     (file-in-directory-p destname from)
+                     (error "Cannot copy `%s' into its subdirectory `%s'"
+                            from to)))
+              (if overwrite
+                  (or (and dired-overwrite-confirmed
+                           (push (cons from to) async-fn-list))
+                      (progn
+                        (push (dired-make-relative from) failures)
+                        (dired-log "%s `%s' to `%s' failed\n"
+                                   operation from to)))
+                  (push (cons from to) async-fn-list)))))
+      ;; When async-fn-list is empty that's mean only one file
+      ;; had to be copied and user finally answer NO.
+      ;; In this case async process will never start and callback
+      ;; will have no chance to run, so notify failures here.
+      (unless async-fn-list
+        (cond (failures
+               (funcall dired-async-message-function
+                        "%s failed for %d of %d file%s"
+                        'dired-async-failures
+                        operation (length failures)
+                        total (dired-plural-s total)))
+              (skipped
+               (funcall dired-async-message-function
+                        "%s: %d of %d file%s skipped"
+                        'dired-async-failures
+                        operation (length skipped) total
+                        (dired-plural-s total)))))
+      ;; Setup callback.
+      (setq callback
+            (lambda (&optional _ignore)
+               (dired-async-after-file-create
+                total (list operation (length async-fn-list)) failures skipped)
+               (when (string= (downcase operation) "rename")
+                 (cl-loop for (file . to) in async-fn-list
+                          for bf = (get-file-buffer file)
+                          do (and bf (with-current-buffer bf
+                                       (set-visited-file-name to nil t))))))))
+    ;; Start async process.
+    (when async-fn-list
+      (async-start `(lambda ()
+                      (require 'cl-lib) (require 'dired-aux) (require 'dired-x)
+                      ,(async-inject-variables dired-async-env-variables-regexp)
+                      (condition-case err
+                          (let ((dired-recursive-copies (quote always))
+                                (dired-copy-preserve-time
+                                 ,dired-copy-preserve-time))
+                            (setq overwrite-backup-query nil)
+                            ;; Inline `backup-file' as long as it is not
+                            ;; available in emacs.
+                            (defalias 'backup-file
+                                ;; Same feature as "cp --backup=numbered from to"
+                                ;; Symlinks are copied as file from source unlike
+                                ;; `dired-copy-file' which is same as cp -d.
+                                ;; Directories are omitted.
+                                (lambda (from to ok)
+                                  (cond ((file-directory-p from) (ignore))
+                                        (t (let ((count 0))
+                                             (while (let ((attrs (file-attributes to)))
+                                                      (and attrs (null (nth 0 attrs))))
+                                               (cl-incf count)
+                                               (setq to (concat (file-name-sans-versions to)
+                                                                (format ".~%s~" count)))))
+                                           (condition-case err
+                                               (copy-file from to ok dired-copy-preserve-time)
+                                             (file-date-error
+                                              (push (dired-make-relative from)
+                                                    dired-create-files-failures)
+                                              (dired-log "Can't set date on %s:\n%s\n" from err)))))))
+                            ;; Now run the FILE-CREATOR function on files.
+                            (cl-loop with fn = (quote ,file-creator)
+                                     for (from . dest) in (quote ,async-fn-list)
+                                     do (funcall fn from dest t)))
+                        (file-error
+                         (with-temp-file ,dired-async-log-file
+                           (insert (format "%S" err)))))
+                      ,(dired-async-maybe-kill-ftp))
+                   callback)
+      ;; Run mode-line notifications while process running.
+      (dired-async--modeline-mode 1)
+      (message "%s proceeding asynchronously..." operation))))
+
+(defadvice dired-create-files (around dired-async)
+  (dired-async-create-files file-creator operation fn-list
+                            name-constructor marker-char))
+
+;;;###autoload
+(define-minor-mode dired-async-mode
+    "Do dired actions asynchronously."
+  :group 'dired-async
+  :global t
+  (if dired-async-mode
+      (if (fboundp 'advice-add)
+          (advice-add 'dired-create-files :override #'dired-async-create-files)
+          (ad-activate 'dired-create-files))
+      (if (fboundp 'advice-remove)
+          (advice-remove 'dired-create-files #'dired-async-create-files)
+          (ad-deactivate 'dired-create-files))))
 
-(defun dired-internal-do-deletions (l arg &optional trash)
-  ;; L is an alist of files to delete, with their buffer positions.
-  ;; ARG is the prefix arg.
-  ;; Filenames are absolute.
-  ;; (car L) *must* be the *last* (bottommost) file in the dired buffer.
-  ;; That way as changes are made in the buffer they do not shift the
-  ;; lines still to be changed, so the (point) values in L stay valid.
-  ;; Also, for subdirs in natural order, a subdir's files are deleted
-  ;; before the subdir itself - the other way around would not work.
-  (let* ((files (mapcar (function car) l))
-         (count (length l))
-         (succ 0)
-         (trashing (and trash delete-by-moving-to-trash))
-         (progress-reporter
-          (make-progress-reporter
-           (if trashing "Trashing..." "Deleting...")
-           succ count)))
-    ;; canonicalize file list for pop up
-    (setq files (nreverse (mapcar (function dired-make-relative) files)))
-    (if (dired-mark-pop-up
-         " *Deletions*" 'delete files dired-deletion-confirmer
-         (format "%s %s "
-                 (if trashing "Trash" "Delete")
-                 (dired-mark-prompt arg files)))
-        (save-excursion
-          (let (failures);; files better be in reverse order for this loop!
-            (while l
-              (goto-char (cdr (car l)))
-              (let ((inhibit-read-only t))
-                (condition-case err
-                    (let ((fn (car (car l))))
-                      (dired-delete-file fn dired-recursive-deletes trash)
-                      ;; if we get here, removing worked
-                      (setq succ (1+ succ))
-                      (progress-reporter-update progress-reporter succ)
-                      (dired-fun-in-all-buffers
-                       (file-name-directory fn) (file-name-nondirectory fn)
-                       (function dired-delete-entry) fn))
-                  (error;; catch errors from failed deletions
-                   (dired-log "%s\n" err)
-                   (setq failures (cons (car (car l)) failures)))))
-              (setq l (cdr l)))
-            (if (not failures)
-                (progress-reporter-done progress-reporter)
-              (dired-log-summary
-               (format "%d of %d deletion%s failed"
-                       (length failures) count
-                       (dired-plural-s count))
-               failures))))
-      (message "(No deletions performed)"))))
 
 (provide 'dired-async)