diff options
Diffstat (limited to 'configs/shared/emacs/.emacs.d/elpa/async-20180527.1730/async.el')
| -rw-r--r-- | configs/shared/emacs/.emacs.d/elpa/async-20180527.1730/async.el | 392 |
1 files changed, 392 insertions, 0 deletions
diff --git a/configs/shared/emacs/.emacs.d/elpa/async-20180527.1730/async.el b/configs/shared/emacs/.emacs.d/elpa/async-20180527.1730/async.el new file mode 100644 index 000000000000..771e64105330 --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/async-20180527.1730/async.el @@ -0,0 +1,392 @@ +;;; async.el --- Asynchronous processing in Emacs -*- lexical-binding: t -*- + +;; Copyright (C) 2012-2016 Free Software Foundation, Inc. + +;; Author: John Wiegley <jwiegley@gmail.com> +;; Created: 18 Jun 2012 +;; Version: 1.9.3 + +;; Keywords: async +;; X-URL: https://github.com/jwiegley/emacs-async + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation; either version 2, or (at +;; your option) any later version. + +;; This program is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; Adds the ability to call asynchronous functions and process with ease. See +;; the documentation for `async-start' and `async-start-process'. + +;;; Code: + +(eval-when-compile (require 'cl-lib)) + +(defgroup async nil + "Simple asynchronous processing in Emacs" + :group 'emacs) + +(defcustom async-variables-noprops-function #'async-variables-noprops + "Default function to remove text properties in variables." + :group 'async + :type 'function) + +(defvar async-debug 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-variables-noprops (sequence) + "Remove text properties in SEQUENCE. + +Argument SEQUENCE may be a list or a string, if anything else it +is returned unmodified. + +Note that this is a naive function that doesn't remove text properties +in SEQUENCE recursively, only at the first level which suffice in most +cases." + (cond ((stringp sequence) + (substring-no-properties sequence)) + ((listp sequence) + (cl-loop for elm in sequence + if (stringp elm) + collect (substring-no-properties elm) + else collect elm)) + (t sequence))) + +(defun async-inject-variables + (include-regexp &optional predicate exclude-regexp noprops) + "Return a `setq' form that replicates part of the calling environment. + +It sets the value for every variable matching INCLUDE-REGEXP and +also PREDICATE. It will not perform injection for any variable +matching EXCLUDE-REGEXP (if present) or representing a syntax-table +i.e. ending by \"-syntax-table\". +When NOPROPS is non nil it tries to strip out text properties of each +variable's value with `async-variables-noprops-function'. + +It is intended to be used as follows: + + (async-start + `(lambda () + (require 'smtpmail) + (with-temp-buffer + (insert ,(buffer-substring-no-properties (point-min) (point-max))) + ;; Pass in the variable environment for smtpmail + ,(async-inject-variables \"\\`\\(smtpmail\\|\\(user-\\)?mail\\)-\") + (smtpmail-send-it))) + 'ignore)" + `(setq + ,@(let (bindings) + (mapatoms + (lambda (sym) + (let* ((sname (and (boundp sym) (symbol-name sym))) + (value (and sname (symbol-value sym)))) + (when (and sname + (or (null include-regexp) + (string-match include-regexp sname)) + (or (null exclude-regexp) + (not (string-match exclude-regexp sname))) + (not (string-match "-syntax-table\\'" sname))) + (unless (or (stringp value) + (memq value '(nil t)) + (numberp value) + (vectorp value)) + (setq value `(quote ,value))) + (when noprops + (setq value (funcall async-variables-noprops-function + value))) + (when (or (null predicate) + (funcall predicate sym)) + (setq bindings (cons value bindings) + bindings (cons sym bindings))))))) + bindings))) + +(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 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)) + (if (= 0 (process-exit-status proc)) + (if async-callback-for-process + (if async-callback + (prog1 + (funcall async-callback proc) + (unless async-debug + (kill-buffer (current-buffer)))) + (set (make-local-variable 'async-callback-value) proc) + (set (make-local-variable 'async-callback-value-set) t)) + (goto-char (point-max)) + (backward-sexp) + (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 (decode-coding-string (base64-decode-string + (read stream)) 'utf-8-auto)) + ;; Parent expects UTF-8 encoded text. + (coding-system-for-write 'utf-8-auto)) + (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) + (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-auto) + (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 + (if async-debug + (message "Transmitting sexp {{{%s}}}" (pp-to-string sexp))) + (async--insert-sexp sexp) + (process-send-region process (point-min) (point-max)))) + +(defun async-batch-invoke () + "Called from the child Emacs process' command-line." + ;; Make sure 'message' and 'prin1' encode stuff in UTF-8, as parent + ;; process expects. + (let ((coding-system-for-write 'utf-8-auto)) + (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 it is ready. + +I.e., if no blocking +would result from a call to `async-get' on that FUTURE." + (and (memq (process-status future) '(exit signal)) + (let ((buf (process-buffer future))) + (if (buffer-live-p buf) + (with-current-buffer buf + async-callback-value-set) + t)))) + +(defun async-wait (future) + "Wait for FUTURE to become ready." + (while (not (async-ready future)) + (sleep-for 0.05))) + +(defun async-get (future) + "Get the value from process FUTURE when it is ready. +FUTURE is returned by `async-start' or `async-start-process' when +its FINISH-FUNC is nil." + (and future (async-wait future)) + (let ((buf (process-buffer future))) + (when (buffer-live-p buf) + (with-current-buffer buf + (async-handle-result + #'identity async-callback-value (current-buffer)))))) + +(defun async-message-p (value) + "Return true of VALUE is an async.el message packet." + (and (listp value) + (plist-get value :async-message))) + +(defun async-send (&rest args) + "Send the given messages to the asychronous Emacs PROCESS." + (let ((args (append args '(:async-message t)))) + (if async-in-child-emacs + (if async-callback + (funcall async-callback args)) + (async--transmit-sexp (car args) (list 'quote (cdr args)))))) + +(defun async-receive () + "Send the given messages to the asychronous Emacs PROCESS." + (async--receive-sexp)) + +;;;###autoload +(defun async-start-process (name program finish-func &rest program-args) + "Start the executable PROGRAM asynchronously. See `async-start'. +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. 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)))) + (with-current-buffer buf + (set (make-local-variable 'async-callback) finish-func) + (set-process-sentinel proc #'async-when-done) + (unless (string= name "emacs") + (set (make-local-variable 'async-callback-for-process) t)) + proc))) + +(defvar async-quiet-switch "-Q" + "The Emacs parameter to use to call emacs without config. +Can be one of \"-Q\" or \"-q\". +Default is \"-Q\" but it is sometimes useful to use \"-q\" to have a +enhanced config or some more variables loaded.") + +;;;###autoload +(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-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))) + +If FINISH-FUNC is nil or missing, a future is returned that can +be inspected using `async-get', blocking until the value is +ready. Example: + + (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 \"Waiting on async process, result should be 222: %s\" + (async-get proc))) + +If you don't want to use a callback, and you don't care about any +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): + + (async-start + (lambda () + (delete-file \"a remote file on a slow link\" nil)) + 'ignore) + +Note: Even when FINISH-FUNC is present, a future is still +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'." + (let ((sexp start-func) + ;; Subordinate Emacs will send text encoded in UTF-8. + (coding-system-for-read 'utf-8-auto)) + (setq async--procvar + (async-start-process + "emacs" (file-truename + (expand-file-name invocation-name + invocation-directory)) + finish-func + async-quiet-switch "-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--fold-left (fn forms bindings) + (let ((res forms)) + (dolist (binding bindings) + (setq res (funcall fn res + (if (listp binding) + binding + (list binding))))) + res)) + +(defmacro async-let (bindings &rest forms) + "Implements `let', but each binding is established asynchronously. +For example: + + (async-let ((x (foo)) + (y (bar))) + (message \"%s %s\" x y)) + + expands to ==> + + (async-start (foo) + (lambda (x) + (async-start (bar) + (lambda (y) + (message \"%s %s\" x y)))))" + (declare (indent 1)) + (async--fold-left + (lambda (acc binding) + (let ((fun (pcase (cadr binding) + ((and (pred functionp) f) f) + (f `(lambda () ,f))))) + `(async-start ,fun + (lambda (,(car binding)) + ,acc)))) + `(progn ,@forms) + (reverse bindings))) + +(provide 'async) + +;;; async.el ends here |