code.delx.au - gnu-emacs-elpa/blob - async.el

   1 ;;; async --- Asynchronous processing in Emacs
   2
   3 ;; Copyright (C) 2012 John Wiegley
   4
   5 ;; Author: John Wiegley <jwiegley@gmail.com>
   6 ;; Created: 18 Jun 2012
   7 ;; Version: 1.0
   8 ;; Keywords: async
   9 ;; X-URL: https://github.com/jwiegley/async
  10
  11 ;; This program is free software; you can redistribute it and/or
  12 ;; modify it under the terms of the GNU General Public License as
  13 ;; published by the Free Software Foundation; either version 2, or (at
  14 ;; your option) any later version.
  15
  16 ;; This program is distributed in the hope that it will be useful, but
  17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  19 ;; General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  24 ;; Boston, MA 02111-1307, USA.
  25 \f
  26 ;;; Commentary:
  27
  28 ;; Adds the ability to process Lisp concurrently, with a very simple syntax:
  29 ;;
  30 ;;   (async-start
  31 ;;      ;; What to do in the child process
  32 ;;      (lambda ()
  33 ;;        (message "This is a test")
  34 ;;        (sleep-for 3)
  35 ;;        222)
  36 ;;
  37 ;;      ;; What to do when it finishes
  38 ;;      (lambda (result)
  39 ;;        (message "Async process done, result should be 222: %s" result)))
  40 ;;
  41 ;; If you omit the callback function, `async-start' will return a process
  42 ;; object that you can call `async-get' on when you're ready to wait for the
  43 ;; result value:
  44 ;;
  45 ;;   (let ((proc (async-start
  46 ;;                  ;; What to do in the child process
  47 ;;                  (lambda ()
  48 ;;                    (message "This is a test")
  49 ;;                    (sleep-for 3)
  50 ;;                    222))))
  51 ;;       (message "I'm going to do some work here")
  52 ;;       ;; ....
  53 ;;       (message "Async process done, result should be 222: %s"
  54 ;;                (async-get proc)))
  55 ;;
  56 ;; If you don't want to use a callback, and you don't care about any return
  57 ;; value form the child proces, pass the `ignore' symbol as the second
  58 ;; argument:
  59 ;;
  60 ;;   (async-start
  61 ;;    (lambda ()
  62 ;;      (delete-file "a remote file on a slow link" nil))
  63 ;;      'ignore)
  64 \f
  65 ;;; Code:
  66
  67 (defgroup async nil
  68   "Simple asynchronous processing in Emacs"
  69   :group 'emacs)
  70
  71 (defvar async-callback nil)
  72 (defvar async-callback-value nil)
  73 (defvar async-callback-value-set nil)
  74
  75 (defmacro async-inject-environment
  76   (include-regexp &optional predicate exclude-regexp)
  77   "Inject a part of the parent environment into an async function."
  78   `'(setq
  79      ,@(let (bindings)
  80          (mapatoms
  81           (lambda (sym)
  82             (if (and (boundp sym)
  83                      (or (null include-regexp)
  84                          (string-match include-regexp (symbol-name sym)))
  85                      (not (string-match
  86                            (or exclude-regexp "-syntax-table\\'")
  87                            (symbol-name sym))))
  88                 (let ((value (symbol-value sym)))
  89                   (when (funcall (or predicate
  90                                      (lambda (sym)
  91                                        (let ((value (symbol-value sym)))
  92                                          (or (not (functionp value))
  93                                              (symbolp value)))))
  94                                  sym)
  95                     (setq bindings (cons `(quote ,value) bindings)
  96                           bindings (cons sym bindings)))))))
  97          bindings)))
  98
  99 (defun async-when-done (proc &optional change)
 100   "Process sentinal used to retrieve the value from the child process."
 101   (when (eq 'exit (process-status proc))
 102     (with-current-buffer (process-buffer proc)
 103       (if (= 0 (process-exit-status proc))
 104           (progn
 105             (goto-char (point-max))
 106             (backward-sexp)
 107             (let ((result (read (current-buffer))))
 108               (if (and (listp result)
 109                        (eq 'async-signal (car result)))
 110                   (if (eq 'error (car (cdr result)))
 111                       (error (cadr (cdr result)))
 112                     (signal (cadr result)
 113                             (cddr result)))
 114                 (if async-callback
 115                     (prog1
 116                         (funcall async-callback result)
 117                       (kill-buffer (current-buffer)))
 118                   (set (make-local-variable 'async-callback-value) result)
 119                   (set (make-local-variable 'async-callback-value-set) t)))))
 120         (set (make-local-variable 'async-callback-value) 'error)
 121         (set (make-local-variable 'async-callback-value-set) t)
 122         (error "Async Emacs process failed with exit code %d"
 123                (process-exit-status proc))))))
 124
 125 (defun async-batch-invoke ()
 126   "Called from the child Emacs process' command-line."
 127   (condition-case err
 128       (prin1 (funcall (eval (read nil))))
 129     (signal
 130      (prin1 `(async-signal . ,err)))
 131     (error
 132      (prin1 `(async-signal . ,err)))))
 133
 134 (defun async-ready (proc)
 135   "Wait until PROC has successfully completed."
 136   (and (eq 'exit (process-status proc))
 137        async-callback-value-set))
 138
 139 (defun async-wait (proc)
 140   "Wait until PROC has successfully completed."
 141   (while (not (async-ready proc))
 142     (sit-for 0 50)))
 143
 144 (defun async-get (proc)
 145   "Wait until PROC has successfully completed."
 146   (async-wait proc)
 147   (with-current-buffer (process-buffer proc)
 148     (prog1
 149         async-callback-value
 150       (kill-buffer (current-buffer)))))
 151
 152 (defmacro async-start (start-func &optional finish-func)
 153   "Fork execution of `start-func' into its own Emacs process.
 154 `start-func' must be a `read'-able symbol or lambda form.  It
 155 cannot be a byte-compiled lambda.
 156
 157 `finish-func' is called with the result of `start-func' when that
 158 process has completed.  If it is nil, `async-start' will return a
 159 process object that you can block on with `async-future-get' in
 160 order to wait for the result of `start-func'.  This would allow
 161 you to start some expensive background processing at the
 162 beginning of a command, then wait for the result only when you're
 163 ready to use it."
 164   (let ((bufvar (make-symbol "buf"))
 165         (procvar (make-symbol "proc")))
 166     (require 'find-func)
 167     `(let* ((,bufvar (generate-new-buffer "*emacs*"))
 168             (,procvar
 169              (start-process "emacs" ,bufvar
 170                             (expand-file-name invocation-name
 171                                               invocation-directory)
 172                             "-Q" "-l" (find-library-name "async")
 173                             "-batch" "-f" "async-batch-invoke")))
 174        (with-current-buffer ,bufvar
 175          (set (make-local-variable 'async-callback) ,finish-func)
 176          (set-process-sentinel ,procvar #'async-when-done)
 177          (with-temp-buffer
 178            (let ((print-escape-newlines t))
 179              (prin1 (list 'quote ,start-func) (current-buffer)))
 180            (insert ?\n)
 181            (process-send-region ,procvar (point-min) (point-max))
 182            (process-send-eof ,procvar))
 183          ,procvar))))
 184
 185 (defun async-test-1 ()
 186   (interactive)
 187   (message "Starting async-test-1...")
 188   (async-start
 189    ;; What to do in the child process
 190    (lambda ()
 191      (message "This is a test")
 192      (sleep-for 3)
 193      222)
 194
 195    ;; What to do when it finishes
 196    (lambda (result)
 197      (message "Async process done, result should be 222: %s" result)))
 198   (message "Starting async-test-1...done"))
 199
 200 (defun async-test-2 ()
 201   (interactive)
 202   (message "Starting async-test-2...")
 203   (let ((proc (async-start
 204                ;; What to do in the child process
 205                (lambda ()
 206                  (message "This is a test")
 207                  (sleep-for 3)
 208                  222))))
 209     (message "I'm going to do some work here")
 210     ;; ....
 211     (message "Async process done, result should be 222: %s"
 212              (async-get proc))))
 213
 214 (defun async-test-3 ()
 215   (interactive)
 216   (message "Starting async-test-3...")
 217   (async-start
 218    ;; What to do in the child process
 219    (lambda ()
 220      (message "This is a test")
 221      (sleep-for 3)
 222      (error "Error in child process")
 223      222)
 224
 225    ;; What to do when it finishes
 226    (lambda (result)
 227      (message "Async process done, result should be 222: %s" result)))
 228   (message "Starting async-test-1...done"))
 229
 230 (provide 'async)
 231
 232 ;;; async.el ends here