-;;; async --- Asynchronous processing in Emacs
+;;; async.el --- Asynchronous processing in Emacs -*- lexical-binding: t -*-
-;; Copyright (C) 2012~2013 John Wiegley
+;; Copyright (C) 2012-2016 Free Software Foundation, Inc.
;; Author: John Wiegley <jwiegley@gmail.com>
;; Created: 18 Jun 2012
-;; Version: 1.1
+;; Version: 1.6
+
;; Keywords: async
;; X-URL: https://github.com/jwiegley/emacs-async
(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)
(unless async-debug
(kill-buffer buf)))))
-(defun async-when-done (proc &optional change)
- "Process sentinal used to retrieve the value from the child process."
+(defun async-when-done (proc &optional _change)
+ "Process sentinel used to retrieve the value from the child process."
(when (eq 'exit (process-status proc))
(with-current-buffer (process-buffer proc)
(let ((async-current-process proc))
(defun async--receive-sexp (&optional stream)
(let ((sexp (decode-coding-string (base64-decode-string
- (read stream)) 'utf-8-unix)))
+ (read stream)) 'utf-8-unix))
+ ;; Parent expects UTF-8 encoded text.
+ (coding-system-for-write 'utf-8-unix))
(if async-debug
(message "Received sexp {{{%s}}}" (pp-to-string sexp)))
(setq sexp (read sexp))
(eval sexp)))
(defun async--insert-sexp (sexp)
- (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))
+ (let (print-level
+ print-length
+ (print-escape-nonascii t)
+ (print-circle t))
+ (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
(async--insert-sexp sexp)
(process-send-region process (point-min) (point-max))))
-(defsubst async--value-printable-p (value)
- "Return non-nil if VALUE can be round-tripped to a string prepresentation."
- (condition-case nil
- (let* ((value-string (prin1-to-string value))
- (value-from-string (car (read-from-string value-string))))
- (equal value value-from-string))
- (error nil)))
-
-(defun async--sanitize-closure (func)
- "If FUNC is a closure, delete unprintable lexicals from it."
- (when (eq (car-safe func) 'closure)
- (setf (cadr func)
- (or (loop for obj in (cadr func)
- if (or (not (consp obj))
- (async--value-printable-p (cdr obj)))
- collect obj
- else do
- (when async-debug
- (message "Sanitized var from closure: %s=%S"
- (car obj) (cdr obj))))
- ;; A closure with no lexicals generally has this value
- ;; as its cadr, so we'll use that if everything gets
- ;; filtered out.
- '(t))))
- func)
-
-(defsubst async--get-function (func)
- "Get the function definition of FUNC, whatever it is.
-
-FUNC can be a variable name, a function definition, or an
-expression that evaluates to a function.
-
-This exists to get around the fact that closures are not
-self-quoting, so calling `eval' on them results in an error."
- (indirect-function
- (cond
- ;; Quoted form => Extract value without evaluating since `(eval
- ;; (quote (closure ...)))' is an error.
- ((memq (car-safe func) '(quote function))
- (cadr func))
- ;; Anything else => eval it
- ;; (e.g. variable or function call)
- (t
- (eval func)))))
-
(defun async-batch-invoke ()
"Called from the child Emacs process' command-line."
- (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))))
- (condition-case err
- (prin1 (funcall
- (async--receive-sexp (unless async-send-over-pipe
- command-line-args-left))))
- (error
- (prin1 (list 'async-signal err))))))
+ ;; Make sure 'message' and 'prin1' encode stuff in UTF-8, as parent
+ ;; process expects.
+ (let ((coding-system-for-write 'utf-8-unix))
+ (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))))
+ (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
(funcall async-callback args))
(async--transmit-sexp (car args) (list 'quote (cdr args))))))
-(defun async-receive (&rest args)
+(defun async-receive ()
"Send the given messages to the asychronous Emacs PROCESS."
(async--receive-sexp))
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 (let ((process-connection-type nil))
(apply #'start-process name buf program program-args))))
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:
(async-get proc)))
If you don't want to use a callback, and you don't care about any
-return value form the child process, pass the `ignore' symbol as
+return value from the child process, pass the `ignore' symbol as
the second argument (if you don't, and never call `async-get', it
will leave *emacs* process buffers hanging around):
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"))
- ;; Evaluate START-FUNC and resolve it to an actual function
- ;; definition.
- (start-func
- (async--get-function start-func)))
- (unless (functionp start-func)
- (error "Start-func is not a function: %S" start-func))
- `(let* ((sexp (async--sanitize-closure #',start-func))
- (,procvar
- (async-start-process
- "emacs" (file-truename
- (expand-file-name invocation-name
- invocation-directory))
- ,finish-func
- "-Q" "-l" ,(funcall (symbol-function 'find-library-name)
- "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 ,procvar (list 'quote sexp)))
- ,procvar)))
+ (let ((sexp start-func)
+ ;; Subordinate Emacs will send text encoded in UTF-8.
+ (coding-system-for-read 'utf-8-unix))
+ (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."