emacs-elpa-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[elpa] master 527c590 38/39: Merge commit '0e327f72bdffc5bc4a1fbc34a8da1


From: Thierry Volpiatto
Subject: [elpa] master 527c590 38/39: Merge commit '0e327f72bdffc5bc4a1fbc34a8da1b7066e819b3'
Date: Wed, 18 May 2016 18:02:55 +0000 (UTC)

branch: master
commit 527c590e8dcbddb0d04c0a1d7e530e5ef76acf6d
Merge: 6ad010c 0e327f7
Author: Thierry Volpiatto <address@hidden>
Commit: Thierry Volpiatto <address@hidden>

    Merge commit '0e327f72bdffc5bc4a1fbc34a8da1b7066e819b3'
---
 packages/async/README.md         |    4 +
 packages/async/async-bytecomp.el |   44 ++++-----
 packages/async/async-pkg.el      |    2 +
 packages/async/async.el          |   12 +--
 packages/async/dired-async.el    |  183 +++++++++++++++++++++++---------------
 packages/async/smtpmail-async.el |    6 +-
 6 files changed, 150 insertions(+), 101 deletions(-)

diff --git a/packages/async/README.md b/packages/async/README.md
index a5b0866..e19fb5a 100644
--- a/packages/async/README.md
+++ b/packages/async/README.md
@@ -25,6 +25,10 @@ you can disable this by running the copy, rename etc... 
commands with a prefix a
 
 If you don't want to make dired/helm asynchronous disable it with 
`dired-async-mode`.
 
+### Debian and Ubuntu
+
+Users of Debian 9 or later or Ubuntu 16.04 or later may simply `apt-get 
install elpa-async`.
+
 ## Enable asynchronous compilation of your (M)elpa packages
 
 By default emacs package.el compile packages in its running emacs session.
diff --git a/packages/async/async-bytecomp.el b/packages/async/async-bytecomp.el
index 54313c0..2c96da0 100644
--- a/packages/async/async-bytecomp.el
+++ b/packages/async/async-bytecomp.el
@@ -1,4 +1,4 @@
-;;; async-bytecomp.el --- Async functions to compile elisp files async
+;;; async-bytecomp.el --- Compile elisp files asynchronously -*- 
lexical-binding: t -*-
 
 ;; Copyright (C) 2014-2016 Free Software Foundation, Inc.
 
