Ensure dired-copy-preserve-time is passed to child with its current value.

[gnu-emacs-elpa] / dired-async.el

diff --git a/dired-async.el b/dired-async.el
index 01d1a8fa8addbc5be6160566565c123b930080d0..41f2b795562e301917e186870371462d75808fb7 100644 (file)
--- a/dired-async.el
+++ b/dired-async.el
@@ -1,7 +1,6 @@
 ;;; dired-async.el --- Copy/move/delete asynchronously in dired.
 
-;; Copyright (C) 2012~2014 John Wiegley
-;; Copyright (C) 2012~2014 Thierry Volpiatto
+;; Copyright (C) 2012-2016 Free Software Foundation, Inc.
 
 ;; Authors: John Wiegley <jwiegley@gmail.com>
 ;;          Thierry Volpiatto <thierry.volpiatto@gmail.com>
@@ -153,7 +152,8 @@ See `dired-create-files' for the behavior of arguments."
   (setq dired-async-operation nil)
   (let (dired-create-files-failures
         failures async-fn-list
-        skipped (success-count 0) (total (length fn-list))
+        skipped (success-count 0)
+        (total (length fn-list))
         callback)
     (let (to overwrite-query
              overwrite-backup-query)    ; for dired-handle-overwrite
@@ -166,7 +166,8 @@ See `dired-create-files' for the behavior of arguments."
                          (downcase operation) from)))
         (if (not to)
             (setq skipped (cons (dired-make-relative from) skipped))
-            (let* ((overwrite (file-exists-p to))
+            (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 "\
@@ -218,8 +219,8 @@ ESC or `q' to not overwrite any of the remaining files,
                   (push (cons from to) async-fn-list)))))
       (setq callback
             `(lambda (&optional ignore)
-               (dired-async-after-file-create ,(length fn-list))
-               (when (string= ,operation "rename")
+               (dired-async-after-file-create ,total)
+               (when (string= ,(downcase operation) "rename")
                  (cl-loop for (file . to) in ',async-fn-list
                           do (and (get-file-buffer file)
                                   (with-current-buffer (get-file-buffer file)
@@ -254,9 +255,34 @@ ESC or `q' to not overwrite any of the remaining files,
                       (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)))
-                            (cl-loop for (f . d) in (quote ,async-fn-list)
-                                     do (funcall (quote ,file-creator) f d t)))
+                          (let ((dired-recursive-copies (quote always))
+                                (dired-copy-preserve-time
+                                 ,dired-copy-preserve-time))
+                            ;; 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)))))