(eval-when-compile
(defvar async-callback))
-;; (defvar dired-async-operation nil)
(defgroup dired-async nil
"Copy rename files asynchronously from dired."
(when operation
(if (file-exists-p dired-async-log-file)
(progn
- (pop-to-buffer (get-buffer-create "*dired async*"))
- (erase-buffer)
+ (pop-to-buffer (get-buffer-create dired-log-buffer))
+ (goto-char (point-max))
+ (setq inhibit-read-only t)
(insert "Error: ")
(insert-file-contents dired-async-log-file)
+ (special-mode)
+ (shrink-window-if-larger-than-buffer)
(delete-file dired-async-log-file))
(run-with-timer
0.1 nil
(funcall dired-async-message-function
"%s failed for %d of %d file%s"
'dired-async-failures
- operation (length 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
- operation (length skipped) total
+ (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"
+ "Asynchronous %s of %s on %s file%s done"
'dired-async-message
- (car operation) (cadr operation) total))))))
+ (car operation) (cadr operation)
+ total (dired-plural-s total)))))))
(defun dired-async-maybe-kill-ftp ()
"Return a form to kill ftp process in child emacs."
(push (cons from to) async-fn-list))
(progn
(push (dired-make-relative from) failures)
- (dired-log "%s `%s' to `%s' failed"
+ (dired-log "%s `%s' to `%s' failed\n"
operation from to)))
(push (cons from to) async-fn-list)))))
+ ;; When failures have been printed to dired log add the date at bob.
+ (when (or failures skipped) (dired-log t))
+ ;; 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)
(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))))))))
+ for destp = (file-exists-p to)
+ do (and bf destp
+ (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))
(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)))))
+ do (condition-case err
+ (funcall fn from dest t)
+ (file-error
+ (dired-log "%s: %s\n" (car err) (cdr err)))
+ nil))
+ (when (get-buffer dired-log-buffer)
+ (dired-log t)
+ (with-current-buffer dired-log-buffer
+ (write-region (point-min) (point-max)
+ ,dired-async-log-file))))
,(dired-async-maybe-kill-ftp))
callback)
;; Run mode-line notifications while process running.
(dired-async--modeline-mode 1)
- ;; (setq dired-async-operation (list operation (length async-fn-list)))
(message "%s proceeding asynchronously..." operation))))
(defadvice dired-create-files (around dired-async)