@@ -65,27 +65,27 @@ All *.elc files are systematically deleted before 
proceeding."
   ;; This happen when recompiling its own directory.
   (load "async")
   (let ((call-back
-         `(lambda (&optional ignore)
-            (if (file-exists-p async-byte-compile-log-file)
-                (let ((buf (get-buffer-create byte-compile-log-buffer))
-                      (n 0))
-                  (with-current-buffer buf
-                    (goto-char (point-max))
-                    (let ((inhibit-read-only t))
-                      (insert-file-contents async-byte-compile-log-file)
-                      (compilation-mode))
-                    (display-buffer buf)
-                    (delete-file async-byte-compile-log-file)
-                    (unless ,quiet
-                      (save-excursion
-                        (goto-char (point-min))
-                        (while (re-search-forward "^.*:Error:" nil t)
-                          (cl-incf n)))
-                      (if (> n 0)
-                          (message "Failed to compile %d files in directory 
`%s'" n ,directory)
-                          (message "Directory `%s' compiled asynchronously 
with warnings" ,directory)))))
-                (unless ,quiet
-                  (message "Directory `%s' compiled asynchronously with 
success" ,directory))))))
+         (lambda (&optional _ignore)
+           (if (file-exists-p async-byte-compile-log-file)
+               (let ((buf (get-buffer-create byte-compile-log-buffer))
+                     (n 0))
+                 (with-current-buffer buf
+                   (goto-char (point-max))
+                   (let ((inhibit-read-only t))
+                     (insert-file-contents async-byte-compile-log-file)
+                     (compilation-mode))
+                   (display-buffer buf)
+                   (delete-file async-byte-compile-log-file)
+                   (unless quiet
+                     (save-excursion
+                       (goto-char (point-min))
+                       (while (re-search-forward "^.*:Error:" nil t)
+                         (cl-incf n)))
+                     (if (> n 0)
+                         (message "Failed to compile %d files in directory 
`%s'" n directory)
+                         (message "Directory `%s' compiled asynchronously with 
warnings" directory)))))
+               (unless quiet
+                 (message "Directory `%s' compiled asynchronously with 
success" directory))))))
     (async-start
      `(lambda ()
         (require 'bytecomp)
diff --git a/packages/async/async-pkg.el b/packages/async/async-pkg.el
new file mode 100644
index 0000000..363e942
--- /dev/null
+++ b/packages/async/async-pkg.el
@@ -0,0 +1,2 @@
+;; Generated package description from async.el
+(define-package "async" "1.9" "Asynchronous processing in Emacs" 'nil :url 
"http://elpa.gnu.org/packages/async.html"; :keywords '("async"))
diff --git a/packages/async/async.el b/packages/async/async.el
index 24db2a1..3798c95 100644
--- a/packages/async/async.el
+++ b/packages/async/async.el
@@ -1,10 +1,10 @@
-;;; async.el --- Asynchronous processing in Emacs
+;;; async.el --- Asynchronous processing in Emacs -*- lexical-binding: t -*-
 
 ;; Copyright (C) 2012-2016 Free Software Foundation, Inc.
 
 ;; Author: John Wiegley <address@hidden>
 ;; Created: 18 Jun 2012
-;; Version: 1.6
+;; Version: 1.9
 
 ;; Keywords: async
 ;; X-URL: https://github.com/jwiegley/emacs-async
@@ -95,8 +95,8 @@ as follows:
       (unless async-debug
         (kill-buffer buf)))))
 
-(defun async-when-done (proc &optional change)
-  "Process sentinal used to retrieve the value from the child process."
+(defun async-when-done (proc &optional _change)
+  "Process sentinel used to retrieve the value from the child process."
   (when (eq 'exit (process-status proc))
     (with-current-buffer (process-buffer proc)
       (let ((async-current-process proc))
@@ -201,7 +201,7 @@ its FINISH-FUNC is nil."
             (funcall async-callback args))
       (async--transmit-sexp (car args) (list 'quote (cdr args))))))
 
-(defun async-receive (&rest args)
+(defun async-receive ()
   "Send the given messages to the asychronous Emacs PROCESS."
   (async--receive-sexp))
 
@@ -257,7 +257,7 @@ ready.  Example:
                  (async-get proc)))
 
 If you don't want to use a callback, and you don't care about any
-return value form the child process, pass the `ignore' symbol as
+return value from the child process, pass the `ignore' symbol as
 the second argument (if you don't, and never call `async-get', it
 will leave *emacs* process buffers hanging around):
 
diff --git a/packages/async/dired-async.el b/packages/async/dired-async.el
index ecab9cb..d0de789 100644
--- a/packages/async/dired-async.el
+++ b/packages/async/dired-async.el
@@ -1,4 +1,4 @@
-;;; dired-async.el --- Copy/move/delete asynchronously in dired.
+;;; dired-async.el --- Asynchronous dired actions -*- lexical-binding: t -*-
 
 ;; Copyright (C) 2012-2016 Free Software Foundation, Inc.
 
@@ -44,7 +44,6 @@
 
 (eval-when-compile
   (defvar async-callback))
-(defvar dired-async-operation nil)
 
 (defgroup dired-async nil
   "Copy rename files asynchronously from dired."
@@ -72,6 +71,11 @@ Should take same args as `message'."
   "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."
@@ -87,7 +91,7 @@ Should take same args as `message'."
   (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
@@ -95,7 +99,7 @@ Should take same args as `message'."
                                 (if args
                                     (apply #'format text args)
                                     text)
-                                'face 'dired-async-message))))
+                                'face face))))
     (force-mode-line-update)
     (sit-for 3)
     (force-mode-line-update)))
@@ -110,28 +114,49 @@ Should take same args as `message'."
   (interactive)
   (let* ((processes (dired-async-processes))
          (proc (car (last processes))))
-    (delete-process proc)
+    (and proc (delete-process proc))
     (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*"))
-          (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
-         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 -- See *Dired log* 
buffer"
+                           '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 -- See *Dired log* 
buffer"
+                           '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 on %s file%s done"
+                    'dired-async-message
+                    (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."
@@ -144,19 +169,16 @@ Should take same args as `message'."
                                        (buffer-name b)) b))))
        (when buf (kill-buffer buf))))))
 
+(defvar overwrite-query)
 (defun dired-async-create-files (file-creator operation fn-list 
name-constructor
-                                 &optional marker-char)
+                                 &optional _marker-char)
   "Same as `dired-create-files' but asynchronous.
 
 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)
-    (let (to overwrite-query
-             overwrite-backup-query)    ; for dired-handle-overwrite
+  (setq overwrite-query nil)
+  (let ((total (length fn-list))
+        failures async-fn-list skipped callback)
+    (let (to)
       (dolist (from fn-list)
         (setq to (funcall name-constructor from))
         (if (equal to from)
@@ -166,22 +188,16 @@ See `dired-create-files' for the behavior of arguments."
                          (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 "\
+                         (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))))
+`!' 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
               ;; possibly to itself or one of its subdirectories.
@@ -213,58 +229,85 @@ ESC or `q' to not overwrite any of the remaining files,
                            (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 -- See *Dired log* 
buffer"
+                        'dired-async-failures
+                        operation (length failures)
+                        total (dired-plural-s total)))
+              (skipped
+               (funcall dired-async-message-function
+                        "%s: %d of %d file%s skipped -- See *Dired log* buffer"
+                        'dired-async-failures
+                        operation (length skipped) total
+                        (dired-plural-s total)))))
+      ;; Setup callback.
       (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)
+            (lambda (&optional _ignore)
+               (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)
+                          for destp = (file-exists-p to)
+                          do (and bf destp
+                                  (with-current-buffer bf
                                     (set-visited-file-name to nil t))))))))
-    ;; 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"
-                operation (length failures)
-                (dired-plural-s (length failures))
-                total)
-        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"
-                operation (length skipped) total
-                (dired-plural-s total))
-        skipped))
-      (t (message "%s: %s file%s"
-                  operation success-count (dired-plural-s success-count))))
     ;; 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)))
-                            (cl-loop for (f . d) in (quote ,async-fn-list)
-                                     do (funcall (quote ,file-creator) f d t)))
-                        (file-error
-                         (with-temp-file ,dired-async-log-file
-                           (insert (format "%S" err)))))
+                          (let ((dired-recursive-copies (quote always))
+                                (dired-copy-preserve-time
+                                 ,dired-copy-preserve-time))
+                            (setq overwrite-backup-query nil)
+                            ;; 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
+                                              (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 (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)
diff --git a/packages/async/smtpmail-async.el b/packages/async/smtpmail-async.el
index 5ac426d..6fcf287 100644
--- a/packages/async/smtpmail-async.el
+++ b/packages/async/smtpmail-async.el
@@ -1,4 +1,4 @@
-;;; smtpmail-async.el --- Send e-mail with smtpmail.el asynchronously
+;;; smtpmail-async.el --- Send e-mail with smtpmail.el asynchronously -*- 
lexical-binding: t -*-
 
 ;; Copyright (C) 2012-2016 Free Software Foundation, Inc.
 
@@ -65,8 +65,8 @@ It is called just before calling `smtpmail-send-it'.")
             nil 
"\\`\\(mail-header-format-function\\|smtpmail-address-buffer\\|mail-mode-abbrev-table\\)")
           (run-hooks 'async-smtpmail-before-send-hook)
           (smtpmail-send-it)))
-     `(lambda (&optional ignore)
-        (message "Delivering message to %s...done" ,to)))))
+     (lambda (&optional _ignore)
+       (message "Delivering message to %s...done" to)))))
 
 (provide 'smtpmail-async)
 



reply via email to

[Prev in Thread] Current Thread [Next in Thread]