(eval-when-compile
(defvar async-callback))
-(defvar dired-async-operation nil)
(defgroup dired-async nil
"Copy rename files asynchronously from dired."
"Face used for mode-line message."
:group 'dired-async)
+(defface dired-async-failures
+ '((t (:foreground "red")))
+ "Face used for mode-line message."
+ :group 'dired-async)
+
(defface dired-async-mode-message
'((t (:foreground "Gold")))
"Face used for `dired-async--modeline-mode' lighter."
(unless dired-async--modeline-mode
(let ((visible-bell t)) (ding))))
-(defun dired-async-mode-line-message (text &rest args)
+(defun dired-async-mode-line-message (text face &rest args)
"Notify end of operation in `mode-line'."
(message nil)
(let ((mode-line-format (concat
(if args
(apply #'format text args)
text)
- 'face 'dired-async-message))))
+ 'face face))))
(force-mode-line-update)
(sit-for 3)
(force-mode-line-update)))
(unless (> (length processes) 1)
(dired-async--modeline-mode -1))))
-(defun dired-async-after-file-create (len-flist)
+(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 dired-async-operation
+ (when operation
(if (file-exists-p dired-async-log-file)
(progn
(pop-to-buffer (get-buffer-create "*dired async*"))
(delete-file dired-async-log-file))
(run-with-timer
0.1 nil
- dired-async-message-function "Asynchronous %s of %s file(s) on %s file(s) done"
- (car dired-async-operation) (cadr dired-async-operation) len-flist))))
+ (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))))))
(defun dired-async-maybe-kill-ftp ()
"Return a form to kill ftp process in child emacs."
"Same as `dired-create-files' but asynchronous.
See `dired-create-files' for the behavior of arguments."
- (setq dired-async-operation nil)
(setq overwrite-query nil)
(let ((total (length fn-list))
failures async-fn-list skipped callback)
(file-exists-p to)))
(dired-overwrite-confirmed ; for dired-handle-overwrite
(and overwrite
- (let ((help-form '(format "\
+ (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)))
+`!' 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
(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)
- (dired-async-after-file-create total)
+ (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))))))))
- ;; Handle error happening in host emacs.
- (cond (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)))
;; Start async process.
(when async-fn-list
(async-start `(lambda ()
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)