X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/dfaddaa28203a0d467177dcce46595db2ea84fbb..6d4e1a5df00da26de98d64d724a3162115377b1c:/async.el diff --git a/async.el b/async.el index 11ee5c249..d44f14af5 100644 --- a/async.el +++ b/async.el @@ -1,10 +1,10 @@ ;;; async --- Asynchronous processing in Emacs -;; Copyright (C) 2012 John Wiegley +;; Copyright (C) 2012~2014 John Wiegley ;; Author: John Wiegley ;; Created: 18 Jun 2012 -;; Version: 1.1 + ;; Keywords: async ;; X-URL: https://github.com/jwiegley/emacs-async @@ -79,6 +79,20 @@ as follows: (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)) @@ -95,27 +109,17 @@ as follows: (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 (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)) @@ -126,6 +130,7 @@ as follows: (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)) @@ -139,20 +144,25 @@ as follows: (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." @@ -165,9 +175,7 @@ FUTURE is returned by `async-start' or `async-start-process' when 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." @@ -256,113 +264,27 @@ returns nil. It can still be useful, however, as an argument to `(let* ((sexp ,start-func) (,procvar (async-start-process - "emacs" (expand-file-name invocation-name - invocation-directory) + "emacs" (file-truename + (expand-file-name invocation-name + invocation-directory)) ,finish-func - "-Q" "-l" ,(find-library-name "async") + "-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" - ,@(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)))) + (if 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)))) +(defmacro async-sandbox(func) + "Evaluate FUNC in a separate Emacs process, synchronously." + `(async-get (async-start ,func))) (provide 'async)