X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/ac1b89660ae4168db0487cd3872742bcc7f90888..228ec4bb351a9e14e338b9cb09eeb4809957c909:/async.el

diff --git a/async.el b/async.el
index 429d6ec02..dc732707b 100644
--- a/async.el
+++ b/async.el
@@ -1,10 +1,11 @@
-;;; async --- Asynchronous processing in Emacs
+;;; async.el --- Asynchronous processing in Emacs -*- lexical-binding: t -*-
 
-;; Copyright (C) 2012 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
 
@@ -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))
@@ -118,7 +120,10 @@ as follows:
           (set (make-local-variable 'async-callback-value-set) t))))))
 
 (defun async--receive-sexp (&optional stream)
-  (let ((sexp (base64-decode-string (read stream))))
+  (let ((sexp (decode-coding-string (base64-decode-string
+                                     (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))
@@ -127,11 +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
-  (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
@@ -142,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
@@ -188,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))
 
@@ -198,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))))
@@ -210,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:
 
@@ -243,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):
 
@@ -257,125 +271,33 @@ 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" (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."
   `(async-get (async-start ,func)))
 
-(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))))
-
 (provide 'async)
 
 ;;; async.el ends here