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

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

[elpa] master 4e44885 185/187: Add 'packages/async/' from commit '2a4035


From: Michael Albinus
Subject: [elpa] master 4e44885 185/187: Add 'packages/async/' from commit '2a40355c3328e57102a9648c9108e19d67727dc1'
Date: Wed, 30 Dec 2015 11:50:34 +0000

branch: master
commit 4e448854ac035e581812a27c22c84a574cb02c76
Merge: 81b0ef7 2a40355
Author: Michael Albinus <address@hidden>
Commit: Michael Albinus <address@hidden>

    Add 'packages/async/' from commit '2a40355c3328e57102a9648c9108e19d67727dc1'
    
    git-subtree-dir: packages/async
    git-subtree-mainline: 81b0ef76e85360e3f20e71195bf0db94183ecc04
    git-subtree-split: 2a40355c3328e57102a9648c9108e19d67727dc1
---
 packages/async/README.md         |  145 +++++++++++++++++++
 packages/async/async-bytecomp.el |  172 ++++++++++++++++++++++
 packages/async/async-pkg.el      |   12 ++
 packages/async/async-test.el     |  140 ++++++++++++++++++
 packages/async/async.el          |  292 ++++++++++++++++++++++++++++++++++++++
 packages/async/dired-async.el    |  291 +++++++++++++++++++++++++++++++++++++
 packages/async/smtpmail-async.el |   73 ++++++++++
 7 files changed, 1125 insertions(+), 0 deletions(-)

