async-1.9.2.tar

async-1.9.2/0000755000175000017500000000000013232502457010375 5ustar  cbcbasync-1.9.2/async.el0000644000175000017500000003025113232502457012035 0ustar  cbcb;;; 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.9.2

;; Keywords: async
;; X-URL: https://github.com/jwiegley/emacs-async

;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation; either version 2, or (at
;; your option) any later version.

;; This program is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;; Adds the ability to call asynchronous functions and process with ease.  See
;; the documentation for `async-start' and `async-start-process'.

;;; Code:

(defgroup async nil
  "Simple asynchronous processing in Emacs"
  :group 'emacs)

(defvar async-debug nil)
(defvar async-send-over-pipe t)
(defvar async-in-child-emacs nil)
(defvar async-callback nil)
(defvar async-callback-for-process nil)
(defvar async-callback-value nil)
(defvar async-callback-value-set nil)
(defvar async-current-process nil)
(defvar async--procvar nil)

(defun async-inject-variables
  (include-regexp &optional predicate exclude-regexp)
  "Return a `setq' form that replicates part of the calling environment.
It sets the value for every variable matching INCLUDE-REGEXP and
also PREDICATE.  It will not perform injection for any variable
matching EXCLUDE-REGEXP (if present).  It is intended to be used
as follows:

    (async-start
       `(lambda ()
          (require 'smtpmail)
          (with-temp-buffer
            (insert ,(buffer-substring-no-properties (point-min) (point-max)))
            ;; Pass in the variable environment for smtpmail
            ,(async-inject-variables \"\\`\\(smtpmail\\|\\(user-\\)?mail\\)-\")
            (smtpmail-send-it)))
       'ignore)"
  `(setq
    ,@(let (bindings)
        (mapatoms
         (lambda (sym)
           (if (and (boundp sym)
                    (or (null include-regexp)
                        (string-match include-regexp (symbol-name sym)))
                    (not (string-match
                          (or exclude-regexp "-syntax-table\\'")
                          (symbol-name sym))))
               (let ((value (symbol-value sym)))
                 (when (or (null predicate)
                           (funcall predicate sym))
                   (setq bindings (cons `(quote ,value) bindings)
                         bindings (cons sym bindings)))))))
        bindings)))

(defalias 'async-inject-environment 'async-inject-variables)

