[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] master 753d593 148/187: Allow enabling dired-async with a minor-m
From: |
Michael Albinus |
Subject: |
[elpa] master 753d593 148/187: Allow enabling dired-async with a minor-mode. |
Date: |
Wed, 30 Dec 2015 11:50:18 +0000 |
branch: master
commit 753d59324248357f2c4afdafe51364bc04460f52
Author: Thierry Volpiatto <address@hidden>
Commit: Thierry Volpiatto <address@hidden>
Allow enabling dired-async with a minor-mode.
* dired-async.el (dired-async-be-async): Removed.
(dired-async-modeline-mode): Renamed from dired-async-mode.
(dired-async-create-files): The function that replace dired-create-files.
(dired-async-mode): New mode to enable dired-async.
---
dired-async.el | 201 ++++++++++++++++++++++++--------------------------------
1 files changed, 85 insertions(+), 116 deletions(-)
diff --git a/dired-async.el b/dired-async.el
index 59b1d98..3f7d4d4 100644
--- a/dired-async.el
+++ b/dired-async.el
@@ -81,17 +81,17 @@ This allow to turn off async features provided to this
package."
(defface dired-async-mode-message
'((t (:background "Firebrick1")))
- "Face used for `dired-async-mode' lighter."
+ "Face used for `dired-async-modeline-mode' lighter."
:group 'dired-async)
-(define-minor-mode dired-async-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-mode
+ (unless dired-async-modeline-mode
(let ((visible-bell t)) (ding))))
(defun dired-async-mode-line-message (text &rest args)
@@ -119,14 +119,14 @@ This allow to turn off async features provided to this
package."
(proc (car (last processes))))
(delete-process proc)
(unless (> (length processes) 1)
- (dired-async-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-mode -1))
+ (dired-async-modeline-mode -1))
(when dired-async-operation
(if (file-exists-p dired-async-log-file)
(progn
@@ -151,37 +151,18 @@ This allow to turn off async features provided to this
package."
(buffer-name b)) b))))
(when buf (kill-buffer buf))))))
-(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.
-
-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'.
-
-OPERATION should be a capitalized string describing the operation
-performed (e.g. `Copy'). It is used for error logging.
-
-FN-LIST is the list of files to copy (full absolute file names).
+(defun dired-async-create-files (file-creator operation fn-list
name-constructor
+ &optional marker-char)
+ "Same as `dired-create-files' but asynchronous.
-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.
-
-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."
+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)))))
+ skipped (success-count 0) (total (length
fn-list))
+ (callback `(lambda (&optional ignore)
+
(dired-async-after-file-create ,(length fn-list)))))
(let (to overwrite-query
- overwrite-backup-query) ; for dired-handle-overwrite
+ overwrite-backup-query) ; for dired-handle-overwrite
(dolist (from fn-list)
(setq to (funcall name-constructor from))
(if (equal to from)
@@ -191,100 +172,82 @@ 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 (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)))
- (if dired-async-be-async
- (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"
- operation from to)))
- (push (cons from to) async-fn-list))
- (condition-case err
- (progn
- (funcall file-creator from to dired-overwrite-confirmed)
- (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))
- (setq success-count (1+ success-count))
- (message "%s: %d of %d" operation success-count total)
- (dired-add-file to actual-marker-char))
- (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)))))))))
+ (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)))
+ (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"
+ operation from to)))
+ (push (cons from to) async-fn-list))))))
;; Handle error happening in host emacs.
(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"
+ (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"
+ 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"
+ 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: %s file%s"
- operation success-count (dired-plural-s success-count))))
+ skipped))
+ (t (message "%s: %s file%s"
+ operation success-count (dired-plural-s success-count))))
;; Start async process.
- (when (and async-fn-list dired-async-be-async)
+ (when async-fn-list
(async-start `(lambda ()
(require 'cl-lib) (require 'dired-aux) (require 'dired-x)
,(async-inject-variables
dired-async-env-variables-regexp)
@@ -298,11 +261,17 @@ ESC or `q' to not overwrite any of the remaining files,
,(dired-async-maybe-kill-ftp))
callback)
;; Run mode-line notifications while process running.
- (dired-async-mode 1)
+ (dired-async-modeline-mode 1)
(setq dired-async-operation (list operation (length async-fn-list)))
- (message "%s proceeding asynchronously..." operation)))
- (unless dired-async-be-async
- (dired-move-to-filename)))
+ (message "%s proceeding asynchronously..." operation))))
+
+(define-minor-mode dired-async-mode
+ "Do dired actions asynchronously."
+ :group 'helm
+ :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)))
(provide 'dired-async)
- [elpa] master 98ef20d 162/187: Change mode-line face., (continued)
- [elpa] master 98ef20d 162/187: Change mode-line face., Michael Albinus, 2015/12/30
- [elpa] master 2143217 159/187: Bind print-level and print-length (#48)., Michael Albinus, 2015/12/30
- [elpa] master 89f1ca6 133/187: Merge pull request #42 from mneilsen/master, Michael Albinus, 2015/12/30
- [elpa] master 1f5e89b 146/187: * async-bytecomp.el (package--compile): Fix typo., Michael Albinus, 2015/12/30
- [elpa] master 7625671 140/187: Async compile also dependendies (#46)., Michael Albinus, 2015/12/30
- [elpa] master d250e7b 139/187: Allow customizing which packages compile async (#46)., Michael Albinus, 2015/12/30
- [elpa] master 51c598b 149/187: Add autoload cookie and make dired-async--modeline-mode internal., Michael Albinus, 2015/12/30
- [elpa] master 23edf9e 151/187: * dired-async.el (dired-async-mode): Fix group name., Michael Albinus, 2015/12/30
- [elpa] master c368125 155/187: * async-bytecomp.el: Add autoload cookies., Michael Albinus, 2015/12/30
- [elpa] master bedfa96 152/187: * dired-async.el: Fix compatibility with emacs-24.3., Michael Albinus, 2015/12/30
- [elpa] master 753d593 148/187: Allow enabling dired-async with a minor-mode.,
Michael Albinus <=
- [elpa] master cdbf622 157/187: No message on startup when quiet., Michael Albinus, 2015/12/30
- [elpa] master 4ab15f7 161/187: Merge pull request #50 from tarsius/master, Michael Albinus, 2015/12/30
- [elpa] master a97aa4c 166/187: Don't call package-activate-1 in package--compile., Michael Albinus, 2015/12/30
- [elpa] master 7616e0c 165/187: Check if pkg is member of package-archive-contents (#51)., Michael Albinus, 2015/12/30
- [elpa] master ee727e1 168/187: Add async to load-path when recompiling itself., Michael Albinus, 2015/12/30
- [elpa] master 40814ea 173/187: Correct package headers, Michael Albinus, 2015/12/30
- [elpa] master 3499a32 176/187: Only rename buffers on rename operation (#56)., Michael Albinus, 2015/12/30
- [elpa] master d98799c 172/187: Add epg to inject variables in smtpmail (#54)., Michael Albinus, 2015/12/30
- [elpa] master 062c609 158/187: Add more helm packages to compile async., Michael Albinus, 2015/12/30
- [elpa] master cbd8d9a 164/187: Update version number., Michael Albinus, 2015/12/30