From 8b0ec5b5953cfac8c29e5ed463e044854a42beb1 Mon Sep 17 00:00:00 2001 From: Andreas Gerler Date: Wed, 15 Jul 2015 08:10:23 +0200 Subject: [PATCH] new version of async. --- bba.org | 2 +- elpa/async-20150412.2207/async-pkg.el | 4 - .../async-autoloads.el | 54 ++++- .../async-bytecomp.el | 15 +- elpa/async-20150529.529/async-pkg.el | 4 + .../async.el | 0 .../dired-async.el | 216 ++++++++---------- .../smtpmail-async.el | 0 8 files changed, 163 insertions(+), 132 deletions(-) delete mode 100644 elpa/async-20150412.2207/async-pkg.el rename elpa/{async-20150412.2207 => async-20150529.529}/async-autoloads.el (58%) rename elpa/{async-20150412.2207 => async-20150529.529}/async-bytecomp.el (92%) create mode 100644 elpa/async-20150529.529/async-pkg.el rename elpa/{async-20150412.2207 => async-20150529.529}/async.el (100%) rename elpa/{async-20150412.2207 => async-20150529.529}/dired-async.el (53%) rename elpa/{async-20150412.2207 => async-20150529.529}/smtpmail-async.el (100%) diff --git a/bba.org b/bba.org index cdbb877d..a9033a9b 100644 --- a/bba.org +++ b/bba.org @@ -100,7 +100,7 @@ Keep track of your important stuff! #+BEGIN_SRC emacs-lisp (if (>= emacs-major-version 25) (progn - (add-to-list 'load-path "~/.emacs.d/elpa/async-20150412.2207") + (add-to-list 'load-path "~/.emacs.d/elpa/async-20150529.529") (require 'async) ) ) diff --git a/elpa/async-20150412.2207/async-pkg.el b/elpa/async-20150412.2207/async-pkg.el deleted file mode 100644 index 7d1eb8b1..00000000 --- a/elpa/async-20150412.2207/async-pkg.el +++ /dev/null @@ -1,4 +0,0 @@ -(define-package "async" "20150412.2207" "Asynchronous processing in Emacs" 'nil) -;; Local Variables: -;; no-byte-compile: t -;; End: diff --git a/elpa/async-20150412.2207/async-autoloads.el b/elpa/async-20150529.529/async-autoloads.el similarity index 58% rename from elpa/async-20150412.2207/async-autoloads.el rename to elpa/async-20150529.529/async-autoloads.el index ef6d2102..683bece4 100644 --- a/elpa/async-20150412.2207/async-autoloads.el +++ b/elpa/async-20150529.529/async-autoloads.el @@ -3,7 +3,7 @@ ;;; Code: (add-to-list 'load-path (or (file-name-directory #$) (car load-path))) -;;;### (autoloads nil "async" "async.el" (21822 1126 0 0)) +;;;### (autoloads nil "async" "async.el" (21908 14300 0 0)) ;;; Generated autoloads from async.el (autoload 'async-start-process "async" "\ @@ -68,8 +68,56 @@ returns nil. It can still be useful, however, as an argument to ;;;*** -;;;### (autoloads nil nil ("async-bytecomp.el" "async-pkg.el" "dired-async.el" -;;;;;; "smtpmail-async.el") (21822 3160 168227 0)) +;;;### (autoloads nil "async-bytecomp" "async-bytecomp.el" (21908 +;;;;;; 14300 0 0)) +;;; Generated autoloads from async-bytecomp.el + +(autoload 'async-byte-recompile-directory "async-bytecomp" "\ +Compile all *.el files in DIRECTORY asynchronously. +All *.elc files are systematically deleted before proceeding. + +\(fn DIRECTORY &optional QUIET)" nil nil) + +(defvar async-bytecomp-package-mode nil "\ +Non-nil if Async-Bytecomp-Package mode is enabled. +See the command `async-bytecomp-package-mode' for a description of this minor mode. +Setting this variable directly does not take effect; +either customize it (see the info node `Easy Customization') +or call the function `async-bytecomp-package-mode'.") + +(custom-autoload 'async-bytecomp-package-mode "async-bytecomp" nil) + +(autoload 'async-bytecomp-package-mode "async-bytecomp" "\ +Byte compile asynchronously packages installed with package.el. +Async compilation of packages can be controlled by +`async-bytecomp-allowed-packages'. + +\(fn &optional ARG)" t nil) + +;;;*** + +;;;### (autoloads nil "dired-async" "dired-async.el" (21908 14300 +;;;;;; 0 0)) +;;; Generated autoloads from dired-async.el + +(defvar dired-async-mode nil "\ +Non-nil if Dired-Async mode is enabled. +See the command `dired-async-mode' for a description of this minor mode. +Setting this variable directly does not take effect; +either customize it (see the info node `Easy Customization') +or call the function `dired-async-mode'.") + +(custom-autoload 'dired-async-mode "dired-async" nil) + +(autoload 'dired-async-mode "dired-async" "\ +Do dired actions asynchronously. + +\(fn &optional ARG)" t nil) + +;;;*** + +;;;### (autoloads nil nil ("async-pkg.el" "smtpmail-async.el") (21908 +;;;;;; 14300 316611 0)) ;;;*** diff --git a/elpa/async-20150412.2207/async-bytecomp.el b/elpa/async-20150529.529/async-bytecomp.el similarity index 92% rename from elpa/async-20150412.2207/async-bytecomp.el rename to elpa/async-20150529.529/async-bytecomp.el index 047e6057..00043472 100644 --- a/elpa/async-20150412.2207/async-bytecomp.el +++ b/elpa/async-20150529.529/async-bytecomp.el @@ -53,6 +53,7 @@ the symbol `all', in this case packages are always compiled asynchronously." (defvar async-byte-compile-log-file "~/.emacs.d/async-bytecomp.log") +;;;###autoload (defun async-byte-recompile-directory (directory &optional quiet) "Compile all *.el files in DIRECTORY asynchronously. All *.elc files are systematically deleted before proceeding." @@ -101,7 +102,7 @@ All *.elc files are systematically deleted before proceeding." (erase-buffer) (insert error-data)))))) call-back) - (message "Started compiling asynchronously directory %s" directory))) + (unless quiet (message "Started compiling asynchronously directory %s" directory)))) (defvar package-archive-contents) (declare-function package-desc-reqs "package.el" (cl-x)) @@ -131,7 +132,7 @@ All *.elc files are systematically deleted before proceeding." (delete-dups (append async-bytecomp-allowed-packages reqs))))) -(defadvice package--compile (around byte-compile-async activate) +(defadvice package--compile (around byte-compile-async) (let ((cur-package (package-desc-name pkg-desc))) (if (or (equal async-bytecomp-allowed-packages '(all)) (memq cur-package (async-bytecomp-get-allowed-pkgs))) @@ -143,6 +144,16 @@ All *.elc files are systematically deleted before proceeding." (async-byte-recompile-directory (package-desc-dir pkg-desc) t)) ad-do-it))) +;;;###autoload +(define-minor-mode async-bytecomp-package-mode + "Byte compile asynchronously packages installed with package.el. +Async compilation of packages can be controlled by +`async-bytecomp-allowed-packages'." + :group 'async + :global t + (if async-bytecomp-package-mode + (ad-activate 'package--compile) + (ad-deactivate 'package--compile))) (provide 'async-bytecomp) diff --git a/elpa/async-20150529.529/async-pkg.el b/elpa/async-20150529.529/async-pkg.el new file mode 100644 index 00000000..da89a153 --- /dev/null +++ b/elpa/async-20150529.529/async-pkg.el @@ -0,0 +1,4 @@ +(define-package "async" "20150529.529" "Asynchronous processing in Emacs" 'nil) +;; Local Variables: +;; no-byte-compile: t +;; End: diff --git a/elpa/async-20150412.2207/async.el b/elpa/async-20150529.529/async.el similarity index 100% rename from elpa/async-20150412.2207/async.el rename to elpa/async-20150529.529/async.el diff --git a/elpa/async-20150412.2207/dired-async.el b/elpa/async-20150529.529/dired-async.el similarity index 53% rename from elpa/async-20150412.2207/dired-async.el rename to elpa/async-20150529.529/dired-async.el index 59b1d986..d37c5cb1 100644 --- a/elpa/async-20150412.2207/dired-async.el +++ b/elpa/async-20150529.529/dired-async.el @@ -68,12 +68,6 @@ Should take same args as `message'." :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." @@ -81,17 +75,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 +113,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 +145,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 +166,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 +255,26 @@ 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)))) + +(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 'dired-async + :global t + (if dired-async-mode + (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) diff --git a/elpa/async-20150412.2207/smtpmail-async.el b/elpa/async-20150529.529/smtpmail-async.el similarity index 100% rename from elpa/async-20150412.2207/smtpmail-async.el rename to elpa/async-20150529.529/smtpmail-async.el -- 2.47.3