diff options
Diffstat (limited to 'elpa/async-20200113.1745')
| -rw-r--r-- | elpa/async-20200113.1745/async-autoloads.el | 174 | ||||
| -rw-r--r-- | elpa/async-20200113.1745/async-bytecomp.el | 210 | ||||
| -rw-r--r-- | elpa/async-20200113.1745/async-pkg.el | 8 | ||||
| -rw-r--r-- | elpa/async-20200113.1745/async.el | 408 | ||||
| -rw-r--r-- | elpa/async-20200113.1745/dired-async.el | 408 | ||||
| -rw-r--r-- | elpa/async-20200113.1745/smtpmail-async.el | 73 |
6 files changed, 1281 insertions, 0 deletions
diff --git a/elpa/async-20200113.1745/async-autoloads.el b/elpa/async-20200113.1745/async-autoloads.el new file mode 100644 index 0000000..de07d21 --- /dev/null +++ b/elpa/async-20200113.1745/async-autoloads.el @@ -0,0 +1,174 @@ +;;; async-autoloads.el --- automatically extracted autoloads +;; +;;; Code: + +(add-to-list 'load-path (directory-file-name + (or (file-name-directory #$) (car load-path)))) + + +;;;### (autoloads nil "async" "async.el" (0 0 0 0)) +;;; Generated autoloads from async.el + +(autoload 'async-start-process "async" "\ +Start the executable PROGRAM asynchronously named NAME. 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. + +\(fn NAME PROGRAM FINISH-FUNC &rest PROGRAM-ARGS)" nil nil) + +(autoload 'async-start "async" "\ +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'. + +\(fn START-FUNC &optional FINISH-FUNC)" nil nil) + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "async" '("async-"))) + +;;;*** + +;;;### (autoloads nil "async-bytecomp" "async-bytecomp.el" (0 0 0 +;;;;;; 0)) +;;; Generated autoloads from async-bytecomp.el + +(autoload 'async-byte-recompile-directory "async-bytecomp" "\ +Compile all *.el files in DIRECTORY asynchronously. +All *.elc files are systematically deleted before proceeding. + +\(fn DIRECTORY &optional QUIET)" nil nil) + +(defvar async-bytecomp-package-mode nil "\ +Non-nil if Async-Bytecomp-Package mode is enabled. +See the `async-bytecomp-package-mode' command +for a description of this minor mode. +Setting this variable directly does not take effect; +either customize it (see the info node `Easy Customization') +or call the function `async-bytecomp-package-mode'.") + +(custom-autoload 'async-bytecomp-package-mode "async-bytecomp" nil) + +(autoload 'async-bytecomp-package-mode "async-bytecomp" "\ +Byte compile asynchronously packages installed with package.el. +Async compilation of packages can be controlled by +`async-bytecomp-allowed-packages'. + +\(fn &optional ARG)" t nil) + +(autoload 'async-byte-compile-file "async-bytecomp" "\ +Byte compile Lisp code FILE asynchronously. + +Same as `byte-compile-file' but asynchronous. + +\(fn FILE)" t nil) + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "async-bytecomp" '("async-byte"))) + +;;;*** + +;;;### (autoloads nil "dired-async" "dired-async.el" (0 0 0 0)) +;;; Generated autoloads from dired-async.el + +(defvar dired-async-mode nil "\ +Non-nil if Dired-Async mode is enabled. +See the `dired-async-mode' command +for a description of this minor mode. +Setting this variable directly does not take effect; +either customize it (see the info node `Easy Customization') +or call the function `dired-async-mode'.") + +(custom-autoload 'dired-async-mode "dired-async" nil) + +(autoload 'dired-async-mode "dired-async" "\ +Do dired actions asynchronously. + +\(fn &optional ARG)" t nil) + +(autoload 'dired-async-do-copy "dired-async" "\ +Run ‘dired-do-copy’ asynchronously. + +\(fn &optional ARG)" t nil) + +(autoload 'dired-async-do-symlink "dired-async" "\ +Run ‘dired-do-symlink’ asynchronously. + +\(fn &optional ARG)" t nil) + +(autoload 'dired-async-do-hardlink "dired-async" "\ +Run ‘dired-do-hardlink’ asynchronously. + +\(fn &optional ARG)" t nil) + +(autoload 'dired-async-do-rename "dired-async" "\ +Run ‘dired-do-rename’ asynchronously. + +\(fn &optional ARG)" t nil) + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "dired-async" '("dired-async-"))) + +;;;*** + +;;;### (autoloads nil "smtpmail-async" "smtpmail-async.el" (0 0 0 +;;;;;; 0)) +;;; Generated autoloads from smtpmail-async.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "smtpmail-async" '("async-smtpmail-"))) + +;;;*** + +;;;### (autoloads nil nil ("async-pkg.el") (0 0 0 0)) + +;;;*** + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; coding: utf-8 +;; End: +;;; async-autoloads.el ends here diff --git a/elpa/async-20200113.1745/async-bytecomp.el b/elpa/async-20200113.1745/async-bytecomp.el new file mode 100644 index 0000000..1198497 --- /dev/null +++ b/elpa/async-20200113.1745/async-bytecomp.el @@ -0,0 +1,210 @@ +;;; async-bytecomp.el --- Compile elisp files asynchronously -*- lexical-binding: t -*- + +;; Copyright (C) 2014-2016 Free Software Foundation, Inc. + +;; Authors: John Wiegley <jwiegley@gmail.com> +;; Thierry Volpiatto <thierry.volpiatto@gmail.com> + +;; Keywords: dired async byte-compile +;; X-URL: https://github.com/jwiegley/dired-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: +;; +;; This package provide the `async-byte-recompile-directory' function +;; which allows, as the name says to recompile a directory outside of +;; your running emacs. +;; The benefit is your files will be compiled in a clean environment without +;; the old *.el files loaded. +;; Among other things, this fix a bug in package.el which recompile +;; the new files in the current environment with the old files loaded, creating +;; errors in most packages after upgrades. +;; +;; NB: This package is advicing the function `package--compile'. + +;;; Code: + +(require 'cl-lib) +(require 'async) + +(defcustom async-bytecomp-allowed-packages + ;; FIXME: Arguably the default should be `all', but currently + ;; this minor mode is silently/forcefully enabled by Helm and Magit to ensure + ;; they get compiled asynchronously, so this conservative default value is + ;; here to make sure that the mode can be enabled without the user's + ;; explicit consent. + '(async forge helm helm-core helm-ls-git helm-ls-hg magit) + "Packages in this list will be compiled asynchronously by `package--compile'. +All the dependencies of these packages will be compiled async too, +so no need to add dependencies to this list. +The value of this variable can also be the symbol `all', in this case +all packages are always compiled asynchronously." + :group 'async + :type '(choice + (const :tag "All packages" all) + (repeat symbol))) + +(defvar async-byte-compile-log-file + (concat user-emacs-directory "async-bytecomp.log")) + +;;;###autoload +(defun async-byte-recompile-directory (directory &optional quiet) + "Compile all *.el files in DIRECTORY asynchronously. +All *.elc files are systematically deleted before proceeding." + (cl-loop with dir = (directory-files directory t "\\.elc\\'") + unless dir return nil + for f in dir + when (file-exists-p f) do (delete-file f)) + ;; Ensure async is reloaded when async.elc is deleted. + ;; This happen when recompiling its own directory. + (load "async") + (let ((call-back + (lambda (&optional _ignore) + (if (file-exists-p async-byte-compile-log-file) + (let ((buf (get-buffer-create byte-compile-log-buffer)) + (n 0)) + (with-current-buffer buf + (goto-char (point-max)) + (let ((inhibit-read-only t)) + (insert-file-contents async-byte-compile-log-file) + (compilation-mode)) + (display-buffer buf) + (delete-file async-byte-compile-log-file) + (unless quiet + (save-excursion + (goto-char (point-min)) + (while (re-search-forward "^.*:Error:" nil t) + (cl-incf n))) + (if (> n 0) + (message "Failed to compile %d files in directory `%s'" n directory) + (message "Directory `%s' compiled asynchronously with warnings" directory))))) + (unless quiet + (message "Directory `%s' compiled asynchronously with success" directory)))))) + (async-start + `(lambda () + (require 'bytecomp) + ,(async-inject-variables "\\`\\(load-path\\)\\|byte\\'") + (let ((default-directory (file-name-as-directory ,directory)) + error-data) + (add-to-list 'load-path default-directory) + (byte-recompile-directory ,directory 0 t) + (when (get-buffer byte-compile-log-buffer) + (setq error-data (with-current-buffer byte-compile-log-buffer + (buffer-substring-no-properties (point-min) (point-max)))) + (unless (string= error-data "") + (with-temp-file ,async-byte-compile-log-file + (erase-buffer) + (insert error-data)))))) + call-back) + (unless quiet (message "Started compiling asynchronously directory %s" directory)))) + +(defvar package-archive-contents) +(defvar package-alist) +(declare-function package-desc-reqs "package.el" (cl-x)) + +(defun async-bytecomp--get-package-deps (pkgs) + ;; Same as `package--get-deps' but parse instead `package-archive-contents' + ;; because PKG is not already installed and not present in `package-alist'. + ;; However fallback to `package-alist' in case PKG no more present + ;; in `package-archive-contents' due to modification to `package-archives'. + ;; See issue #58. + (let ((seen '())) + (while pkgs + (let ((pkg (pop pkgs))) + (unless (memq pkg seen) + (let ((pkg-desc (cadr (or (assq pkg package-archive-contents) + (assq pkg package-alist))))) + (when pkg-desc + (push pkg seen) + (setq pkgs (append (mapcar #'car (package-desc-reqs pkg-desc)) + pkgs))))))) + seen)) + +(defadvice package--compile (around byte-compile-async) + (let ((cur-package (package-desc-name pkg-desc)) + (pkg-dir (package-desc-dir pkg-desc))) + (if (or (member async-bytecomp-allowed-packages '(t all (all))) + (memq cur-package (async-bytecomp--get-package-deps + async-bytecomp-allowed-packages))) + (progn + (when (eq cur-package 'async) + (fmakunbound 'async-byte-recompile-directory)) + ;; Add to `load-path' the latest version of async and + ;; reload it when reinstalling async. + (when (string= cur-package "async") + (cl-pushnew pkg-dir load-path) + (load "async-bytecomp")) + ;; `async-byte-recompile-directory' will add directory + ;; as needed to `load-path'. + (async-byte-recompile-directory (package-desc-dir pkg-desc) t)) + ad-do-it))) + +;;;###autoload +(define-minor-mode async-bytecomp-package-mode + "Byte compile asynchronously packages installed with package.el. +Async compilation of packages can be controlled by +`async-bytecomp-allowed-packages'." + :group 'async + :global t + (if async-bytecomp-package-mode + (ad-activate 'package--compile) + (ad-deactivate 'package--compile))) + +;;;###autoload +(defun async-byte-compile-file (file) + "Byte compile Lisp code FILE asynchronously. + +Same as `byte-compile-file' but asynchronous." + (interactive "fFile: ") + (let ((call-back + (lambda (&optional _ignore) + (let ((bn (file-name-nondirectory file))) + (if (file-exists-p async-byte-compile-log-file) + (let ((buf (get-buffer-create byte-compile-log-buffer)) + start) + (with-current-buffer buf + (goto-char (setq start (point-max))) + (let ((inhibit-read-only t)) + (insert-file-contents async-byte-compile-log-file) + (compilation-mode)) + (display-buffer buf) + (delete-file async-byte-compile-log-file) + (save-excursion + (goto-char start) + (if (re-search-forward "^.*:Error:" nil t) + (message "Failed to compile `%s'" bn) + (message "`%s' compiled asynchronously with warnings" bn))))) + (message "`%s' compiled asynchronously with success" bn)))))) + (async-start + `(lambda () + (require 'bytecomp) + ,(async-inject-variables "\\`load-path\\'") + (let ((default-directory ,(file-name-directory file))) + (add-to-list 'load-path default-directory) + (byte-compile-file ,file) + (when (get-buffer byte-compile-log-buffer) + (setq error-data (with-current-buffer byte-compile-log-buffer + (buffer-substring-no-properties (point-min) (point-max)))) + (unless (string= error-data "") + (with-temp-file ,async-byte-compile-log-file + (erase-buffer) + (insert error-data)))))) + call-back))) + +(provide 'async-bytecomp) + +;;; async-bytecomp.el ends here diff --git a/elpa/async-20200113.1745/async-pkg.el b/elpa/async-20200113.1745/async-pkg.el new file mode 100644 index 0000000..229bfe8 --- /dev/null +++ b/elpa/async-20200113.1745/async-pkg.el @@ -0,0 +1,8 @@ +(define-package "async" "20200113.1745" "Asynchronous processing in Emacs" + '((emacs "24.3")) + :commit "86aef2c38e7d35e8509b7feeee3e989d825eba91" :keywords + '("async") + :url "https://github.com/jwiegley/emacs-async") +;; Local Variables: +;; no-byte-compile: t +;; End: diff --git a/elpa/async-20200113.1745/async.el b/elpa/async-20200113.1745/async.el new file mode 100644 index 0000000..6437a30 --- /dev/null +++ b/elpa/async-20200113.1745/async.el @@ -0,0 +1,408 @@ +;;; async.el --- Asynchronous processing -*- lexical-binding: t -*- + +;; Copyright (C) 2012-2016 Free Software Foundation, Inc. + +;; Author: John Wiegley <jwiegley@gmail.com> +;; Created: 18 Jun 2012 +;; Version: 1.9.4 +;; Package-Requires: ((emacs "24.3")) +;; Keywords: convenience async +;; 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--purecopy + "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--purecopy (object) + "Remove text properties in OBJECT. + +Argument OBJECT may be a list or a string, if anything else it +is returned unmodified." + (cond ((stringp object) + (substring-no-properties object)) + ((consp object) + (cl-loop for elm in object + ;; A string. + if (stringp elm) + collect (substring-no-properties elm) + else + ;; Proper lists. + if (and (consp elm) (null (cdr (last elm)))) + collect (async--purecopy elm) + else + ;; Dotted lists. + ;; We handle here only dotted list where car and cdr + ;; are atoms i.e. (x . y) and not (x . (x . y)) or + ;; (x . (x y)) which should fit most cases. + if (and (consp elm) (cdr (last elm))) + collect (let ((key (car elm)) + (val (cdr elm))) + (cons (if (stringp key) + (substring-no-properties key) + key) + (if (stringp val) + (substring-no-properties val) + val))) + else + collect elm)) + (t object))) + +(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 non-nil 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 named NAME. 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 diff --git a/elpa/async-20200113.1745/dired-async.el b/elpa/async-20200113.1745/dired-async.el new file mode 100644 index 0000000..1dba956 --- /dev/null +++ b/elpa/async-20200113.1745/dired-async.el @@ -0,0 +1,408 @@ +;;; dired-async.el --- Asynchronous dired actions -*- lexical-binding: t -*- + +;; Copyright (C) 2012-2016 Free Software Foundation, Inc. + +;; Authors: John Wiegley <jwiegley@gmail.com> +;; Thierry Volpiatto <thierry.volpiatto@gmail.com> + +;; Keywords: dired async network +;; X-URL: https://github.com/jwiegley/dired-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: + +;; This file provide a redefinition of `dired-create-file' function, +;; performs copies, moves and all what is handled by `dired-create-file' +;; in the background using a slave Emacs process, +;; by means of the async.el module. +;; To use it, put this in your .emacs: + +;; (dired-async-mode 1) + +;; This will enable async copy/rename etc... +;; in dired and helm. + +;;; Code: + +(require 'cl-lib) +(require 'dired-aux) +(require 'async) + +(eval-when-compile + (defvar async-callback)) + +(defgroup dired-async nil + "Copy rename files asynchronously from dired." + :group 'dired) + +(defcustom dired-async-env-variables-regexp + "\\`\\(tramp-\\(default\\|connection\\|remote\\)\\|ange-ftp\\)-.*" + "Variables matching this regexp will be loaded on Child Emacs." + :type 'regexp + :group 'dired-async) + +(defcustom dired-async-message-function 'dired-async-mode-line-message + "Function to use to notify result when operation finish. +Should take same args as `message'." + :group 'dired-async + :type 'function) + +(defcustom dired-async-log-file "/tmp/dired-async.log" + "File use to communicate errors from Child Emacs to host Emacs." + :group 'dired-async + :type 'string) + +(defcustom dired-async-mode-lighter '(:eval + (when (eq major-mode 'dired-mode) + " Async")) + "Mode line lighter used for `dired-async-mode'." + :group 'dired-async + :risky t + :type 'sexp) + +(defface dired-async-message + '((t (:foreground "yellow"))) + "Face used for mode-line message." + :group 'dired-async) + +(defface dired-async-failures + '((t (:foreground "red"))) + "Face used for mode-line message." + :group 'dired-async) + +(defface dired-async-mode-message + '((t (:foreground "Gold"))) + "Face used for `dired-async--modeline-mode' lighter." + :group 'dired-async) + +(define-minor-mode dired-async--modeline-mode + "Notify mode-line that an async process run." + :group 'dired-async + :global t + :lighter (:eval (propertize (format " [%s Async job(s) running]" + (length (dired-async-processes))) + 'face 'dired-async-mode-message)) + (unless dired-async--modeline-mode + (let ((visible-bell t)) (ding)))) + +(defun dired-async-mode-line-message (text face &rest args) + "Notify end of operation in `mode-line'." + (message nil) + (let ((mode-line-format (concat + " " (propertize + (if args + (apply #'format text args) + text) + 'face face)))) + (force-mode-line-update) + (sit-for 3) + (force-mode-line-update))) + +(defun dired-async-processes () + (cl-loop for p in (process-list) + when (cl-loop for c in (process-command p) thereis + (string= "async-batch-invoke" c)) + collect p)) + +(defun dired-async-kill-process () + (interactive) + (let* ((processes (dired-async-processes)) + (proc (car (last processes)))) + (and proc (delete-process proc)) + (unless (> (length processes) 1) + (dired-async--modeline-mode -1)))) + +(defun dired-async-after-file-create (total operation failures skipped) + "Callback function used for operation handled by `dired-create-file'." + (unless (dired-async-processes) + ;; Turn off mode-line notification + ;; only when last process end. + (dired-async--modeline-mode -1)) + (when operation + (if (file-exists-p dired-async-log-file) + (progn + (pop-to-buffer (get-buffer-create dired-log-buffer)) + (goto-char (point-max)) + (setq inhibit-read-only t) + (insert "Error: ") + (insert-file-contents dired-async-log-file) + (special-mode) + (shrink-window-if-larger-than-buffer) + (delete-file dired-async-log-file)) + (run-with-timer + 0.1 nil + (lambda () + ;; First send error messages. + (cond (failures + (funcall dired-async-message-function + "%s failed for %d of %d file%s -- See *Dired log* buffer" + 'dired-async-failures + (car operation) (length failures) + total (dired-plural-s total))) + (skipped + (funcall dired-async-message-function + "%s: %d of %d file%s skipped -- See *Dired log* buffer" + 'dired-async-failures + (car operation) (length skipped) total + (dired-plural-s total)))) + (when dired-buffers + (cl-loop for (_f . b) in dired-buffers + when (buffer-live-p b) + do (with-current-buffer b + (when (and (not (file-remote-p default-directory nil t)) + (file-exists-p default-directory)) + (revert-buffer nil t))))) + ;; Finally send the success message. + (funcall dired-async-message-function + "Asynchronous %s of %s on %s file%s done" + 'dired-async-message + (car operation) (cadr operation) + total (dired-plural-s total))))))) + +(defun dired-async-maybe-kill-ftp () + "Return a form to kill ftp process in child emacs." + (quote + (progn + (require 'cl-lib) + (let ((buf (cl-loop for b in (buffer-list) + thereis (and (string-match + "\\`\\*ftp.*" + (buffer-name b)) b)))) + (when buf (kill-buffer buf)))))) + +(defvar overwrite-query) +(defun dired-async-create-files (file-creator operation fn-list name-constructor + &optional _marker-char) + "Same as `dired-create-files' but asynchronous. + +See `dired-create-files' for the behavior of arguments." + (setq overwrite-query nil) + (let ((total (length fn-list)) + failures async-fn-list skipped callback + async-quiet-switch) + (let (to) + (dolist (from fn-list) + (setq to (funcall name-constructor from)) + (if (and (equal to from) + (null (eq file-creator 'backup-file))) + (progn + (setq to nil) + (dired-log "Cannot %s to same file: %s\n" + (downcase operation) from))) + (if (not to) + (setq skipped (cons (dired-make-relative from) skipped)) + (let* ((overwrite (and (null (eq file-creator 'backup-file)) + (file-exists-p to))) + (dired-overwrite-confirmed ; for dired-handle-overwrite + (and overwrite + (let ((help-form `(format "\ +Type SPC or `y' to overwrite file `%s', +DEL or `n' to skip to next, +ESC or `q' to not overwrite any of the remaining files, +`!' to overwrite all remaining files with no more questions." ,to))) + (dired-query 'overwrite-query "Overwrite `%s'?" to))))) + ;; Handle the `dired-copy-file' file-creator specially + ;; When copying a directory to another directory or + ;; possibly to itself or one of its subdirectories. + ;; e.g "~/foo/" => "~/test/" + ;; or "~/foo/" =>"~/foo/" + ;; or "~/foo/ => ~/foo/bar/") + ;; In this case the 'name-constructor' have set the destination + ;; TO to "~/test/foo" because the old emacs23 behavior + ;; of `copy-directory' was to not create the subdirectory + ;; and instead copy the contents. + ;; With the new behavior of `copy-directory' + ;; (similar to the `cp' shell command) we don't + ;; need such a construction of the target directory, + ;; so modify the destination TO to "~/test/" instead of "~/test/foo/". + (let ((destname (file-name-directory to))) + (when (and (file-directory-p from) + (file-directory-p to) + (eq file-creator 'dired-copy-file)) + (setq to destname)) + ;; If DESTNAME is a subdirectory of FROM, not a symlink, + ;; and the method in use is copying, signal an error. + (and (eq t (car (file-attributes destname))) + (eq file-creator 'dired-copy-file) + (file-in-directory-p destname from) + (error "Cannot copy `%s' into its subdirectory `%s'" + from to))) + (if overwrite + (or (and dired-overwrite-confirmed + (push (cons from to) async-fn-list)) + (progn + (push (dired-make-relative from) failures) + (dired-log "%s `%s' to `%s' failed\n" + operation from to))) + (push (cons from to) async-fn-list))))) + ;; Fix tramp issue #80 with emacs-26, use "-q" only when needed. + (setq async-quiet-switch + (if (and (boundp 'tramp-cache-read-persistent-data) + async-fn-list + (cl-loop for (_from . to) in async-fn-list + thereis (file-remote-p to))) + "-q" "-Q")) + ;; When failures have been printed to dired log add the date at bob. + (when (or failures skipped) (dired-log t)) + ;; When async-fn-list is empty that's mean only one file + ;; had to be copied and user finally answer NO. + ;; In this case async process will never start and callback + ;; will have no chance to run, so notify failures here. + (unless async-fn-list + (cond (failures + (funcall dired-async-message-function + "%s failed for %d of %d file%s -- See *Dired log* buffer" + 'dired-async-failures + operation (length failures) + total (dired-plural-s total))) + (skipped + (funcall dired-async-message-function + "%s: %d of %d file%s skipped -- See *Dired log* buffer" + 'dired-async-failures + operation (length skipped) total + (dired-plural-s total))))) + ;; Setup callback. + (setq callback + (lambda (&optional _ignore) + (dired-async-after-file-create + total (list operation (length async-fn-list)) failures skipped) + (when (string= (downcase operation) "rename") + (cl-loop for (file . to) in async-fn-list + for bf = (get-file-buffer file) + for destp = (file-exists-p to) + do (and bf destp + (with-current-buffer bf + (set-visited-file-name to t t)))))))) + ;; Start async process. + (when async-fn-list + (async-start `(lambda () + (require 'cl-lib) (require 'dired-aux) (require 'dired-x) + ,(async-inject-variables dired-async-env-variables-regexp) + (let ((dired-recursive-copies (quote always)) + (dired-copy-preserve-time + ,dired-copy-preserve-time)) + (setq overwrite-backup-query nil) + ;; Inline `backup-file' as long as it is not + ;; available in emacs. + (defalias 'backup-file + ;; Same feature as "cp -f --backup=numbered from to" + ;; Symlinks are copied as file from source unlike + ;; `dired-copy-file' which is same as cp -d. + ;; Directories are omitted. + (lambda (from to ok) + (cond ((file-directory-p from) (ignore)) + (t (let ((count 0)) + (while (let ((attrs (file-attributes to))) + (and attrs (null (nth 0 attrs)))) + (cl-incf count) + (setq to (concat (file-name-sans-versions to) + (format ".~%s~" count))))) + (condition-case err + (copy-file from to ok dired-copy-preserve-time) + (file-date-error + (dired-log "Can't set date on %s:\n%s\n" from err))))))) + ;; Now run the FILE-CREATOR function on files. + (cl-loop with fn = (quote ,file-creator) + for (from . dest) in (quote ,async-fn-list) + do (condition-case err + (funcall fn from dest t) + (file-error + (dired-log "%s: %s\n" (car err) (cdr err))) + nil)) + (when (get-buffer dired-log-buffer) + (dired-log t) + (with-current-buffer dired-log-buffer + (write-region (point-min) (point-max) + ,dired-async-log-file)))) + ,(dired-async-maybe-kill-ftp)) + callback) + ;; Run mode-line notifications while process running. + (dired-async--modeline-mode 1) + (message "%s proceeding asynchronously..." operation)))) + +(defvar wdired-use-interactive-rename) +(defun dired-async-wdired-do-renames (old-fn &rest args) + ;; Perhaps a better fix would be to ask for renaming BEFORE starting + ;; OLD-FN when `wdired-use-interactive-rename' is non-nil. For now + ;; just bind it to nil to ensure no questions will be asked between + ;; each rename. + (let (wdired-use-interactive-rename) + (apply old-fn args))) + +(defadvice wdired-do-renames (around wdired-async) + (let (wdired-use-interactive-rename) + ad-do-it)) + +(defadvice dired-create-files (around dired-async) + (dired-async-create-files file-creator operation fn-list + name-constructor marker-char)) + +;;;###autoload +(define-minor-mode dired-async-mode + "Do dired actions asynchronously." + :group 'dired-async + :lighter dired-async-mode-lighter + :global t + (if dired-async-mode + (if (fboundp 'advice-add) + (progn (advice-add 'dired-create-files :override #'dired-async-create-files) + (advice-add 'wdired-do-renames :around #'dired-async-wdired-do-renames)) + (ad-activate 'dired-create-files) + (ad-activate 'wdired-do-renames)) + (if (fboundp 'advice-remove) + (progn (advice-remove 'dired-create-files #'dired-async-create-files) + (advice-remove 'wdired-do-renames #'dired-async-wdired-do-renames)) + (ad-deactivate 'dired-create-files) + (ad-deactivate 'wdired-do-renames)))) + +(defmacro dired-async--with-async-create-files (&rest body) + "Evaluate BODY with ‘dired-create-files’ set to ‘dired-async-create-files’." + (declare (indent 0)) + `(cl-letf (((symbol-function 'dired-create-files) #'dired-async-create-files)) + ,@body)) + +;;;###autoload +(defun dired-async-do-copy (&optional arg) + "Run ‘dired-do-copy’ asynchronously." + (interactive "P") + (dired-async--with-async-create-files + (dired-do-copy arg))) + +;;;###autoload +(defun dired-async-do-symlink (&optional arg) + "Run ‘dired-do-symlink’ asynchronously." + (interactive "P") + (dired-async--with-async-create-files + (dired-do-symlink arg))) + +;;;###autoload +(defun dired-async-do-hardlink (&optional arg) + "Run ‘dired-do-hardlink’ asynchronously." + (interactive "P") + (dired-async--with-async-create-files + (dired-do-hardlink arg))) + +;;;###autoload +(defun dired-async-do-rename (&optional arg) + "Run ‘dired-do-rename’ asynchronously." + (interactive "P") + (dired-async--with-async-create-files + (dired-do-rename arg))) + +(provide 'dired-async) + +;;; dired-async.el ends here diff --git a/elpa/async-20200113.1745/smtpmail-async.el b/elpa/async-20200113.1745/smtpmail-async.el new file mode 100644 index 0000000..ac26923 --- /dev/null +++ b/elpa/async-20200113.1745/smtpmail-async.el @@ -0,0 +1,73 @@ +;;; smtpmail-async.el --- Send e-mail with smtpmail.el asynchronously -*- lexical-binding: t -*- + +;; Copyright (C) 2012-2016 Free Software Foundation, Inc. + +;; Author: John Wiegley <jwiegley@gmail.com> +;; Created: 18 Jun 2012 + +;; Keywords: email 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: + +;; Send e-mail with smtpmail.el asynchronously. To use: +;; +;; (require 'smtpmail-async) +;; +;; (setq send-mail-function 'async-smtpmail-send-it +;; message-send-mail-function 'async-smtpmail-send-it) +;; +;; This assumes you already have smtpmail.el working. + +;;; Code: + +(defgroup smtpmail-async nil + "Send e-mail with smtpmail.el asynchronously" + :group 'smptmail) + +(require 'async) +(require 'smtpmail) +(require 'message) + +(defvar async-smtpmail-before-send-hook nil + "Hook running in the child emacs in `async-smtpmail-send-it'. +It is called just before calling `smtpmail-send-it'.") + +(defun async-smtpmail-send-it () + (let ((to (message-field-value "To")) + (buf-content (buffer-substring-no-properties + (point-min) (point-max)))) + (message "Delivering message to %s..." to) + (async-start + `(lambda () + (require 'smtpmail) + (with-temp-buffer + (insert ,buf-content) + (set-buffer-multibyte nil) + ;; Pass in the variable environment for smtpmail + ,(async-inject-variables + "\\`\\(smtpmail\\|async-smtpmail\\|\\(user-\\)?mail\\)-\\|auth-sources\\|epg\\|nsm" + nil "\\`\\(mail-header-format-function\\|smtpmail-address-buffer\\|mail-mode-abbrev-table\\)") + (run-hooks 'async-smtpmail-before-send-hook) + (smtpmail-send-it))) + (lambda (&optional _ignore) + (message "Delivering message to %s...done" to))))) + +(provide 'smtpmail-async) + +;;; smtpmail-async.el ends here |