]> code.delx.au - gnu-emacs-elpa/blobdiff - async.el
Handle errors file by file instead of returning on first error.
[gnu-emacs-elpa] / async.el
index 63e178381b4208032f9cb6f9e80985d240265689..dc732707b85ff91992f4e7eba2128366cf1c479a 100644 (file)
--- a/async.el
+++ b/async.el
@@ -1,9 +1,10 @@
-;;; async --- Asynchronous processing in Emacs
+;;; async.el --- Asynchronous processing in Emacs -*- lexical-binding: t -*-
 
-;; Copyright (C) 2012~2014 John Wiegley
+;; Copyright (C) 2012-2016 Free Software Foundation, Inc.
 
 ;; Author: John Wiegley <jwiegley@gmail.com>
 ;; Created: 18 Jun 2012
+;; Version: 1.6
 
 ;; Keywords: async
 ;; X-URL: https://github.com/jwiegley/emacs-async
@@ -42,6 +43,7 @@
 (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)
@@ -93,8 +95,8 @@ as follows:
       (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))
@@ -119,7 +121,9 @@ as follows:
 
 (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))
@@ -128,12 +132,16 @@ as follows:
     (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
@@ -144,18 +152,21 @@ as follows:
 
 (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
@@ -190,7 +201,7 @@ its FINISH-FUNC is nil."
             (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))
 
@@ -200,7 +211,8 @@ its FINISH-FUNC is nil."
 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))))
@@ -212,7 +224,7 @@ finished."
       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:
 
@@ -245,7 +257,7 @@ ready.  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):
 
@@ -259,25 +271,28 @@ returned except that it yields no value (since the value is
 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" (file-truename
-                       (expand-file-name invocation-name
-                                         invocation-directory))
-              ,finish-func
-              "-Q" "-l" (symbol-file 'async-batch-invoke 'defun)
-              "-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."