(defun async-handle-result (func result buf)
  (if (null func)
      (progn
        (set (make-local-variable 'async-callback-value) result)
        (set (make-local-variable 'async-callback-value-set) t))
    (unwind-protect
        (if (and (listp result)
                 (eq 'async-signal (nth 0 result)))
            (signal (car (nth 1 result))
                    (cdr (nth 1 result)))
          (funcall func result))
      (unless async-debug
        (kill-buffer buf)))))

(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))
        (if (= 0 (process-exit-status proc))
            (if async-callback-for-process
                (if async-callback
                    (prog1
                        (funcall async-callback proc)
                      (unless async-debug
                        (kill-buffer (current-buffer))))
                  (set (make-local-variable 'async-callback-value) proc)
                  (set (make-local-variable 'async-callback-value-set) t))
              (goto-char (point-max))
              (backward-sexp)
              (async-handle-result async-callback (read (current-buffer))
                                   (current-buffer)))
          (set (make-local-variable 'async-callback-value)
               (list 'error
                     (format "Async process '%s' failed with exit code %d"
                             (process-name proc) (process-exit-status proc))))
          (set (make-local-variable 'async-callback-value-set) t))))))

(defun async--receive-sexp (&optional stream)
  (let ((sexp (decode-coding-string (base64-decode-string
                                     (read stream)) 'utf-8-unix))
	;; Parent expects UTF-8 encoded text.
	(coding-system-for-write 'utf-8-unix))
    (if async-debug
        (message "Received sexp {{{%s}}}" (pp-to-string sexp)))
    (setq sexp (read sexp))
    (if async-debug
        (message "Read sexp {{{%s}}}" (pp-to-string sexp)))
    (eval sexp)))

(defun async--insert-sexp (sexp)
  (let (print-level
	print-length
	(print-escape-nonascii t)
	(print-circle t))
    (prin1 sexp (current-buffer))
    ;; Just in case the string we're sending might contain EOF
    (encode-coding-region (point-min) (point-max) 'utf-8-unix)
    (base64-encode-region (point-min) (point-max) t)
    (goto-char (point-min)) (insert ?\")
    (goto-char (point-max)) (insert ?\" ?\n)))

(defun async--transmit-sexp (process sexp)
  (with-temp-buffer
    (if async-debug
        (message "Transmitting sexp {{{%s}}}" (pp-to-string sexp)))
    (async--insert-sexp sexp)
    (process-send-region process (point-min) (point-max))))

(defun async-batch-invoke ()
  "Called from the child Emacs process' command-line."
  ;; Make sure 'message' and 'prin1' encode stuff in UTF-8, as parent
  ;; process expects.
  (let ((coding-system-for-write 'utf-8-unix))
    (setq async-in-child-emacs t
	  debug-on-error async-debug)
    (if debug-on-error
	(prin1 (funcall
		(async--receive-sexp (unless async-send-over-pipe
				       command-line-args-left))))
      (condition-case err
	  (prin1 (funcall
		  (async--receive-sexp (unless async-send-over-pipe
					 command-line-args-left))))
	(error
	 (prin1 (list 'async-signal err)))))))

(defun async-ready (future)
  "Query a FUTURE to see if it is ready.

I.e., if no blocking
would result from a call to `async-get' on that FUTURE."
  (and (memq (process-status future) '(exit signal))
       (let ((buf (process-buffer future)))
         (if (buffer-live-p buf)
             (with-current-buffer buf
               async-callback-value-set)
             t))))

(defun async-wait (future)
  "Wait for FUTURE to become ready."
  (while (not (async-ready future))
    (sleep-for 0.05)))

(defun async-get (future)
  "Get the value from process FUTURE when it is ready.
FUTURE is returned by `async-start' or `async-start-process' when
its FINISH-FUNC is nil."
  (and future (async-wait future))
  (let ((buf (process-buffer future)))
    (when (buffer-live-p buf)
      (with-current-buffer buf
        (async-handle-result
         #'identity async-callback-value (current-buffer))))))

(defun async-message-p (value)
  "Return true of VALUE is an async.el message packet."
  (and (listp value)
       (plist-get value :async-message)))

(defun async-send (&rest args)
  "Send the given messages to the asychronous Emacs PROCESS."
  (let ((args (append args '(:async-message t))))
    (if async-in-child-emacs
        (if async-callback
            (funcall async-callback args))
      (async--transmit-sexp (car args) (list 'quote (cdr args))))))

(defun async-receive ()
  "Send the given messages to the asychronous Emacs PROCESS."
  (async--receive-sexp))

;;;###autoload
(defun async-start-process (name program finish-func &rest program-args)
  "Start the executable PROGRAM asynchronously.  See `async-start'.
PROGRAM is passed PROGRAM-ARGS, calling FINISH-FUNC with the
process object when done.  If FINISH-FUNC is nil, the future
object will return the process object when the program is
finished.  Set DEFAULT-DIRECTORY to change PROGRAM's current
working directory."
  (let* ((buf (generate-new-buffer (concat "*" name "*")))
         (proc (let ((process-connection-type nil))
                 (apply #'start-process name buf program program-args))))
    (with-current-buffer buf
      (set (make-local-variable 'async-callback) finish-func)
      (set-process-sentinel proc #'async-when-done)
      (unless (string= name "emacs")
        (set (make-local-variable 'async-callback-for-process) t))
      proc)))

;;;###autoload
(defun async-start (start-func &optional finish-func)
  "Execute START-FUNC (often a lambda) in a subordinate Emacs process.
When done, the return value is passed to FINISH-FUNC.  Example:

    (async-start
       ;; What to do in the child process
       (lambda ()
         (message \"This is a test\")
         (sleep-for 3)
         222)

       ;; What to do when it finishes
       (lambda (result)
         (message \"Async process done, result should be 222: %s\"
                  result)))

If FINISH-FUNC is nil or missing, a future is returned that can
be inspected using `async-get', blocking until the value is
ready.  Example:

    (let ((proc (async-start
                   ;; What to do in the child process
                   (lambda ()
                     (message \"This is a test\")
                     (sleep-for 3)
                     222))))

        (message \"I'm going to do some work here\") ;; ....

        (message \"Waiting on async process, result should be 222: %s\"
                 (async-get proc)))

If you don't want to use a callback, and you don't care about any
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):

    (async-start
     (lambda ()
       (delete-file \"a remote file on a slow link\" nil))
     'ignore)

Note: Even when FINISH-FUNC is present, a future is still
returned except that it yields no value (since the value is
passed to FINISH-FUNC).  Call `async-get' on such a future always
returns nil.  It can still be useful, however, as an argument to
`async-ready' or `async-wait'."
  (let ((sexp start-func)
	;; Subordinate Emacs will send text encoded in UTF-8.
	(coding-system-for-read 'utf-8-unix))
    (setq async--procvar
          (async-start-process
           "emacs" (file-truename
                    (expand-file-name invocation-name
                                      invocation-directory))
           finish-func
           "-Q" "-l"
           ;; Using `locate-library' ensure we use the right file
           ;; when the .elc have been deleted.
           (locate-library "async")
           "-batch" "-f" "async-batch-invoke"
           (if async-send-over-pipe
               "<none>"
               (with-temp-buffer
                 (async--insert-sexp (list 'quote sexp))
                 (buffer-string)))))
    (if async-send-over-pipe
        (async--transmit-sexp async--procvar (list 'quote sexp)))
    async--procvar))

(defmacro async-sandbox(func)
  "Evaluate FUNC in a separate Emacs process, synchronously."
  `(async-get (async-start ,func)))

(defun async--fold-left (fn forms bindings)
  (let ((res forms))
    (dolist (binding bindings)
      (setq res (funcall fn res
                         (if (listp binding)
                             binding
                             (list binding)))))
    res))

(defmacro async-let (bindings &rest forms)
  "Implements `let', but each binding is established asynchronously.
For example:

  (async-let ((x (foo))
              (y (bar)))
     (message \"%s %s\" x y))

    expands to ==>

  (async-start (foo)
   (lambda (x)
     (async-start (bar)
      (lambda (y)
        (message \"%s %s\" x y)))))"
  (declare (indent 1))
  (async--fold-left
   (lambda (acc binding)
     (let ((fun (pcase (cadr binding)
                  ((and (pred functionp) f) f)
                  (f `(lambda () ,f)))))
       `(async-start ,fun
                     (lambda (,(car binding))
                       ,acc))))
   `(progn ,@forms)
   (reverse bindings)))

(provide 'async)

;;; async.el ends here
async-1.9.2/async-pkg.el0000644000175000017500000000030313232502456012606 0ustar  cbcb(define-package "async" "1.9.2" "Asynchronous processing in Emacs" 'nil :keywords
  '("async")
  :url "https://github.com/jwiegley/emacs-async")
;; Local Variables:
;; no-byte-compile: t
;; End:
async-1.9.2/smtpmail-async.el0000644000175000017500000000500113232502457013654 0ustar  cbcb;;; smtpmail-async.el --- Send e-mail with smtpmail.el asynchronously -*- lexical-binding: t -*-

;; Copyright (C) 2012-2016 Free Software Foundation, Inc.

;; Author: John Wiegley <jwiegley@gmail.com>
;; Created: 18 Jun 2012

;; Keywords: email async
;; X-URL: https://github.com/jwiegley/emacs-async

;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation; either version 2, or (at
;; your option) any later version.

;; This program is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;; Send e-mail with smtpmail.el asynchronously.  To use:
;;
;;   (require 'smtpmail-async)
;;
;;   (setq send-mail-function 'async-smtpmail-send-it
;;         message-send-mail-function 'async-smtpmail-send-it)
;;
;; This assumes you already have smtpmail.el working.

;;; Code:

(defgroup smtpmail-async nil
  "Send e-mail with smtpmail.el asynchronously"
  :group 'smptmail)

(require 'async)
(require 'smtpmail)
(require 'message)

(defvar async-smtpmail-before-send-hook nil
  "Hook running in the child emacs in `async-smtpmail-send-it'.
It is called just before calling `smtpmail-send-it'.")

(defun async-smtpmail-send-it ()
  (let ((to          (message-field-value "To"))
        (buf-content (buffer-substring-no-properties
                      (point-min) (point-max))))
    (message "Delivering message to %s..." to)
    (async-start
     `(lambda ()
        (require 'smtpmail)
        (with-temp-buffer
          (insert ,buf-content)
          (set-buffer-multibyte nil)
          ;; Pass in the variable environment for smtpmail
          ,(async-inject-variables
            "\\`\\(smtpmail\\|async-smtpmail\\|\\(user-\\)?mail\\)-\\|auth-sources\\|epg\\|nsm"
            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)))))

(provide 'smtpmail-async)

;;; smtpmail-async.el ends here
async-1.9.2/dired-async.el0000644000175000017500000003623213232502456013126 0ustar  cbcb;;; dired-async.el --- Asynchronous dired actions -*- lexical-binding: t -*-

;; Copyright (C) 2012-2016 Free Software Foundation, Inc.

;; Authors: John Wiegley <jwiegley@gmail.com>
;;          Thierry Volpiatto <thierry.volpiatto@gmail.com>

;; Keywords: dired async network
;; X-URL: https://github.com/jwiegley/dired-async

;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation; either version 2, or (at
;; your option) any later version.

;; This program is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;; This file provide a redefinition of `dired-create-file' function,
;; 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:

;;     (dired-async-mode 1)

;; This will enable async copy/rename etc...
;; in dired and helm.

;;; Code:

(require 'cl-lib)
(require 'dired-aux)
(require 'async)

(eval-when-compile
  (defvar async-callback))

(defgroup dired-async nil
  "Copy rename files asynchronously from dired."
  :group 'dired)

(defcustom dired-async-env-variables-regexp
  "\\`\\(tramp-\\(default\\|connection\\|remote\\)\\|ange-ftp\\)-.*"
  "Variables matching this regexp will be loaded on Child Emacs."
  :type  'regexp
  :group 'dired-async)

(defcustom dired-async-message-function 'dired-async-mode-line-message
  "Function to use to notify result when operation finish.
Should take same args as `message'."
  :group 'dired-async
  :type  'function)

(defcustom dired-async-log-file "/tmp/dired-async.log"
  "File use to communicate errors from Child Emacs to host Emacs."
  :group 'dired-async
  :type 'string)

(defface dired-async-message
    '((t (:foreground "yellow")))
  "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."
  :group 'dired-async)

(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
    (let ((visible-bell t)) (ding))))

(defun dired-async-mode-line-message (text face &rest args)
  "Notify end of operation in `mode-line'."
  (message nil)
  (let ((mode-line-format (concat
                           " " (propertize
                                (if args
                                    (apply #'format text args)
                                    text)
                                'face face))))
    (force-mode-line-update)
    (sit-for 3)
    (force-mode-line-update)))

(defun dired-async-processes ()
  (cl-loop for p in (process-list)
           when (cl-loop for c in (process-command p) thereis
                         (string= "async-batch-invoke" c))
           collect p))

(defun dired-async-kill-process ()
  (interactive)
  (let* ((processes (dired-async-processes))
         (proc (car (last processes))))
    (and proc (delete-process proc))
    (unless (> (length processes) 1)
      (dired-async--modeline-mode -1))))

(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 operation
    (if (file-exists-p dired-async-log-file)
        (progn
          (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
         (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."
  (quote
   (progn
     (require 'cl-lib)
     (let ((buf (cl-loop for b in (buffer-list)
                         thereis (and (string-match
                                       "\\`\\*ftp.*"
                                       (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)
  "Same as `dired-create-files' but asynchronous.

See `dired-create-files' for the behavior of arguments."
  (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)
            (progn
              (setq to nil)
              (dired-log "Cannot %s to same file: %s\n"
                         (downcase operation) from)))
        (if (not to)
            (setq skipped (cons (dired-make-relative from) skipped))
            (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 "\
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)))))
              ;; 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\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 (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 t t))))))))
    ;; 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)
                          (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)
      (message "%s proceeding asynchronously..." operation))))

(defvar wdired-use-interactive-rename)
(defun dired-async-wdired-do-renames (old-fn &rest args)
  ;; Perhaps a better fix would be to ask for renaming BEFORE starting
  ;; OLD-FN when `wdired-use-interactive-rename' is non-nil.  For now
  ;; just bind it to nil to ensure no questions will be asked between
  ;; each rename.
  (let (wdired-use-interactive-rename)
    (apply old-fn args)))

(defadvice wdired-do-renames (around wdired-async)
  (let (wdired-use-interactive-rename)
    ad-do-it))

(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)
          (progn (advice-add 'dired-create-files :override #'dired-async-create-files)
                 (advice-add 'wdired-do-renames :around #'dired-async-wdired-do-renames))
        (ad-activate 'dired-create-files)
        (ad-activate 'wdired-do-renames))
      (if (fboundp 'advice-remove)
          (progn (advice-remove 'dired-create-files #'dired-async-create-files)
                 (advice-remove 'wdired-do-renames #'dired-async-wdired-do-renames))
          (ad-deactivate 'dired-create-files)
          (ad-deactivate 'wdired-do-renames))))


(provide 'dired-async)

;;; dired-async.el ends here
async-1.9.2/async-bytecomp.el0000644000175000017500000001723313232502456013661 0ustar  cbcb;;; async-bytecomp.el --- Compile elisp files asynchronously -*- lexical-binding: t -*-

;; Copyright (C) 2014-2016 Free Software Foundation, Inc.

;; Authors: John Wiegley <jwiegley@gmail.com>
;;          Thierry Volpiatto <thierry.volpiatto@gmail.com>

;; Keywords: dired async byte-compile
;; X-URL: https://github.com/jwiegley/dired-async

;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation; either version 2, or (at
;; your option) any later version.

;; This program is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:
;;
;;  This package provide the `async-byte-recompile-directory' function
;;  which allows, as the name says to recompile a directory outside of
;;  your running emacs.
;;  The benefit is your files will be compiled in a clean environment without
;;  the old *.el files loaded.
;;  Among other things, this fix a bug in package.el which recompile
;;  the new files in the current environment with the old files loaded, creating
;;  errors in most packages after upgrades.
;;
;;  NB: This package is advicing the function `package--compile'.

;;; Code:

(require 'cl-lib)
(require 'async)

(defcustom async-bytecomp-allowed-packages
  '(async helm helm-core helm-ls-git helm-ls-hg magit)
  "Packages in this list will be compiled asynchronously by `package--compile'.
All the dependencies of these packages will be compiled async too,
so no need to add dependencies to this list.
The value of this variable can also be a list with a single element,
the symbol `all', in this case packages are always compiled asynchronously."
  :group 'async
  :type '(repeat (choice symbol)))

(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."
  (cl-loop with dir = (directory-files directory t "\\.elc\\'")
           unless dir return nil
           for f in dir
           when (file-exists-p f) do (delete-file f))
  ;; Ensure async is reloaded when async.elc is deleted.
  ;; 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))))))
    (async-start
     `(lambda ()
        (require 'bytecomp)
        ,(async-inject-variables "\\`\\(load-path\\)\\|byte\\'")
        (let ((default-directory (file-name-as-directory ,directory))
              error-data)
          (add-to-list 'load-path default-directory)
          (byte-recompile-directory ,directory 0 t)
          (when (get-buffer byte-compile-log-buffer)
            (setq error-data (with-current-buffer byte-compile-log-buffer
                               (buffer-substring-no-properties (point-min) (point-max))))
            (unless (string= error-data "")
              (with-temp-file ,async-byte-compile-log-file
                (erase-buffer)
                (insert error-data))))))
     call-back)
    (unless quiet (message "Started compiling asynchronously directory %s" directory))))

(defvar package-archive-contents)
(defvar package-alist)
(declare-function package-desc-reqs "package.el" (cl-x))

(defun async-bytecomp--get-package-deps (pkg &optional only)
  ;; Same as `package--get-deps' but parse instead `package-archive-contents'
  ;; because PKG is not already installed and not present in `package-alist'.
  ;; However fallback to `package-alist' in case PKG no more present
  ;; in `package-archive-contents' due to modification to `package-archives'.
  ;; See issue #58.
  (let* ((pkg-desc (cadr (or (assq pkg package-archive-contents)
                             (assq pkg package-alist))))
         (direct-deps (cl-loop for p in (package-desc-reqs pkg-desc)
                               for name = (car p)
                               when (or (assq name package-archive-contents)
                                        (assq name package-alist))
                               collect name))
         (indirect-deps (unless (eq only 'direct)
                          (delete-dups
                           (cl-loop for p in direct-deps append
                                    (async-bytecomp--get-package-deps p))))))
    (cl-case only
      (direct   direct-deps)
      (separate (list direct-deps indirect-deps))
      (indirect indirect-deps)
      (t        (delete-dups (append direct-deps indirect-deps))))))

(defun async-bytecomp-get-allowed-pkgs ()
  (when (and async-bytecomp-allowed-packages
             (listp async-bytecomp-allowed-packages))
    (if package-archive-contents
        (cl-loop for p in async-bytecomp-allowed-packages
                 when (assq p package-archive-contents)
                 append (async-bytecomp--get-package-deps p) into reqs
                 finally return
                 (delete-dups
                  (append async-bytecomp-allowed-packages reqs)))
        async-bytecomp-allowed-packages)))

(defadvice package--compile (around byte-compile-async)
  (let ((cur-package (package-desc-name pkg-desc))
        (pkg-dir (package-desc-dir pkg-desc)))
    (if (or (equal async-bytecomp-allowed-packages '(all))
            (memq cur-package (async-bytecomp-get-allowed-pkgs)))
        (progn
          (when (eq cur-package 'async)
            (fmakunbound 'async-byte-recompile-directory))
          ;; Add to `load-path' the latest version of async and
          ;; reload it when reinstalling async.
          (when (string= cur-package "async")
            (cl-pushnew pkg-dir load-path)
            (load "async-bytecomp"))
          ;; `async-byte-recompile-directory' will add directory
          ;; as needed to `load-path'.
          (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)

;;; async-bytecomp.el ends here
async-1.9.2/async-autoloads.el0000644000175000017500000001025213232502457014025 0ustar  cbcb;;; async-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path))))

;;;### (autoloads nil "async" "async.el" (23146 34095 0 0))
;;; Generated autoloads from async.el

(autoload 'async-start-process "async" "\
Start the executable PROGRAM asynchronously.  See `async-start'.
PROGRAM is passed PROGRAM-ARGS, calling FINISH-FUNC with the
process object when done.  If FINISH-FUNC is nil, the future
object will return the process object when the program is
finished.  Set DEFAULT-DIRECTORY to change PROGRAM's current
working directory.

\(fn NAME PROGRAM FINISH-FUNC &rest PROGRAM-ARGS)" nil nil)

(autoload 'async-start "async" "\
Execute START-FUNC (often a lambda) in a subordinate Emacs process.
When done, the return value is passed to FINISH-FUNC.  Example:

    (async-start
       ;; What to do in the child process
       (lambda ()
         (message \"This is a test\")
         (sleep-for 3)
         222)

       ;; What to do when it finishes
       (lambda (result)
         (message \"Async process done, result should be 222: %s\"
                  result)))

If FINISH-FUNC is nil or missing, a future is returned that can
be inspected using `async-get', blocking until the value is
ready.  Example:

    (let ((proc (async-start
                   ;; What to do in the child process
                   (lambda ()
                     (message \"This is a test\")
                     (sleep-for 3)
                     222))))

        (message \"I'm going to do some work here\") ;; ....

        (message \"Waiting on async process, result should be 222: %s\"
                 (async-get proc)))

If you don't want to use a callback, and you don't care about any
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):

    (async-start
     (lambda ()
       (delete-file \"a remote file on a slow link\" nil))
     'ignore)

Note: Even when FINISH-FUNC is present, a future is still
returned except that it yields no value (since the value is
passed to FINISH-FUNC).  Call `async-get' on such a future always
returns nil.  It can still be useful, however, as an argument to
`async-ready' or `async-wait'.

\(fn START-FUNC &optional FINISH-FUNC)" nil nil)

;;;***

;;;### (autoloads nil "async-bytecomp" "async-bytecomp.el" (23146
;;;;;;  34094 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 `async-bytecomp-package-mode' command
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" (23146 34094
;;;;;;  0 0))
;;; Generated autoloads from dired-async.el

(defvar dired-async-mode nil "\
Non-nil if Dired-Async mode is enabled.
See the `dired-async-mode' command
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") (23146
;;;;;;  34095 0 0))

;;;***

;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; async-autoloads.el ends here