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.1
   8 ;; Keywords: async
   9 ;; X-URL: https://github.com/jwiegley/emacs-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 call asynchronous functions and process with ease.  See
  29 ;; the documentation for `async-start' and `async-start-process'.
  30 \f
  31 ;;; Code:
  32
  33 (defgroup async nil
  34   "Simple asynchronous processing in Emacs"
  35   :group 'emacs)
  36
  37 (defvar async-callback nil)
  38 (defvar async-callback-for-process nil)
  39 (defvar async-callback-value nil)
  40 (defvar async-callback-value-set nil)
  41
  42 (defmacro async-inject-variables
  43   (include-regexp &optional predicate exclude-regexp)
  44   "Return a `setq' form that replicates part of the calling environment.
  45 It sets the value for every variable matching INCLUDE-REGEXP and
  46 also PREDICATE.  It will not perform injection for any variable
  47 matching EXCLUDE-REGEXP (if present).  It is intended to be used
  48 as follows:
  49
  50     (async-start
  51        `(lambda ()
  52           (require 'smtpmail)
  53           (with-temp-buffer
  54             (insert ,(buffer-substring-no-properties (point-min) (point-max)))
  55             ;; Pass in the variable environment for smtpmail
  56             ,(async-inject-variables \"\\`\\(smtpmail\\|\\(user-\\)?mail\\)-\")
  57             (smtpmail-send-it)))
  58        'ignore)"
  59   `'(setq
  60      ,@(let (bindings)
  61          (mapatoms
  62           (lambda (sym)
  63             (if (and (boundp sym)
  64                      (or (null include-regexp)
  65                          (string-match include-regexp (symbol-name sym)))
  66                      (not (string-match
  67                            (or exclude-regexp "-syntax-table\\'")
  68                            (symbol-name sym))))
  69                 (let ((value (symbol-value sym)))
  70                   (when (funcall (or predicate
  71                                      (lambda (sym)
  72                                        (let ((value (symbol-value sym)))
  73                                          (or (not (functionp value))
  74                                              (symbolp value)))))
  75                                  sym)
  76                     (setq bindings (cons `(quote ,value) bindings)
  77                           bindings (cons sym bindings)))))))
  78          bindings)))
  79
  80 (defalias 'async-inject-environment 'async-inject-variables)
  81
  82 (defun async-when-done (proc &optional change)
  83   "Process sentinal used to retrieve the value from the child process."
  84   (when (eq 'exit (process-status proc))
  85     (with-current-buffer (process-buffer proc)
  86       (if (= 0 (process-exit-status proc))
  87           (if async-callback-for-process
  88               (if async-callback
  89                   (prog1
  90                       (funcall async-callback proc)
  91                     (kill-buffer (current-buffer)))
  92                 (set (make-local-variable 'async-callback-value) proc)
  93                 (set (make-local-variable 'async-callback-value-set) t))
  94             (goto-char (point-max))
  95             (backward-sexp)
  96             (let ((result (read (current-buffer))))
  97               (if (and (listp result)
  98                        (eq 'async-signal (car result)))
  99                   (if (eq 'error (car (cdr result)))
 100                       (error (cadr (cdr result)))
 101                     (signal (cadr result)
 102                             (cddr result)))
 103                 (if async-callback
 104                     (prog1
 105                         (funcall async-callback result)
 106                       (kill-buffer (current-buffer)))
 107                   (set (make-local-variable 'async-callback-value) result)
 108                   (set (make-local-variable 'async-callback-value-set) t)))))
 109         (set (make-local-variable 'async-callback-value) 'error)
 110         (set (make-local-variable 'async-callback-value-set) t)
 111         (error "Async Emacs process failed with exit code %d"
 112                (process-exit-status proc))))))
 113
 114 (defun async-batch-invoke ()
 115   "Called from the child Emacs process' command-line."
 116   (condition-case err
 117       (prin1 (funcall (eval (read nil))))
 118     (error
 119      (prin1 `(async-signal . ,err)))))
 120
 121 (defun async-ready (future)
 122   "Query a FUTURE to see if the ready is ready -- i.e., if no blocking
 123 would result from a call to `async-get' on that FUTURE."
 124   (and (eq 'exit (process-status future))
 125        async-callback-value-set))
 126
 127 (defun async-wait (future)
 128   "Wait for FUTURE to become ready."
 129   (while (not (async-ready future))
 130     (sit-for 0 50)))
 131
 132 (defun async-get (future)
 133   "Get the value from an asynchronously function when it is ready.
 134 FUTURE is returned by `async-start' or `async-start-process' when
 135 its FINISH-FUNC is nil."
 136   (async-wait future)
 137   (with-current-buffer (process-buffer future)
 138     (prog1
 139         async-callback-value
 140       (kill-buffer (current-buffer)))))
 141
 142 ;;;###autoload
 143 (defmacro async-start-process (name program finish-func &rest program-args)
 144   "Start the executable PROGRAM asynchronously.  See `async-start'.
 145 PROGRAM is passed PROGRAM-ARGS, calling FINISH-FUNC with the
 146 process object when done.  If FINISH-FUNC is nil, the future
 147 object will return the process object when the program is
 148 finished."
 149 (let ((bufvar (make-symbol "buf"))
 150       (procvar (make-symbol "proc")))
 151   `(let* ((,bufvar (generate-new-buffer ,(concat "*" name "*")))
 152           (,procvar
 153            ,`(apply #'start-process ,name ,bufvar ,program
 154                     (quote ,program-args))))
 155      (with-current-buffer ,bufvar
 156        (set (make-local-variable 'async-callback) ,finish-func)
 157        (set-process-sentinel ,procvar #'async-when-done)
 158        ,(unless (string= name "emacs")
 159           '(set (make-local-variable 'async-callback-for-process) t))
 160        ,procvar))))
 161
 162 ;;;###autoload
 163 (defmacro async-start (start-func &optional finish-func)
 164   "Execute START-FUNC (often a lambda) in a subordinate Emacs process.
 165 When done, the return value is passed to FINISH-FUNC.  Example:
 166
 167     (async-start
 168        ;; What to do in the child process
 169        (lambda ()
 170          (message \"This is a test\")
 171          (sleep-for 3)
 172          222)
 173
 174        ;; What to do when it finishes
 175        (lambda (result)
 176          (message \"Async process done, result should be 222: %s\"
 177                   result)))
 178
 179 If FINISH-FUNC is nil or missing, a future is returned that can
 180 be inspected using `async-get', blocking until the value is
 181 ready.  Example:
 182
 183     (let ((proc (async-start
 184                    ;; What to do in the child process
 185                    (lambda ()
 186                      (message \"This is a test\")
 187                      (sleep-for 3)
 188                      222))))
 189
 190         (message \"I'm going to do some work here\") ;; ....
 191
 192         (message \"Waiting on async process, result should be 222: %s\"
 193                  (async-get proc)))
 194
 195 If you don't want to use a callback, and you don't care about any
 196 return value form the child process, pass the `ignore' symbol as
 197 the second argument (if you don't, and never call `async-get', it
 198 will leave *emacs* process buffers hanging around):
 199
 200     (async-start
 201      (lambda ()
 202        (delete-file \"a remote file on a slow link\" nil))
 203      'ignore)
 204
 205 Note: Even when FINISH-FUNC is present, a future is still
 206 returned except that it yields no value (since the value is
 207 passed to FINISH-FUNC).  Call `async-get' on such a future always
 208 returns nil.  It can still be useful, however, as an argument to
 209 `async-ready' or `async-wait'."
 210   (require 'find-func)
 211   (let ((procvar (make-symbol "proc")))
 212     `(let ((,procvar
 213             (async-start-process "emacs" (expand-file-name invocation-name
 214                                                            invocation-directory)
 215                                  ,finish-func
 216                                  "-Q" "-l" ,(find-library-name "async")
 217                                  "-batch" "-f" "async-batch-invoke")))
 218        (with-current-buffer (process-buffer ,procvar)
 219          (with-temp-buffer
 220            (let ((print-escape-newlines t))
 221              (prin1 (list 'quote ,start-func) (current-buffer)))
 222            (insert ?\n)
 223            (process-send-region ,procvar (point-min) (point-max))
 224            (process-send-eof ,procvar))
 225          ,procvar))))
 226
 227 (defun async-test-1 ()
 228   (interactive)
 229   (message "Starting async-test-1...")
 230   (async-start
 231    ;; What to do in the child process
 232    (lambda ()
 233      (message "This is a test")
 234      (sleep-for 3)
 235      222)
 236
 237    ;; What to do when it finishes
 238    (lambda (result)
 239      (message "Async process done, result should be 222: %s" result)))
 240   (message "Starting async-test-1...done"))
 241
 242 (defun async-test-2 ()
 243   (interactive)
 244   (message "Starting async-test-2...")
 245   (let ((proc (async-start
 246                ;; What to do in the child process
 247                (lambda ()
 248                  (message "This is a test")
 249                  (sleep-for 3)
 250                  222))))
 251     (message "I'm going to do some work here")
 252     ;; ....
 253     (message "Async process done, result should be 222: %s"
 254              (async-get proc))))
 255
 256 (defun async-test-3 ()
 257   (interactive)
 258   (message "Starting async-test-3...")
 259   (async-start
 260    ;; What to do in the child process
 261    (lambda ()
 262      (message "This is a test")
 263      (sleep-for 3)
 264      (error "Error in child process")
 265      222)
 266
 267    ;; What to do when it finishes
 268    (lambda (result)
 269      (message "Async process done, result should be 222: %s" result)))
 270   (message "Starting async-test-1...done"))
 271
 272 (defun async-test-4 ()
 273   (interactive)
 274   (message "Starting async-test-4...")
 275   (async-start-process "sleep" "sleep"
 276                        ;; What to do when it finishes
 277                        (lambda (proc)
 278                          (message "Sleep done, exit code was %d"
 279                                   (process-exit-status proc)))
 280                        "3")
 281   (message "Starting async-test-4...done"))
 282
 283 (provide 'async)
 284
 285 ;;; async.el ends here