diff --git a/packages/async/README.md b/packages/async/README.md
new file mode 100644
index 0000000..a5b0866
--- /dev/null
+++ b/packages/async/README.md
@@ -0,0 +1,145 @@
+<p><a href="http://www.gnu.org/licenses/gpl-3.0.txt";><img 
src="https://img.shields.io/badge/license-GPL_3-green.svg"; alt="License GPL 3" 
/></a>
+<a href="http://melpa.org/#/async";><img 
src="http://melpa.org/packages/async-badge.svg"; alt="MELPA" title="" /></a>
+<a href="http://stable.melpa.org/#/async";><img 
src="http://stable.melpa.org/packages/async-badge.svg"; alt="MELPA Stable" 
title="" /></a></p>
+
+
+# emacs-async
+
+`async.el` is a module for doing asynchronous processing in Emacs.
+
+# Install
+
+## Install dired-async
+
+Add to your `.emacs.el`:
+
+    (autoload 'dired-async-mode "dired-async.el" nil t)
+    (dired-async-mode 1)
+
+This will allow you to run  asynchronously
+the dired commands for copying, renaming and symlinking.
+If you are a [helm](https://github.com/emacs-helm/helm) user, this will allow 
you
+to copy, rename etc... asynchronously from 
[helm](https://github.com/emacs-helm/helm).
+Note that with [helm](https://github.com/emacs-helm/helm)
+you can disable this by running the copy, rename etc... commands with a prefix 
argument.
+
+If you don't want to make dired/helm asynchronous disable it with 
`dired-async-mode`.
+
+## Enable asynchronous compilation of your (M)elpa packages
+
+By default emacs package.el compile packages in its running emacs session.
+This is not a problem when installing a new package (which is not actually 
loaded in current emacs)
+but it may create errors and bad compilation when upgrading a package (old 
version of package is already loaded
+and running in current emacs).
+You can remedy to this by allowing async to compile your packages 
asynchronously,
+(helm and magit actually do this by default,
+so if you are using these packages they will compile asynchronously)
+to do this, add to your init file:
+    
+    (async-bytecomp-package-mode 1)
+
+
+You can control which packages will compile async with 
`async-bytecomp-allowed-packages`.
+Set it to `'(all)` to be sure you will compile all packages asynchronously.
+
+# Usage
+
+The interface is intended to be very easy to use:
+
+## async-start
+
+    async-start START-FUNC 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).  Calling
+`async-get` on such a future always returns `nil`.  It can still be useful,
+however, as an argument to `async-ready` or `async-wait`.
+
+## async-start-process
+
+    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.
+
+## async-get
+
+    async-get FUTURE
+
+Get the value from an asynchronously called function when it is ready.  FUTURE 
is
+returned by `async-start` or `async-start-process` when its FINISH-FUNC is
+`nil`.
+
+## async-ready
+
+    async-ready FUTURE
+
+Query a FUTURE to see if its function's value is ready -- i.e., if no blocking
+would result from a call to `async-get` on that FUTURE.
+
+## async-wait
+
+    async-wait FUTURE
+
+Wait for FUTURE to become ready.
+
+## async-inject-variables
+
+    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)
diff --git a/packages/async/async-bytecomp.el b/packages/async/async-bytecomp.el
new file mode 100644
index 0000000..53d288d
--- /dev/null
+++ b/packages/async/async-bytecomp.el
@@ -0,0 +1,172 @@
+;;; async-bytecomp.el --- Async functions to compile elisp files async
+
+;; Copyright (C) 2014 John Wiegley
+;; Copyright (C) 2014 Thierry Volpiatto
+
+;; Authors: John Wiegley <address@hidden>
+;;          Thierry Volpiatto <address@hidden>
+
+;; 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)
+(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'.
+  (let* ((pkg-desc (cadr (assq pkg package-archive-contents)))
+         (direct-deps (cl-loop for p in (package-desc-reqs pkg-desc)
+                               for name = (car p)
+                               when (assq name package-archive-contents)
+                               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
diff --git a/packages/async/async-pkg.el b/packages/async/async-pkg.el
new file mode 100644
index 0000000..0268724
--- /dev/null
+++ b/packages/async/async-pkg.el
@@ -0,0 +1,12 @@
+;;; async-pkg.el
+
+(define-package "async" "1.6"
+  "Asynchronous processing in Emacs"
+  '((emacs "24")
+    (cl-lib "0.5"))
+  :url "https://github.com/jwiegley/emacs-async";)
+
+;; Local Variables:
+;; no-byte-compile: t
+;; End:
+
diff --git a/packages/async/async-test.el b/packages/async/async-test.el
new file mode 100644
index 0000000..e37e33d
--- /dev/null
+++ b/packages/async/async-test.el
@@ -0,0 +1,140 @@
+;;; async-test.el --- async.el-related tests
+
+;; Copyright (C) 2012~2014 John Wiegley
+
+;; Author: John Wiegley <address@hidden>
+;; Created: 10 Jul 2012
+;; Version: 1.0
+;; 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:
+
+;; Contains tests for all the async modules.
+
+;;; Code:
+
+(require 'async)
+
+
+(eval-when-compile
+  (require 'cl))
+
+(defun async-test-1 ()
+  (interactive)
+  (message "Starting async-test-1...")
+  (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)))
+  (message "Starting async-test-1...done"))
+
+(defun async-test-2 ()
+  (interactive)
+  (message "Starting async-test-2...")
+  (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 "Async process done, result should be 222: %s"
+             (async-get proc))))
+
+(defun async-test-3 ()
+  (interactive)
+  (message "Starting async-test-3...")
+  (async-start
+   ;; What to do in the child process
+   (lambda ()
+     (message "This is a test")
+     (sleep-for 3)
+     (error "Error in child process")
+     222)
+
+   ;; What to do when it finishes
+   (lambda (result)
+     (message "Async process done, result should be 222: %s" result)))
+  (message "Starting async-test-1...done"))
+
+(defun async-test-4 ()
+  (interactive)
+  (message "Starting async-test-4...")
+  (async-start-process "sleep" "sleep"
+                       ;; What to do when it finishes
+                       (lambda (proc)
+                         (message "Sleep done, exit code was %d"
+                                  (process-exit-status proc)))
+                       "3")
+  (message "Starting async-test-4...done"))
+
+(defun async-test-5 ()
+  (interactive)
+  (message "Starting async-test-5...")
+  (let ((proc
+         (async-start
+          ;; What to do in the child process
+          (lambda ()
+            (message "This is a test, sending message")
+            (async-send :hello "world")
+            ;; wait for a message
+            (let ((msg (async-receive)))
+              (message "Child got message: %s"
+                       (plist-get msg :goodbye)))
+            (sleep-for 3)
+            222)
+
+          ;; What to do when it finishes
+          (lambda (result)
+            (if (async-message-p result)
+                (message "Got hello from child process: %s"
+                         (plist-get result :hello))
+              (message "Async process done, result should be 222: %s"
+                       result))))))
+    (async-send proc :goodbye "everyone"))
+  (message "Starting async-test-5...done"))
+
+(defun async-test-6 ()
+  (interactive)
+  (message "Starting async-test-6...")
+  (async-start
+   ;; What to do in the child process
+   `(lambda ()
+      ,(async-inject-variables "\\`user-mail-address\\'")
+      (format "user-mail-address = %s" user-mail-address))
+
+   ;; What to do when it finishes
+   (lambda (result)
+     (message "Async process done: %s" result))))
+
+
+(provide 'async-test)
+
+;;; async-test.el ends here
+
+;; Local Variables:
+;; no-byte-compile: t
+;; End:
diff --git a/packages/async/async.el b/packages/async/async.el
new file mode 100644
index 0000000..2f57932
--- /dev/null
+++ b/packages/async/async.el
@@ -0,0 +1,292 @@
+;;; async.el --- Asynchronous processing in Emacs
+
+;; Copyright (C) 2012~2014 John Wiegley
+
+;; Author: John Wiegley <address@hidden>
+;; Created: 18 Jun 2012
+
+;; 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 sentinal 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)))
+    (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)
+    (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."
+  (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 the ready 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))
+       (with-current-buffer (process-buffer future)
+         async-callback-value-set)))
+
+(defun async-wait (future)
+  "Wait for FUTURE to become ready."
+  (while (not (async-ready future))
+    (sit-for 0.05)))
+
+(defun async-get (future)
+  "Get the value from an asynchronously function when it is ready.
+FUTURE is returned by `async-start' or `async-start-process' when
+its FINISH-FUNC is nil."
+  (async-wait future)
+  (with-current-buffer (process-buffer future)
+    (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 (&rest args)
+  "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 form 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))
+    (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)))
+
+(provide 'async)
+
+;;; async.el ends here
diff --git a/packages/async/dired-async.el b/packages/async/dired-async.el
new file mode 100644
index 0000000..3f5349d
--- /dev/null
+++ b/packages/async/dired-async.el
@@ -0,0 +1,291 @@
+;;; dired-async.el --- Copy/move/delete asynchronously in dired.
+
+;; Copyright (C) 2012~2014 John Wiegley
+;; Copyright (C) 2012~2014 Thierry Volpiatto
+
+;; Authors: John Wiegley <address@hidden>
+;;          Thierry Volpiatto <address@hidden>
+
+;; 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))
+(defvar dired-async-operation nil)
+
+(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-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 &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 'dired-async-message))))
+    (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))))
+    (delete-process proc)
+    (unless (> (length processes) 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--modeline-mode -1))
+  (when dired-async-operation
+    (if (file-exists-p dired-async-log-file)
+        (progn
+          (pop-to-buffer (get-buffer-create "*dired async*"))
+          (erase-buffer)
+          (insert "Error: ")
+          (insert-file-contents dired-async-log-file)
+          (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))))
+
+(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))))))
+
+(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 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
+      (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 (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 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)))))
+      (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)
+                                    (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)))))
+                      ,(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)
+  (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)
+
+;;; dired-async.el ends here
diff --git a/packages/async/smtpmail-async.el b/packages/async/smtpmail-async.el
new file mode 100644
index 0000000..99c4017
--- /dev/null
+++ b/packages/async/smtpmail-async.el
@@ -0,0 +1,73 @@
+;;; smtpmail-async.el --- Send e-mail with smtpmail.el asynchronously
+
+;; Copyright (C) 2012~2014 John Wiegley
+
+;; Author: John Wiegley <address@hidden>
+;; 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"
+            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



reply via email to

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