;;; 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>
;;; Commentary:
;; This file provide a redefinition of `dired-create-file' function,
-;; which must be loaded *after* dired-aux.el, 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.
+;; 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:
-;;
-;; (eval-after-load "dired-aux"
-;; '(require 'dired-async))
-;;
-;;
+
+;; (dired-async-mode 1)
+
+;; This will enable async copy/rename etc...
+;; in dired and helm.
;;; Code:
\f
:group 'dired-async
:type 'string)
-(defcustom dired-async-be-async t
- "When non--nil make `dired-create-file' async.
-This allow to turn off async features provided to this package."
- :group 'dired-async
- :type 'boolean)
-
(defface dired-async-message
'((t (:foreground "yellow")))
"Face used for mode-line message."
:group 'dired-async)
(defface dired-async-mode-message
- '((t (:background "Firebrick1")))
- "Face used for `dired-async-modeline-mode' lighter."
+ '((t (:foreground "Gold")))
+ "Face used for `dired-async--modeline-mode' lighter."
:group 'dired-async)
-(define-minor-mode dired-async-modeline-mode
+(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
+ (unless dired-async--modeline-mode
(let ((visible-bell t)) (ding))))
(defun dired-async-mode-line-message (text &rest args)
(proc (car (last processes))))
(delete-process proc)
(unless (> (length processes) 1)
- (dired-async-modeline-mode -1))))
+ (dired-async--modeline-mode -1))))
(defun dired-async-after-file-create (len-flist)
"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))
+ (dired-async--modeline-mode -1))
(when dired-async-operation
(if (file-exists-p dired-async-log-file)
(progn
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))
- (callback `(lambda (&optional ignore)
- (dired-async-after-file-create ,(length fn-list)))))
+ (let (dired-create-files-failures
+ failures async-fn-list
+ skipped (success-count 0)
+ (total (length fn-list))
+ callback)
(let (to overwrite-query
overwrite-backup-query) ; for dired-handle-overwrite
(dolist (from fn-list)
(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 "\
(push (dired-make-relative from) failures)
(dired-log "%s `%s' to `%s' failed"
operation from to)))
- (push (cons from to) async-fn-list))))))
+ (push (cons from to) async-fn-list)))))
+ (setq callback
+ `(lambda (&optional ignore)
+ (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)
+ (set-visited-file-name to nil t))))))))
;; Handle error happening in host emacs.
(cond
(dired-create-files-failures
(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)))))
,(dired-async-maybe-kill-ftp))
callback)
;; Run mode-line notifications while process running.
- (dired-async-modeline-mode 1)
+ (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)
+ (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 'helm
+ :group 'dired-async
:global t
(if dired-async-mode
- (advice-add 'dired-create-files :override #'dired-async-create-files)
- (advice-remove 'dired-create-files #'dired-async-create-files)))
+ (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))))
(provide 'dired-async)