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 `async-get' on when you're ready to wait for the result
  43 ;; 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 \f
  56 ;;; Code:
  57
  58 (defgroup async nil
  59   "Simple asynchronous processing in Emacs"
  60   :group 'emacs)
  61
  62 (defvar async-callback)
  63 (defvar async-callback-value nil)
  64 (defvar async-callback-value-set nil)
  65
  66 (defun async-when-done (proc &optional change)
  67   "Process sentinal used to retrieve the value from the child process."
  68   (when (eq 'exit (process-status proc))
  69     (with-current-buffer (process-buffer proc)
  70       (if (= 0 (process-exit-status proc))
  71           (progn
  72             (goto-char (point-max))
  73             (backward-sexp)
  74             (let ((result (read (current-buffer))))
  75               (if async-callback
  76                   (prog1
  77                       (funcall async-callback result)
  78                     (kill-buffer (current-buffer)))
  79                 (set (make-local-variable 'async-callback-value) result)
  80                 (set (make-local-variable 'async-callback-value-set) t))))
  81         (set (make-local-variable 'async-callback-value) 'error)
  82         (set (make-local-variable 'async-callback-value-set) t)
  83         (error "Async Emacs process failed with exit code %d"
  84                (process-exit-status proc))))))
  85
  86 (defun async-batch-invoke ()
  87   "Called from the child Emacs process' command-line."
  88   (with-temp-buffer
  89     (insert (nth 5 command-line-args))
  90     (goto-char (point-min))
  91     ;; Strip out the binding to `buf', as it is unreadable
  92     (while (re-search-forward "(buf \\. #<[^)]+)" nil t)
  93       (delete-region (match-beginning 0) (match-end 0)))
  94     (goto-char (point-min))
  95     (prin1 (funcall (eval (read (current-buffer)))))))
  96
  97 (defun async-get (proc)
  98   "Wait until PROC has successfully completed."
  99   (with-current-buffer (process-buffer proc)
 100     (while (and (not (eq 'exit (process-status proc)))
 101                 (not async-callback-value-set))
 102       (sit-for 0 50))
 103     (prog1
 104         async-callback-value
 105       (kill-buffer (current-buffer)))))
 106
 107 (defmacro async-start (start-func &optional finish-func)
 108   "Fork execution of `start-func' into its own Emacs process.
 109 `start-func' must be a `read'-able symbol or lambda form.  It
 110 cannot be a byte-compiled lambda.
 111
 112 `finish-func' is called with the result of `start-func' when that
 113 process has completed.  If it is nil, `async-start' will return a
 114 process object that you can block on with `async-future-get' in
 115 order to wait for the result of `start-func'.  This would allow
 116 you to start some expensive background processing at the
 117 beginning of a command, then wait for the result only when you're
 118 ready to use it."
 119   (let ((bufvar (make-symbol "buf"))
 120         (procvar (make-symbol "proc")))
 121     (require 'find-func)
 122     `(let* ((,bufvar (generate-new-buffer "*emacs*"))
 123             (,procvar
 124              (start-process "emacs" ,bufvar
 125                             (expand-file-name invocation-name
 126                                               invocation-directory)
 127                             "-Q" "-l" (find-library-name "async")
 128                             "-batch" "-f" "async-batch-invoke"
 129                             (prin1-to-string (list 'quote ,start-func)))))
 130        (with-current-buffer ,bufvar
 131          (set (make-local-variable 'async-callback) ,finish-func)
 132          (set-process-sentinel ,procvar #'async-when-done)
 133          ,procvar))))
 134
 135 (defun async-test-1 ()
 136   (interactive)
 137   (message "Starting async-test-1...")
 138   (async-start
 139    ;; What to do in the child process
 140    (lambda ()
 141      (message "This is a test")
 142      (sleep-for 3)
 143      222)
 144
 145    ;; What to do when it finishes
 146    (lambda (result)
 147      (message "Async process done, result should be 222: %s" result)))
 148   (message "Starting async-test-1...done"))
 149
 150 (defun async-test-2 ()
 151   (interactive)
 152   (message "Starting async-test-2...")
 153   (let ((proc (async-start
 154                ;; What to do in the child process
 155                (lambda ()
 156                  (message "This is a test")
 157                  (sleep-for 3)
 158                  222))))
 159     (message "I'm going to do some work here")
 160     ;; ....
 161     (message "Async process done, result should be 222: %s" (async-get proc))))
 162
 163 (provide 'async)
 164
 165 ;;; async.el ends here