1 ;;; async.el --- Asynchronous processing in Emacs
3 ;; Copyright (C) 2012-2016 Free Software Foundation, Inc.
5 ;; Author: John Wiegley <jwiegley@gmail.com>
6 ;; Created: 18 Jun 2012
10 ;; X-URL: https://github.com/jwiegley/emacs-async
12 ;; This program is free software; you can redistribute it and/or
13 ;; modify it under the terms of the GNU General Public License as
14 ;; published by the Free Software Foundation; either version 2, or (at
15 ;; your option) any later version.
17 ;; This program is distributed in the hope that it will be useful, but
18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
20 ;; General Public License for more details.
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with GNU Emacs; see the file COPYING. If not, write to the
24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
25 ;; Boston, MA 02111-1307, USA.
29 ;; Adds the ability to call asynchronous functions and process with ease. See
30 ;; the documentation for `async-start' and `async-start-process'.
35 "Simple asynchronous processing in Emacs"
38 (defvar async-debug nil)
39 (defvar async-send-over-pipe t)
40 (defvar async-in-child-emacs nil)
41 (defvar async-callback nil)
42 (defvar async-callback-for-process nil)
43 (defvar async-callback-value nil)
44 (defvar async-callback-value-set nil)
45 (defvar async-current-process nil)
46 (defvar async--procvar nil)
48 (defun async-inject-variables
49 (include-regexp &optional predicate exclude-regexp)
50 "Return a `setq' form that replicates part of the calling environment.
51 It sets the value for every variable matching INCLUDE-REGEXP and
52 also PREDICATE. It will not perform injection for any variable
53 matching EXCLUDE-REGEXP (if present). It is intended to be used
60 (insert ,(buffer-substring-no-properties (point-min) (point-max)))
61 ;; Pass in the variable environment for smtpmail
62 ,(async-inject-variables \"\\`\\(smtpmail\\|\\(user-\\)?mail\\)-\")
70 (or (null include-regexp)
71 (string-match include-regexp (symbol-name sym)))
73 (or exclude-regexp "-syntax-table\\'")
75 (let ((value (symbol-value sym)))
76 (when (or (null predicate)
77 (funcall predicate sym))
78 (setq bindings (cons `(quote ,value) bindings)
79 bindings (cons sym bindings)))))))
82 (defalias 'async-inject-environment 'async-inject-variables)
84 (defun async-handle-result (func result buf)
87 (set (make-local-variable 'async-callback-value) result)
88 (set (make-local-variable 'async-callback-value-set) t))
90 (if (and (listp result)
91 (eq 'async-signal (nth 0 result)))
92 (signal (car (nth 1 result))
94 (funcall func result))
98 (defun async-when-done (proc &optional change)
99 "Process sentinal used to retrieve the value from the child process."
100 (when (eq 'exit (process-status proc))
101 (with-current-buffer (process-buffer proc)
102 (let ((async-current-process proc))
103 (if (= 0 (process-exit-status proc))
104 (if async-callback-for-process
107 (funcall async-callback proc)
109 (kill-buffer (current-buffer))))
110 (set (make-local-variable 'async-callback-value) proc)
111 (set (make-local-variable 'async-callback-value-set) t))
112 (goto-char (point-max))
114 (async-handle-result async-callback (read (current-buffer))
116 (set (make-local-variable 'async-callback-value)
118 (format "Async process '%s' failed with exit code %d"
119 (process-name proc) (process-exit-status proc))))
120 (set (make-local-variable 'async-callback-value-set) t))))))
122 (defun async--receive-sexp (&optional stream)
123 (let ((sexp (decode-coding-string (base64-decode-string
124 (read stream)) 'utf-8-unix))
125 ;; Parent expects UTF-8 encoded text.
126 (coding-system-for-write 'utf-8-unix))
128 (message "Received sexp {{{%s}}}" (pp-to-string sexp)))
129 (setq sexp (read sexp))
131 (message "Read sexp {{{%s}}}" (pp-to-string sexp)))
134 (defun async--insert-sexp (sexp)
135 (let (print-level print-length)
136 (prin1 sexp (current-buffer))
137 ;; Just in case the string we're sending might contain EOF
138 (encode-coding-region (point-min) (point-max) 'utf-8-unix)
139 (base64-encode-region (point-min) (point-max) t)
140 (goto-char (point-min)) (insert ?\")
141 (goto-char (point-max)) (insert ?\" ?\n)))
143 (defun async--transmit-sexp (process sexp)
146 (message "Transmitting sexp {{{%s}}}" (pp-to-string sexp)))
147 (async--insert-sexp sexp)
148 (process-send-region process (point-min) (point-max))))
150 (defun async-batch-invoke ()
151 "Called from the child Emacs process' command-line."
152 ;; Make sure 'message' and 'prin1' encode stuff in UTF-8, as parent
154 (let ((coding-system-for-write 'utf-8-unix))
155 (setq async-in-child-emacs t
156 debug-on-error async-debug)
159 (async--receive-sexp (unless async-send-over-pipe
160 command-line-args-left))))
163 (async--receive-sexp (unless async-send-over-pipe
164 command-line-args-left))))
166 (prin1 (list 'async-signal err)))))))
168 (defun async-ready (future)
169 "Query a FUTURE to see if the ready is ready -- i.e., if no blocking
170 would result from a call to `async-get' on that FUTURE."
171 (and (memq (process-status future) '(exit signal))
172 (with-current-buffer (process-buffer future)
173 async-callback-value-set)))
175 (defun async-wait (future)
176 "Wait for FUTURE to become ready."
177 (while (not (async-ready future))
180 (defun async-get (future)
181 "Get the value from an asynchronously function when it is ready.
182 FUTURE is returned by `async-start' or `async-start-process' when
183 its FINISH-FUNC is nil."
185 (with-current-buffer (process-buffer future)
186 (async-handle-result #'identity async-callback-value (current-buffer))))
188 (defun async-message-p (value)
189 "Return true of VALUE is an async.el message packet."
191 (plist-get value :async-message)))
193 (defun async-send (&rest args)
194 "Send the given messages to the asychronous Emacs PROCESS."
195 (let ((args (append args '(:async-message t))))
196 (if async-in-child-emacs
198 (funcall async-callback args))
199 (async--transmit-sexp (car args) (list 'quote (cdr args))))))
201 (defun async-receive (&rest args)
202 "Send the given messages to the asychronous Emacs PROCESS."
203 (async--receive-sexp))
206 (defun async-start-process (name program finish-func &rest program-args)
207 "Start the executable PROGRAM asynchronously. See `async-start'.
208 PROGRAM is passed PROGRAM-ARGS, calling FINISH-FUNC with the
209 process object when done. If FINISH-FUNC is nil, the future
210 object will return the process object when the program is
211 finished. Set DEFAULT-DIRECTORY to change PROGRAM's current
213 (let* ((buf (generate-new-buffer (concat "*" name "*")))
214 (proc (let ((process-connection-type nil))
215 (apply #'start-process name buf program program-args))))
216 (with-current-buffer buf
217 (set (make-local-variable 'async-callback) finish-func)
218 (set-process-sentinel proc #'async-when-done)
219 (unless (string= name "emacs")
220 (set (make-local-variable 'async-callback-for-process) t))
224 (defun async-start (start-func &optional finish-func)
225 "Execute START-FUNC (often a lambda) in a subordinate Emacs process.
226 When done, the return value is passed to FINISH-FUNC. Example:
229 ;; What to do in the child process
231 (message \"This is a test\")
235 ;; What to do when it finishes
237 (message \"Async process done, result should be 222: %s\"
240 If FINISH-FUNC is nil or missing, a future is returned that can
241 be inspected using `async-get', blocking until the value is
244 (let ((proc (async-start
245 ;; What to do in the child process
247 (message \"This is a test\")
251 (message \"I'm going to do some work here\") ;; ....
253 (message \"Waiting on async process, result should be 222: %s\"
256 If you don't want to use a callback, and you don't care about any
257 return value form the child process, pass the `ignore' symbol as
258 the second argument (if you don't, and never call `async-get', it
259 will leave *emacs* process buffers hanging around):
263 (delete-file \"a remote file on a slow link\" nil))
266 Note: Even when FINISH-FUNC is present, a future is still
267 returned except that it yields no value (since the value is
268 passed to FINISH-FUNC). Call `async-get' on such a future always
269 returns nil. It can still be useful, however, as an argument to
270 `async-ready' or `async-wait'."
271 (let ((sexp start-func)
272 ;; Subordinate Emacs will send text encoded in UTF-8.
273 (coding-system-for-read 'utf-8-unix))
276 "emacs" (file-truename
277 (expand-file-name invocation-name
278 invocation-directory))
281 ;; Using `locate-library' ensure we use the right file
282 ;; when the .elc have been deleted.
283 (locate-library "async")
284 "-batch" "-f" "async-batch-invoke"
285 (if async-send-over-pipe
288 (async--insert-sexp (list 'quote sexp))
290 (if async-send-over-pipe
291 (async--transmit-sexp async--procvar (list 'quote sexp)))
294 (defmacro async-sandbox(func)
295 "Evaluate FUNC in a separate Emacs process, synchronously."
296 `(async-get (async-start ,func)))
300 ;;; async.el ends here