]> code.delx.au - gnu-emacs-elpa/commitdiff
Merge commit '0e327f72bdffc5bc4a1fbc34a8da1b7066e819b3'
authorThierry Volpiatto <thierry.volpiatto@gmail.com>
Wed, 18 May 2016 10:35:40 +0000 (12:35 +0200)
committerThierry Volpiatto <thierry.volpiatto@gmail.com>
Wed, 18 May 2016 10:35:40 +0000 (12:35 +0200)
1  2 
packages/async/README.md
packages/async/async-bytecomp.el
packages/async/async-pkg.el
packages/async/async.el
packages/async/dired-async.el
packages/async/smtpmail-async.el

diff --combined packages/async/README.md
index a5b0866510dc8996de2dbd918c99a9562ea0d9cf,e19fb5a54ee0a1b92edd95bf59f66c7a1c2b9ed1..e19fb5a54ee0a1b92edd95bf59f66c7a1c2b9ed1
@@@ -25,6 -25,10 +25,10 @@@ you can disable this by running the cop
  
  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.
index 54313c0e0120aad049f9e313aa930e22264cc469,2c96da0ad6a01a82b4032c8427c593b04b5dce87..2c96da0ad6a01a82b4032c8427c593b04b5dce87
@@@ -1,4 -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 +65,27 @@@ All *.elc files are systematically dele
    ;; 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)
index 0000000000000000000000000000000000000000,363e9420f6612d1b526dcc3e8cddb2a219723baa..363e9420f6612d1b526dcc3e8cddb2a219723baa
mode 000000,100644..100644
--- /dev/null
@@@ -1,0 -1,2 +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 --combined packages/async/async.el
index 24db2a1e7b9b4e1403891f081a673f50ec56e03f,3798c950ff747f21e0233fa143f98ebfa258b16b..3798c950ff747f21e0233fa143f98ebfa258b16b
@@@ -1,10 -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 <jwiegley@gmail.com>
  ;; Created: 18 Jun 2012
- ;; Version: 1.6
+ ;; Version: 1.9
  
  ;; Keywords: async
  ;; X-URL: https://github.com/jwiegley/emacs-async
@@@ -95,8 -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 +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 +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):
  
index ecab9cb5b72a5d07fb1bf48a9a04ceba06a42b28,d0de7893d5b8e792c315b2c1eb0e964e5cb132e8..d0de7893d5b8e792c315b2c1eb0e964e5cb132e8
@@@ -1,4 -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 +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 +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 +91,7 @@@
    (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 +99,7 @@@
                                  (if args
                                      (apply #'format text args)
                                      text)
-                                 'face 'dired-async-message))))
+                                 'face face))))
      (force-mode-line-update)
      (sit-for 3)
      (force-mode-line-update)))
    (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."
                                         (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)
                           (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.
                             (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)
index 5ac426d6c87a1f85e7ba509d821a07133e7a0a67,6fcf287f459bf4896b757d412caaea58fff7190b..6fcf287f459bf4896b757d412caaea58fff7190b
@@@ -1,4 -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 +65,8 @@@ It is called just before calling `smtpm
              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)