-;;; async --- Asynchronous processing in Emacs
+;;; async.el --- Asynchronous processing in Emacs
-;; Copyright (C) 2012 John Wiegley
+;; Copyright (C) 2012~2014 John Wiegley
;; Author: John Wiegley <jwiegley@gmail.com>
;; Created: 18 Jun 2012
-;; Version: 1.1
+
;; Keywords: async
;; X-URL: https://github.com/jwiegley/emacs-async
:group 'emacs)
(defvar async-debug nil)
-(defvar async-send-over-pipe 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)
(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))
(set (make-local-variable 'async-callback-value-set) t))
(goto-char (point-max))
(backward-sexp)
- (let ((result (read (current-buffer))))
- (if (and (listp result)
- (eq 'async-signal (car result)))
- (if (eq 'error (car (cdr result)))
- (error (cadr (cdr result)))
- (signal (cadr result)
- (cddr result)))
- (if async-callback
- (prog1
- (funcall async-callback result)
- (unless async-debug
- (kill-buffer (current-buffer))))
- (set (make-local-variable 'async-callback-value) result)
- (set (make-local-variable 'async-callback-value-set) t)))))
- (set (make-local-variable 'async-callback-value) 'error)
- (set (make-local-variable 'async-callback-value-set) t)
- (error "Async process '%s' failed with exit code %d"
- (process-name proc) (process-exit-status proc)))))))
+ (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 (read (base64-decode-string (read 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)
- (prin1 sexp (current-buffer))
- ;; Just in case the string we're sending might contain EOF
- (base64-encode-region (point-min) (point-max) t)
- (goto-char (point-min)) (insert ?\")
- (goto-char (point-max)) (insert ?\" ?\n))
+ (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
(defun async-batch-invoke ()
"Called from the child Emacs process' command-line."
- (setq async-in-child-emacs t)
- (condition-case err
+ (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))))
- (error
- (backtrace)
- (prin1 `(async-signal . ,err)))))
+ (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 (eq 'exit (process-status future))
- async-callback-value-set))
+ (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."
its FINISH-FUNC is nil."
(async-wait future)
(with-current-buffer (process-buffer future)
- (prog1
- async-callback-value
- (kill-buffer (current-buffer)))))
+ (async-handle-result #'identity async-callback-value (current-buffer))))
(defun async-message-p (value)
"Return true of VALUE is an async.el message packet."
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."
+finished. Set DEFAULT-DIRECTORY to change PROGRAM's current
+working directory."
(let* ((buf (generate-new-buffer (concat "*" name "*")))
- (proc (apply #'start-process name buf program program-args)))
+ (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)
proc)))
;;;###autoload
-(defmacro async-start (start-func &optional finish-func)
+(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:
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'."
- (require 'find-func)
- (let ((procvar (make-symbol "proc")))
- `(let* ((sexp ,start-func)
- (,procvar
- (async-start-process
- "emacs" (expand-file-name invocation-name
- invocation-directory)
- ,finish-func
- "-Q" "-l" ,(find-library-name "async")
- "-batch" "-f" "async-batch-invoke"
- ,@(unless async-send-over-pipe
- '((with-temp-buffer
- (async--insert-sexp (list 'quote sexp))
- (buffer-string)))))))
- ,@(if async-send-over-pipe
- `((async--transmit-sexp ,procvar (list 'quote sexp))))
- ,procvar)))
-
-(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))))
+ (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)