+++ /dev/null
-;;; async-autoloads.el --- automatically extracted autoloads (do not edit) -*- lexical-binding: t -*-
-;; Generated by the `loaddefs-generate' function.
-
-;; This file is part of GNU Emacs.
-
-;;; Code:
-
-(add-to-list 'load-path (or (and load-file-name (directory-file-name (file-name-directory load-file-name))) (car load-path)))
-
-
-\f
-;;; 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)")
-(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 you call `async-send' from a child process, the message will
-be also passed to the FINISH-FUNC. You can test RESULT to see if
-it is a message by using `async-message-p'. If nil, it means
-this is the final result. Example of the FINISH-FUNC:
-
- (lambda (result)
- (if (async-message-p result)
- (message \"Received a message from child process: %s\" result)
- (message \"Async process done, result: %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)
-
-Special case:
-If the output of START-FUNC is a string with properties
-e.g. (buffer-string) RESULT will be transformed in a list where the
-car is the string itself (without props) and the cdr the rest of
-properties, this allows using in FINISH-FUNC the string without
-properties and then apply the properties in cdr to this string (if
-needed).
-Properties handling special objects like markers are returned as
-list to allow restoring them later.
-See <https://github.com/jwiegley/emacs-async/issues/145> for more infos.
-
-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)")
-(register-definition-prefixes "async" '("async-"))
-
-\f
-;;; 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)")
-(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'.
-NOTE: Use this mode only if you install/upgrade etc... your packages
-synchronously, if you use a package manager like helm-package.el which
-by default is async you don't need this.
-
-This is a global minor mode. If called interactively, toggle the
-`Async-Bytecomp-Package mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
-
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the mode
-if ARG is a negative number.
-
-To check whether the minor mode is enabled in the current buffer,
-evaluate `(default-value \\='async-bytecomp-package-mode)'.
-
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
-(fn &optional ARG)" t)
-(autoload 'async-byte-compile-file "async-bytecomp" "\
-Byte compile Lisp code FILE asynchronously.
-
-Same as `byte-compile-file' but asynchronous.
-
-(fn FILE)" t)
-(register-definition-prefixes "async-bytecomp" '("async-"))
-
-\f
-;;; Generated autoloads from async-package.el
-
-(register-definition-prefixes "async-package" '("async-p"))
-
-\f
-;;; 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.
-
-This is a global minor mode. If called interactively, toggle the
-`Dired-Async mode' mode. If the prefix argument is positive, enable the
-mode, and if it is zero or negative, disable the mode.
-
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
-mode if ARG is nil, omitted, or is a positive number. Disable the mode
-if ARG is a negative number.
-
-To check whether the minor mode is enabled in the current buffer,
-evaluate `(default-value \\='dired-async-mode)'.
-
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
-(fn &optional ARG)" t)
-(autoload 'dired-async-do-copy "dired-async" "\
-Run ‘dired-do-copy’ asynchronously.
-
-(fn &optional ARG)" t)
-(autoload 'dired-async-do-symlink "dired-async" "\
-Run ‘dired-do-symlink’ asynchronously.
-
-(fn &optional ARG)" t)
-(autoload 'dired-async-do-hardlink "dired-async" "\
-Run ‘dired-do-hardlink’ asynchronously.
-
-(fn &optional ARG)" t)
-(autoload 'dired-async-do-rename "dired-async" "\
-Run ‘dired-do-rename’ asynchronously.
-
-(fn &optional ARG)" t)
-(register-definition-prefixes "dired-async" '("dired-async-"))
-
-\f
-;;; Generated autoloads from smtpmail-async.el
-
-(register-definition-prefixes "smtpmail-async" '("async-smtpmail-"))
-\f
-;;; End of scraped data
-
-(provide 'async-autoloads)
-
-;; Local Variables:
-;; version-control: never
-;; no-byte-compile: t
-;; no-update-autoloads: t
-;; no-native-compile: t
-;; coding: utf-8-emacs-unix
-;; End:
-
-;;; async-autoloads.el ends here
+++ /dev/null
-;;; async-bytecomp.el --- Compile elisp files asynchronously -*- lexical-binding: t -*-
-
-;; Copyright (C) 2014-2022 Free Software Foundation, Inc.
-
-;; Authors: John Wiegley <jwiegleyNOSPAMgmail.com>
-;; Thierry Volpiatto <thievolNOSPAMposteo.net>
-
-;; Keywords: dired async byte-compile
-;; 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 3 of the License, 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 this program. If not, see <https://www.gnu.org/licenses/>.
-
-;;; 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. Single files can be compiled with
-;; `async-byte-compile-file'. The benefit is your files will be
-;; compiled in a clean environment without the old *.el files
-;; loaded. A mode `async-bytecomp-package-mode' is provided to
-;; automatically compile packages asynchronously when installing or
-;; upgrading, 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 advising the function `package--compile' when
-;; `async-bytecomp-package-mode' is enabled. This mode is useful
-;; only when using a synchronous package manager (e.g. M-x
-;; list-package), users of M-x helm-packages don't need this anymore.
-
-;;; Code:
-
-(require 'cl-lib)
-(require 'async)
-(require 'bytecomp)
-
-(declare-function package-desc-name "package.el")
-(declare-function package-desc-dir "package.el")
-
-(defcustom async-bytecomp-allowed-packages 'all
- "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' (default), 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 "async-bytecomp.log"
- "Prefix for a file used to pass errors from async process to the caller.
-The `file-name-nondirectory' part of the value is passed to
-`make-temp-file' as a prefix. When the value is an absolute
-path, then the `file-name-directory' part of it is expanded in
-the calling process (with `expand-file-name') and used as a value
-of variable `temporary-file-directory' in async processes.")
-
-(defvar async-bytecomp-load-variable-regexp "\\`load-path\\'"
- "The variable used by `async-inject-variables' when (re)compiling async.")
-
-(defun async-bytecomp--file-to-comp-buffer-1 (log-file &optional postproc)
- (let ((buf (get-buffer-create byte-compile-log-buffer)))
- (with-current-buffer buf
- (goto-char (point-max))
- (let ((inhibit-read-only t))
- (insert-file-contents log-file)
- (compilation-mode))
- (display-buffer buf)
- (delete-file log-file)
- (and postproc (funcall postproc)))))
-
-(defun async-bytecomp--file-to-comp-buffer (file-or-dir &optional quiet type log-file)
- (let ((bn (file-name-nondirectory (directory-file-name file-or-dir)))
- (action-name (pcase type
- ('file "File")
- ('directory "Directory"))))
- (if (and log-file (file-exists-p log-file))
- (async-bytecomp--file-to-comp-buffer-1
- log-file
- (unless quiet
- (lambda ()
- (let ((n 0))
- (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 bn)
- (message "%s `%s' compiled asynchronously with warnings"
- action-name bn)))))))
- (unless quiet
- (message "%s `%s' compiled asynchronously with success" action-name bn)))))
-
-(defmacro async-bytecomp--comp-buffer-to-file ()
- "Write contents of `byte-compile-log-buffer' to a log file.
-The log file is a temporary file that name is determined by
-`async-byte-compile-log-file', which see. Return the actual log
-file name, or nil if no log file has been created."
- `(when (get-buffer byte-compile-log-buffer)
- (let ((error-data (with-current-buffer byte-compile-log-buffer
- (buffer-substring-no-properties (point-min) (point-max)))))
- (unless (string= error-data "")
- ;; The `async-byte-compile-log-file' used to be an absolute file name
- ;; shared amongst all compilation async processes. For backward
- ;; compatibility the directory part of it is used to create logs the same
- ;; directory while the nondirectory part denotes the PREFIX for
- ;; `make-temp-file' call. The `temporary-file-directory' is bound, such
- ;; that the async process uses one set by the caller.
- (let ((temporary-file-directory
- ,(or (when (and async-byte-compile-log-file
- (file-name-absolute-p
- async-byte-compile-log-file))
- (expand-file-name (file-name-directory
- async-byte-compile-log-file)))
- temporary-file-directory))
- (log-file (make-temp-file ,(let ((log-file
- (file-name-nondirectory
- async-byte-compile-log-file)))
- (format "%s%s"
- log-file
- (if (string-suffix-p "." log-file)
- "" "."))))))
- (with-temp-file log-file
- (erase-buffer)
- (insert error-data))
- log-file)))))
-
-;;;###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 log-file)
- (async-bytecomp--file-to-comp-buffer directory quiet 'directory log-file))))
- (async-start
- `(lambda ()
- (require 'bytecomp)
- ,(async-inject-variables async-bytecomp-load-variable-regexp)
- (let ((default-directory (file-name-as-directory ,directory)))
- (add-to-list 'load-path default-directory)
- (byte-recompile-directory ,directory 0 t)
- ,(macroexpand '(async-bytecomp--comp-buffer-to-file))))
- 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))
-
-(defun async--package-compile (orig-fun pkg-desc &rest args)
- (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.
- (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))
- (apply orig-fun pkg-desc args))))
-
-;;;###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'.
-NOTE: Use this mode only if you install/upgrade etc... your packages
-synchronously, if you use a package manager like helm-package.el which
-by default is async you don't need this."
- :group 'async
- :global t
- (if async-bytecomp-package-mode
- (advice-add 'package--compile :around #'async--package-compile)
- (advice-remove 'package--compile #'async--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 log-file)
- (async-bytecomp--file-to-comp-buffer file nil 'file log-file))))
- (async-start
- `(lambda ()
- (require 'bytecomp)
- ,(async-inject-variables async-bytecomp-load-variable-regexp)
- (let ((default-directory ,(file-name-directory file)))
- (add-to-list 'load-path default-directory)
- (byte-compile-file ,file)
- ,(macroexpand '(async-bytecomp--comp-buffer-to-file))))
- call-back)))
-
-(provide 'async-bytecomp)
-
-;;; async-bytecomp.el ends here
+++ /dev/null
-;;; async-package.el --- Fetch packages asynchronously -*- lexical-binding: t -*-
-
-;; Copyright (C) 2014-2022 Free Software Foundation, Inc.
-
-;; Author: Thierry Volpiatto <thievolNOSPAMposteo.net>
-
-;; Keywords: dired async byte-compile package
-;; 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 3 of the License, 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 this program. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; Provide the function `async-package-do-action' to
-;; (re)install/upgrade packages asynchronously.
-
-;;; Code:
-
-(eval-when-compile (require 'cl-lib))
-(require 'async-bytecomp)
-(require 'dired-async)
-(require 'package)
-
-(define-minor-mode async-package--modeline-mode
- "Notify mode-line that an async process run."
- :group 'async
- :global t
- :lighter (:eval (propertize (format " [%s async job Installing package(s)]"
- (length (dired-async-processes
- 'async-pkg-install)))
- 'face 'async-package-message))
- (unless async-package--modeline-mode
- (let ((visible-bell t)) (ding))))
-
-(defvar async-pkg-install-after-hook nil
- "Hook that run after package installation.
-The hook runs in the call-back once installation is done in child emacs.")
-
-(defface async-package-message
- '((t (:foreground "yellow")))
- "Face used for mode-line message."
- :group 'async)
-
-(defun async-package-do-action (action packages error-file)
- "Execute ACTION asynchronously on PACKAGES.
-Argument ACTION can be one of \\='install, \\='upgrade, \\='reinstall.
-Argument PACKAGES is a list of packages (symbols).
-Argument ERROR-FILE is the file where errors are logged, if some."
- (require 'async-bytecomp)
- (let ((fn (pcase action
- ('install 'package-install)
- ('upgrade 'package-upgrade)
- ('reinstall 'package-reinstall)))
- (action-string (pcase action
- ('install "Installing")
- ('upgrade "Upgrading")
- ('reinstall "Reinstalling")))
- ;; As PACKAGES are installed and compiled in a single async
- ;; process we don't need to compute log-file in child process
- ;; i.e. we use the same log-file for all PACKAGES.
- (log-file (make-temp-file
- (expand-file-name
- (file-name-nondirectory async-byte-compile-log-file)
- temporary-file-directory))))
- (message "%s %s package(s)..." action-string (length packages))
- (process-put
- (async-start
- `(lambda ()
- (require 'bytecomp)
- (setq package-archives ',package-archives
- package-pinned-packages ',package-pinned-packages
- package-archive-contents ',package-archive-contents
- package-user-dir ,package-user-dir
- package-alist ',package-alist
- load-path ',load-path)
- ;; Ensure `async-bytecomp-package-mode' doesn't kick in
- ;; (issue #194) as some packages may enable it
- ;; inconditionally. We don't need to compile async as we are
- ;; already async and in a clean environment.
- (require 'async-bytecomp)
- (setq async-bytecomp-allowed-packages nil)
- (prog1
- (condition-case err
- (mapc ',fn ',packages)
- (error
- (with-temp-file ,error-file
- (insert
- (format
- "%S:\n Please refresh package list before %s"
- err ,action-string)))))
- (when (get-buffer byte-compile-log-buffer)
- (let ((error-data (with-current-buffer byte-compile-log-buffer
- (buffer-substring-no-properties
- (point-min) (point-max)))))
- (unless (string= error-data "")
- (with-temp-file ,log-file
- (erase-buffer)
- (insert error-data)))))))
- (lambda (result)
- (if (file-exists-p error-file)
- (let ((buf (find-file-noselect error-file)))
- (pop-to-buffer
- buf '(nil . ((window-height . fit-window-to-buffer))))
- (special-mode)
- (delete-file error-file)
- (async-package--modeline-mode -1))
- (when result
- (let ((pkgs (if (listp result) result (list result))))
- (when (eq action 'install)
- (customize-save-variable
- 'package-selected-packages
- (delete-dups (append pkgs package-selected-packages))))
- (package-load-all-descriptors) ; refresh package-alist.
- (mapc #'package-activate pkgs) ; load packages.
- (async-package--modeline-mode -1)
- (message "%s %s packages done" action-string (length packages))
- (run-with-timer
- 0.1 nil
- (lambda (lst str)
- (dired-async-mode-line-message
- "%s %d package(s) done"
- 'async-package-message
- str (length lst)))
- packages action-string)
- (if (zerop (nth 7 (file-attributes log-file)))
- (delete-file log-file)
- (async-bytecomp--file-to-comp-buffer-1 log-file)))))
- (run-hooks 'async-pkg-install-after-hook)))
- 'async-pkg-install t)
- (async-package--modeline-mode 1)))
-
-(provide 'async-package)
-
-;;; async-package.el ends here
+++ /dev/null
-;; -*- no-byte-compile: t; lexical-binding: nil -*-
-(define-package "async" "20251005.634"
- "Asynchronous processing in Emacs."
- '((emacs "24.4"))
- :url "https://github.com/jwiegley/emacs-async"
- :commit "31cb2fea8f4bc7a593acd76187a89075d8075500"
- :revdesc "31cb2fea8f4b"
- :keywords '("async")
- :authors '(("John Wiegley" . "jwiegleyNOSPAMgmail.com"))
- :maintainers '(("Thierry Volpiatto" . "thievolNOSPAMposteo.net")))
+++ /dev/null
-;;; async.el --- Asynchronous processing in Emacs -*- lexical-binding: t -*-
-
-;; Copyright (C) 2012-2022 Free Software Foundation, Inc.
-
-;; Author: John Wiegley <jwiegleyNOSPAMgmail.com>
-;; Maintainer: Thierry Volpiatto <thievolNOSPAMposteo.net>
-
-;; Created: 18 Jun 2012
-;; Package-Version: 20251005.634
-;; Package-Revision: 31cb2fea8f4b
-;; Package-Requires: ((emacs "24.4"))
-
-;; 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 3 of the License, 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 this program. If not, see <https://www.gnu.org/licenses/>.
-\f
-;;; Commentary:
-
-;; Adds the ability to call asynchronous functions and process with ease. See
-;; the documentation for `async-start' and `async-start-process'.
-\f
-;;; Code:
-
-(eval-when-compile (require 'cl-lib))
-
-(defvar tramp-password-prompt-regexp)
-
-(defgroup async nil
- "Simple asynchronous processing in Emacs"
- :group 'lisp)
-
-(defcustom async-variables-noprops-function #'async--purecopy
- "Default function to remove text properties in variables."
- :type 'function)
-
-(defcustom async-prompt-for-password t
- "Prompt for password in parent Emacs if needed when non nil.
-When this is nil child Emacs will hang forever when a user interaction
-for password is required unless a password is stored in a \".authinfo\" file."
- :type 'boolean)
-
-(defvar async-process-noquery-on-exit nil
- "Used as the :noquery argument to `make-process'.
-
-Intended to be let-bound around a call to `async-start' or
-`async-start-process'. If non-nil, the child Emacs process will
-be silently killed if the user exits the parent Emacs.")
-
-(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
- "Non-nil if the subprocess is not Emacs executing a lisp form.")
-(defvar async-callback-value nil)
-(defvar async-callback-value-set nil)
-(defvar async-current-process nil)
-(defvar async--procvar nil)
-(defvar async-read-marker nil
- "Position from which we read the last message packet.
-
-Message packets are delivered from client line-by-line as base64
-encoded strings.")
-(defvar async-child-init nil
- "Initialisation file for async child Emacs.
-
-If defined this allows for an init file to setup the child Emacs. It
-should not be your normal init.el as that would likely load more
-things that you require. It should limit itself to ensuring paths have
-been setup so any async code can load libraries you expect.")
-
-;; For emacs<29 (only exists in emacs-29+).
-(defvar print-symbols-bare)
-
-(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)))
-
-(defvar async-inject-variables-exclude-regexps '("-syntax-table\\'" "-abbrev-table\\'")
- "A list of regexps that `async-inject-variables' should ignore.")
-
-(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) and variables matching one of
-`async-inject-variables-exclude-regexps'.
-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)
- (when (and sname
- (or (null include-regexp)
- (string-match include-regexp sname))
- (or (null exclude-regexp)
- (not (string-match exclude-regexp sname)))
- (cl-loop for re in async-inject-variables-exclude-regexps
- never (string-match-p re sname)))
- (setq value (symbol-value sym))
- (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
- ;; we need to check this because theoretically
- ;; `async-callback' could've killed it already
- (when (buffer-live-p (process-buffer proc))
- (kill-buffer (process-buffer proc)))))
- (set (make-local-variable 'async-callback-value) proc)
- (set (make-local-variable 'async-callback-value-set) t))
- ;; Maybe strip out unreadable "#"; They are replaced by
- ;; empty string unless they are prefixing a special
- ;; object like a marker. See issue #145.
- (widen)
- (goto-char (point-min))
- (save-excursion
- ;; Transform markers in list like
- ;; (marker (moves after insertion) at 2338 in
- ;; test\.org) so that remap text properties function
- ;; can parse it to restitute marker.
- (while (re-search-forward "#<\\([^>]*\\)>" nil t)
- (replace-match (concat "(" (match-string 1) ")") t t)))
- (while (re-search-forward "#(" nil t)
- (replace-match "(" t t))
- (goto-char (point-max))
- (backward-sexp)
- (let ((value (read (current-buffer))))
- (async-handle-result async-callback value (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-read-from-client (proc string &optional prompt-for-pwd)
- "Process text from client process.
-
-The string chunks usually arrive in maximum of 4096 bytes, so a
-long client message might be split into multiple calls of this
-function.
-
-We use a marker `async-read-marker' to track the position of the
-lasts complete line. Every time we get new input, we try to look
-for newline, and if found, process the entire line and bump the
-marker position to the end of this next line.
-
-Argument PROMPT-FOR-PWD allow binding lexically the value of
-`async-prompt-for-password', if unspecified its global value
-is used."
- (with-current-buffer (process-buffer proc)
- (when (and prompt-for-pwd
- (boundp 'tramp-password-prompt-regexp)
- tramp-password-prompt-regexp
- (string-match tramp-password-prompt-regexp string))
- (process-send-string
- proc (concat (read-passwd (match-string 0 string)) "\n")))
- (goto-char (point-max))
- (save-excursion
- (insert string))
-
- (while (search-forward "\n" nil t)
- (save-excursion
- (save-restriction
- (widen)
- (narrow-to-region async-read-marker (point))
- (goto-char (point-min))
- (let (msg)
- (condition-case nil
- ;; It is safe to throw errors in the read because we
- ;; send messages always on their own line, and they
- ;; are always a base64 encoded string, so a message
- ;; will always read. We will also ignore the rest
- ;; of this line since there won't be anything
- ;; interesting.
- (while (setq msg (read (current-buffer)))
- (let ((msg-decoded (ignore-errors (base64-decode-string msg))))
- (when msg-decoded
- (setq msg-decoded (car (read-from-string msg-decoded)))
- (when (and (listp msg-decoded)
- (async-message-p msg-decoded)
- async-callback)
- (funcall async-callback msg-decoded)))))
- ;; This is OK, we reached the end of the chunk subprocess sent
- ;; at this time.
- (invalid-read-syntax t)
- (end-of-file t)))
- (goto-char (point-max))
- (move-marker async-read-marker (point)))))))
-
-(defun async--receive-sexp (&optional stream)
- ;; FIXME: Why use `utf-8-auto' instead of `utf-8-unix'? This is
- ;; a communication channel over which we have complete control,
- ;; so we get to choose exactly which encoding and EOL we use, isn't
- ;; it?
- ;; UPDATE: We use now `utf-8-emacs-unix' instead of `utf-8-auto' as
- ;; recommended in bug#165.
- (let ((sexp (decode-coding-string (base64-decode-string (read stream))
- 'utf-8-emacs-unix))
- ;; Parent expects UTF-8 encoded text.
- (coding-system-for-write 'utf-8-emacs-unix))
- (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 t)))
-
-(defun async--insert-sexp (sexp)
- (let (print-level
- print-length
- (print-escape-nonascii t)
- (print-circle t)
- ;; Fix bug#153 in emacs-29 with symbol's positions.
- (print-symbols-bare 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-emacs-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
- (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-emacs-unix)
- (args-left command-line-args-left))
- (setq async-in-child-emacs t
- debug-on-error async-debug
- command-line-args-left nil)
- (condition-case-unless-debug err
- (let ((ret (funcall
- (async--receive-sexp (unless async-send-over-pipe
- args-left)))))
- ;; The newlines makes client messages more robust and also
- ;; handle some weird line-buffering issues on windows.
- ;; Sometimes, the last "chunk" was not read by the filter,
- ;; so a newline here should force a buffer flush.
- (princ "\n")
- (prin1 ret)
- (princ "\n"))
- (error
- (progn
- (princ "\n")
- (prin1 (list 'async-signal err))
- (princ "\n"))))))
-
-(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 if VALUE is an async.el message packet."
- (and (listp value)
- (plist-get value :async-message)))
-
-(defun async-send (process-or-key &rest args)
- "Send the given message to the asynchronous child or parent Emacs.
-
-To send messages from the parent to a child, PROCESS-OR-KEY is
-the child process object. ARGS is a plist. Example:
-
- (async-send proc :operation :load-file :file \"this file\")
-
-To send messages from the child to the parent, PROCESS-OR-KEY is
-the first key of the plist, ARGS is a value followed by
-optionally more key-value pairs. Example:
-
- (async-send :status \"finished\" :file-size 123)"
- (let ((args (append args '(:async-message t))))
- (if async-in-child-emacs
- ;; `princ' because async--insert-sexp already quotes everything.
- (princ
- (with-temp-buffer
- (async--insert-sexp (cons process-or-key args))
- ;; always make sure that one message package has its own
- ;; line as there can be any random debug garbage printed
- ;; above it.
- (concat "\n" (buffer-string))))
- (async--transmit-sexp process-or-key (list 'quote args)))))
-
-(defun async-receive ()
- "Receive message from parent Emacs.
-
-The child process blocks until a message is received.
-
-Message is a plist with one key :async-message set to t always
-automatically added to signify this plist is an async message.
-
-You can use `async-message-p' to test if the payload was a
-message.
-
-Use
-
- (let ((msg (async-receive))) ...)
-
-to read and process a message."
- (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 "*")))
- (buf-err (generate-new-buffer (concat "*" name ":err*")))
- (prt-for-pwd async-prompt-for-password)
- (proc (let ((process-connection-type nil))
- (make-process
- :name name
- :buffer buf
- :stderr buf-err
- :command (cons program program-args)
- :noquery async-process-noquery-on-exit))))
- (set-process-sentinel
- (get-buffer-process buf-err)
- (lambda (proc _change)
- (unless (or async-debug (process-live-p proc))
- (kill-buffer (process-buffer proc)))))
- (with-current-buffer buf
- (set (make-local-variable 'async-callback) finish-func)
- (set (make-local-variable 'async-read-marker)
- (set-marker (make-marker) (point-min) buf))
- (set-marker-insertion-type async-read-marker nil)
- (set-process-sentinel proc #'async-when-done)
- ;; Pass the value of `async-prompt-for-password' to the process
- ;; filter fn through the lexical local var prt-for-pwd (Issue#182).
- (set-process-filter proc (lambda (proc string)
- (async-read-from-client
- proc string prt-for-pwd)))
- (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.")
-
-(defvar async-library nil
- "Cache async library path.
-It is useful only when you run multiple async processes in a loop, to
-avoid calling many times `locate-library' which is costly.
-This variable should be let bound around an `async-start' call and not
-used globally. Should be found with `locate-library'.")
-
-(defun async--emacs-program-args (&optional sexp)
- "Return a list of arguments for invoking the child Emacs."
- ;; Using `locate-library' ensure we use the right file
- ;; when the .elc have been deleted, its result can be cached in
- ;; `async-library' see Issue#193.
- (let ((args (list async-quiet-switch "-l" (or async-library
- (locate-library "async")))))
- (when async-child-init
- (setq args (append args (list "-l" async-child-init))))
- (append args (list "-batch" "-f" "async-batch-invoke"
- (if sexp
- (with-temp-buffer
- (async--insert-sexp (list 'quote sexp))
- (buffer-string))
- "<none>")))))
-
-;;;###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 you call `async-send' from a child process, the message will
-be also passed to the FINISH-FUNC. You can test RESULT to see if
-it is a message by using `async-message-p'. If nil, it means
-this is the final result. Example of the FINISH-FUNC:
-
- (lambda (result)
- (if (async-message-p result)
- (message \"Received a message from child process: %s\" result)
- (message \"Async process done, result: %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)
-
-Special case:
-If the output of START-FUNC is a string with properties
-e.g. (buffer-string) RESULT will be transformed in a list where the
-car is the string itself (without props) and the cdr the rest of
-properties, this allows using in FINISH-FUNC the string without
-properties and then apply the properties in cdr to this string (if
-needed).
-Properties handling special objects like markers are returned as
-list to allow restoring them later.
-See <https://github.com/jwiegley/emacs-async/issues/145> for more infos.
-
-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-emacs-unix))
- (setq async--procvar
- (apply 'async-start-process
- "emacs" (file-truename
- (expand-file-name invocation-name
- invocation-directory))
- finish-func
- (async--emacs-program-args (if (not async-send-over-pipe) sexp))))
-
- (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
+++ /dev/null
-;;; dired-async.el --- Asynchronous dired actions -*- lexical-binding: t -*-
-
-;; Copyright (C) 2012-2019 Free Software Foundation, Inc.
-
-;; Authors: John Wiegley <jwiegleyNOSPAMgmail.com>
-;; Thierry Volpiatto <thievolNOSPAMposteo.net>
-
-;; Keywords: dired async network
-;; 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 3 of the License, 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 this program. If not, see <https://www.gnu.org/licenses/>.
-\f
-;;; 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:
-\f
-(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)
-
-(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'."
- :type 'function)
-
-(defcustom dired-async-log-file "/tmp/dired-async.log"
- "File use to communicate errors from Child Emacs to host Emacs."
- :type 'string)
-
-(defcustom dired-async-mode-lighter '(:eval
- (when (eq major-mode 'dired-mode)
- " Async"))
- "Mode line lighter used for `dired-async-mode'."
- :risky t
- :type 'sexp)
-
-(defcustom dired-async-skip-fast nil
- "If non-nil, skip async for fast operations.
-Same device renames and copying and renaming files smaller than
-`dired-async-small-file-max' are considered fast.
-If the total size of all files exceed `dired-async-small-file-max'
-operation is not considered fast."
- :risky t
- :type 'boolean)
-
-(defcustom dired-async-small-file-max 5000000
- "Files smaller than this in bytes are considered fast to copy
-or rename for `dired-async-skip-fast'."
- :risky t
- :type 'integer)
-
-(defcustom dired-async-large-file-warning-threshold large-file-warning-threshold
- "Same as `large-file-warning-threshold' but for dired-async."
- :type 'integer)
-
-(defface dired-async-message
- '((t (:foreground "yellow")))
- "Face used for mode-line message.")
-
-(defface dired-async-failures
- '((t (:foreground "red")))
- "Face used for mode-line message.")
-
-(defface dired-async-mode-message
- '((t (:foreground "Gold")))
- "Face used for `dired-async--modeline-mode' lighter.")
-
-(define-minor-mode dired-async--modeline-mode
- "Notify mode-line that an async process run."
- :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 (&optional propname)
- (cl-loop for p in (process-list)
- when (process-get p (or propname 'dired-async-process))
- 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))))))
-
-(defsubst dired-async--directory-p (attributes)
- "Return non-nil if ATTRIBUTES is for a directory.
-See `file-attributes'."
- ;; Can also be a string for symlinks, so check for t explicitly.
- (eq (file-attribute-type attributes) t))
-
-(defsubst dired-async--same-device-p (f1 f2)
- "Return non-nil if F1 and F2 have the same device number."
- ;; file-attribute-device-number may be a cons cell, so use equal for
- ;; testing (See Emacs bug/58446).
- (equal (file-attribute-device-number (file-attributes f1))
- (file-attribute-device-number (file-attributes f2))))
-
-(defun dired-async--small-file-p (file &optional attrs)
- "Return non-nil if FILE is considered small.
-
-File is considered small if it size is smaller than
-`dired-async-small-file-max'."
- (let ((a (or attrs (file-attributes file))))
- ;; Directories are always large since we can't easily figure out
- ;; their total size.
- (and (not (dired-async--directory-p a))
- (< (file-attribute-size a) dired-async-small-file-max))))
-
-(defun dired-async--skip-async-p (file-creator file name-constructor &optional attrs)
- "Return non-nil if we should skip async for FILE.
-See `dired-create-files' for FILE-CREATOR and NAME-CONSTRUCTOR."
- ;; Skip async for small files.
- (or (dired-async--small-file-p file attrs)
- ;; Also skip async for same device renames.
- (and (eq file-creator 'dired-rename-file)
- (let ((new (funcall name-constructor file)))
- (dired-async--same-device-p file (file-name-directory new))))))
-
-(defun dired-async--smart-create-files (old-func file-creator
- operation fn-list name-constructor
- &optional marker-char)
- "Around advice for `dired-create-files'.
-Uses async like `dired-async-create-files' but skips certain fast
-cases if `dired-async-skip-fast' is non-nil."
- (let ((total-size 0)
- async-list quick-list)
- (if (or (eq file-creator 'backup-file)
- (null dired-async-skip-fast))
- (setq async-list fn-list)
- (dolist (old fn-list)
- (let ((attrs (file-attributes old)))
- (if (dired-async--skip-async-p
- file-creator old name-constructor attrs)
- (progn
- (push old quick-list)
- (setq total-size (+ total-size (nth 7 attrs))))
- (push old async-list)))))
- (when (> total-size dired-async-small-file-max)
- (setq async-list (append quick-list async-list)
- quick-list nil))
- (when async-list
- (dired-async-create-files
- file-creator operation (nreverse async-list)
- name-constructor marker-char))
- (when quick-list
- (funcall old-func file-creator operation
- (nreverse quick-list) name-constructor marker-char))))
-
-(defun dired-async--abort-if-file-too-large (size op-type filename)
- "Warn when FILENAME larger than `dired-async-large-file-warning-threshold'.
-Same as `abort-if-file-too-large' but without user-error."
- (when (and dired-async-large-file-warning-threshold size
- (> size dired-async-large-file-warning-threshold))
- (files--ask-user-about-large-file
- size op-type filename nil)))
-
-(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 create-dir)
- (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)))
- ;; Skip file if it is too large.
- (if (and (member operation '("Copy" "Rename"))
- dired-async-large-file-warning-threshold
- (eq (dired-async--abort-if-file-too-large
- (file-attribute-size
- (file-attributes (file-truename from)))
- (downcase operation) from)
- 'abort))
- (push from skipped)
- (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)))))))
- (let ((dirp (file-directory-p to))
- (dest (file-name-directory to)))
- (when (boundp 'dired-create-destination-dirs)
- (setq create-dir
- (cl-case dired-create-destination-dirs
- (always 'always)
- (ask (and (null dirp)
- (null (file-directory-p dest))
- (y-or-n-p (format "Create directory `%s'? " dest)))
- 'always))))))
- ;; Start async process.
- (when async-fn-list
- (process-put
- (async-start `(lambda ()
- (require 'cl-lib) (require 'dired-aux) (require 'dired-x)
- ,(async-inject-variables dired-async-env-variables-regexp)
- (advice-add #'files--ask-user-about-large-file
- :override (lambda (&rest args) nil))
- (let ((dired-recursive-copies (quote always))
- (dired-copy-preserve-time
- ,dired-copy-preserve-time)
- (dired-create-destination-dirs ',create-dir)
- (dired-vc-rename-file ,dired-vc-rename-file)
- auth-source-save-behavior)
- (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)
- 'dired-async-process t)
- ;; 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)))
-
-;;;###autoload
-(define-minor-mode dired-async-mode
- "Do dired actions asynchronously."
- :lighter dired-async-mode-lighter
- :global t
- (if dired-async-mode
- (progn
- (advice-add 'dired-create-files :around #'dired-async--smart-create-files)
- (advice-add 'wdired-do-renames :around #'dired-async-wdired-do-renames))
- (progn
- (advice-remove 'dired-create-files #'dired-async--smart-create-files)
- (advice-remove 'wdired-do-renames #'dired-async-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
+++ /dev/null
-;;; smtpmail-async.el --- Send e-mail with smtpmail.el asynchronously -*- lexical-binding: t -*-
-
-;; Copyright (C) 2012-2022 Free Software Foundation, Inc.
-
-;; Author: John Wiegley <jwiegleyNOSPAMgmail.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 3 of the License, 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 this program. If not, see <https://www.gnu.org/licenses/>.
-\f
-;;; 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
--- /dev/null
+Adds the ability to call asynchronous functions and process with ease. See
+the documentation for `async-start' and `async-start-process'.
--- /dev/null
+;;; async-autoloads.el --- automatically extracted autoloads (do not edit) -*- lexical-binding: t -*-
+;; Generated by the `loaddefs-generate' function.
+
+;; This file is part of GNU Emacs.
+
+;;; Code:
+
+(add-to-list 'load-path (or (and load-file-name (directory-file-name (file-name-directory load-file-name))) (car load-path)))
+
+
+\f
+;;; 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)")
+(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 you call `async-send' from a child process, the message will
+be also passed to the FINISH-FUNC. You can test RESULT to see if
+it is a message by using `async-message-p'. If nil, it means
+this is the final result. Example of the FINISH-FUNC:
+
+ (lambda (result)
+ (if (async-message-p result)
+ (message \"Received a message from child process: %s\" result)
+ (message \"Async process done, result: %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)
+
+Special case:
+If the output of START-FUNC is a string with properties
+e.g. (buffer-string) RESULT will be transformed in a list where the
+car is the string itself (without props) and the cdr the rest of
+properties, this allows using in FINISH-FUNC the string without
+properties and then apply the properties in cdr to this string (if
+needed).
+Properties handling special objects like markers are returned as
+list to allow restoring them later.
+See <https://github.com/jwiegley/emacs-async/issues/145> for more infos.
+
+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)")
+(register-definition-prefixes "async" '("async-"))
+
+\f
+;;; 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)")
+(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'.
+NOTE: Use this mode only if you install/upgrade etc... your packages
+synchronously, if you use a package manager like helm-package.el which
+by default is async you don't need this.
+
+This is a global minor mode. If called interactively, toggle the
+`Async-Bytecomp-Package mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
+
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
+
+To check whether the minor mode is enabled in the current buffer,
+evaluate `(default-value \\='async-bytecomp-package-mode)'.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
+(fn &optional ARG)" t)
+(autoload 'async-byte-compile-file "async-bytecomp"
+"Byte compile Lisp code FILE asynchronously.
+
+Same as `byte-compile-file' but asynchronous.
+
+(fn FILE)" t)
+(register-definition-prefixes "async-bytecomp" '("async-"))
+
+\f
+;;; Generated autoloads from async-package.el
+
+(register-definition-prefixes "async-package" '("async-p"))
+
+\f
+;;; 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.
+
+This is a global minor mode. If called interactively, toggle the
+`Dired-Async mode' mode. If the prefix argument is positive, enable the
+mode, and if it is zero or negative, disable the mode.
+
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
+
+To check whether the minor mode is enabled in the current buffer,
+evaluate `(default-value \\='dired-async-mode)'.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
+(fn &optional ARG)" t)
+(autoload 'dired-async-do-copy "dired-async"
+"Run ‘dired-do-copy’ asynchronously.
+
+(fn &optional ARG)" t)
+(autoload 'dired-async-do-symlink "dired-async"
+"Run ‘dired-do-symlink’ asynchronously.
+
+(fn &optional ARG)" t)
+(autoload 'dired-async-do-hardlink "dired-async"
+"Run ‘dired-do-hardlink’ asynchronously.
+
+(fn &optional ARG)" t)
+(autoload 'dired-async-do-rename "dired-async"
+"Run ‘dired-do-rename’ asynchronously.
+
+(fn &optional ARG)" t)
+(register-definition-prefixes "dired-async" '("dired-async-"))
+
+\f
+;;; Generated autoloads from smtpmail-async.el
+
+(register-definition-prefixes "smtpmail-async" '("async-smtpmail-"))
+\f
+;;; End of scraped data
+
+(provide 'async-autoloads)
+
+;; Local Variables:
+;; version-control: never
+;; no-byte-compile: t
+;; no-update-autoloads: t
+;; no-native-compile: t
+;; coding: utf-8-emacs-unix
+;; End:
+
+;;; async-autoloads.el ends here
--- /dev/null
+;;; async-bytecomp.el --- Compile elisp files asynchronously -*- lexical-binding: t -*-
+
+;; Copyright (C) 2014-2022 Free Software Foundation, Inc.
+
+;; Authors: John Wiegley <jwiegleyNOSPAMgmail.com>
+;; Thierry Volpiatto <thievolNOSPAMposteo.net>
+
+;; Keywords: dired async byte-compile
+;; 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 3 of the License, 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 this program. If not, see <https://www.gnu.org/licenses/>.
+
+;;; 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. Single files can be compiled with
+;; `async-byte-compile-file'. The benefit is your files will be
+;; compiled in a clean environment without the old *.el files
+;; loaded. A mode `async-bytecomp-package-mode' is provided to
+;; automatically compile packages asynchronously when installing or
+;; upgrading, 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 advising the function `package--compile' when
+;; `async-bytecomp-package-mode' is enabled. This mode is useful
+;; only when using a synchronous package manager (e.g. M-x
+;; list-package), users of M-x helm-packages don't need this anymore.
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'async)
+(require 'bytecomp)
+
+(declare-function package-desc-name "package.el")
+(declare-function package-desc-dir "package.el")
+
+(defcustom async-bytecomp-allowed-packages 'all
+ "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' (default), 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 "async-bytecomp.log"
+ "Prefix for a file used to pass errors from async process to the caller.
+The `file-name-nondirectory' part of the value is passed to
+`make-temp-file' as a prefix. When the value is an absolute
+path, then the `file-name-directory' part of it is expanded in
+the calling process (with `expand-file-name') and used as a value
+of variable `temporary-file-directory' in async processes.")
+
+(defvar async-bytecomp-load-variable-regexp "\\`load-path\\'"
+ "The variable used by `async-inject-variables' when (re)compiling async.")
+
+(defun async-bytecomp--file-to-comp-buffer-1 (log-file &optional postproc)
+ (let ((buf (get-buffer-create byte-compile-log-buffer)))
+ (with-current-buffer buf
+ (goto-char (point-max))
+ (let ((inhibit-read-only t))
+ (insert-file-contents log-file)
+ (compilation-mode))
+ (display-buffer buf)
+ (delete-file log-file)
+ (and postproc (funcall postproc)))))
+
+(defun async-bytecomp--file-to-comp-buffer (file-or-dir &optional quiet type log-file)
+ (let ((bn (file-name-nondirectory (directory-file-name file-or-dir)))
+ (action-name (pcase type
+ ('file "File")
+ ('directory "Directory"))))
+ (if (and log-file (file-exists-p log-file))
+ (async-bytecomp--file-to-comp-buffer-1
+ log-file
+ (unless quiet
+ (lambda ()
+ (let ((n 0))
+ (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 bn)
+ (message "%s `%s' compiled asynchronously with warnings"
+ action-name bn)))))))
+ (unless quiet
+ (message "%s `%s' compiled asynchronously with success" action-name bn)))))
+
+(defmacro async-bytecomp--comp-buffer-to-file ()
+ "Write contents of `byte-compile-log-buffer' to a log file.
+The log file is a temporary file that name is determined by
+`async-byte-compile-log-file', which see. Return the actual log
+file name, or nil if no log file has been created."
+ `(when (get-buffer byte-compile-log-buffer)
+ (let ((error-data (with-current-buffer byte-compile-log-buffer
+ (buffer-substring-no-properties (point-min) (point-max)))))
+ (unless (string= error-data "")
+ ;; The `async-byte-compile-log-file' used to be an absolute file name
+ ;; shared amongst all compilation async processes. For backward
+ ;; compatibility the directory part of it is used to create logs the same
+ ;; directory while the nondirectory part denotes the PREFIX for
+ ;; `make-temp-file' call. The `temporary-file-directory' is bound, such
+ ;; that the async process uses one set by the caller.
+ (let ((temporary-file-directory
+ ,(or (when (and async-byte-compile-log-file
+ (file-name-absolute-p
+ async-byte-compile-log-file))
+ (expand-file-name (file-name-directory
+ async-byte-compile-log-file)))
+ temporary-file-directory))
+ (log-file (make-temp-file ,(let ((log-file
+ (file-name-nondirectory
+ async-byte-compile-log-file)))
+ (format "%s%s"
+ log-file
+ (if (string-suffix-p "." log-file)
+ "" "."))))))
+ (with-temp-file log-file
+ (erase-buffer)
+ (insert error-data))
+ log-file)))))
+
+;;;###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 log-file)
+ (async-bytecomp--file-to-comp-buffer directory quiet 'directory log-file))))
+ (async-start
+ `(lambda ()
+ (require 'bytecomp)
+ ,(async-inject-variables async-bytecomp-load-variable-regexp)
+ (let ((default-directory (file-name-as-directory ,directory)))
+ (add-to-list 'load-path default-directory)
+ (byte-recompile-directory ,directory 0 t)
+ ,(macroexpand '(async-bytecomp--comp-buffer-to-file))))
+ 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))
+
+(defun async--package-compile (orig-fun pkg-desc &rest args)
+ (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.
+ (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))
+ (apply orig-fun pkg-desc args))))
+
+;;;###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'.
+NOTE: Use this mode only if you install/upgrade etc... your packages
+synchronously, if you use a package manager like helm-package.el which
+by default is async you don't need this."
+ :group 'async
+ :global t
+ (if async-bytecomp-package-mode
+ (advice-add 'package--compile :around #'async--package-compile)
+ (advice-remove 'package--compile #'async--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 log-file)
+ (async-bytecomp--file-to-comp-buffer file nil 'file log-file))))
+ (async-start
+ `(lambda ()
+ (require 'bytecomp)
+ ,(async-inject-variables async-bytecomp-load-variable-regexp)
+ (let ((default-directory ,(file-name-directory file)))
+ (add-to-list 'load-path default-directory)
+ (byte-compile-file ,file)
+ ,(macroexpand '(async-bytecomp--comp-buffer-to-file))))
+ call-back)))
+
+(provide 'async-bytecomp)
+
+;;; async-bytecomp.el ends here
--- /dev/null
+;;; async-package.el --- Fetch packages asynchronously -*- lexical-binding: t -*-
+
+;; Copyright (C) 2014-2022 Free Software Foundation, Inc.
+
+;; Author: Thierry Volpiatto <thievolNOSPAMposteo.net>
+
+;; Keywords: dired async byte-compile package
+;; 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 3 of the License, 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 this program. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Provide the function `async-package-do-action' to
+;; (re)install/upgrade packages asynchronously.
+
+;;; Code:
+
+(eval-when-compile (require 'cl-lib))
+(require 'async-bytecomp)
+(require 'dired-async)
+(require 'package)
+
+(define-minor-mode async-package--modeline-mode
+ "Notify mode-line that an async process run."
+ :group 'async
+ :global t
+ :lighter (:eval (propertize (format " [%s async job Installing package(s)]"
+ (length (dired-async-processes
+ 'async-pkg-install)))
+ 'face 'async-package-message))
+ (unless async-package--modeline-mode
+ (let ((visible-bell t)) (ding))))
+
+(defvar async-pkg-install-after-hook nil
+ "Hook that run after package installation.
+The hook runs in the call-back once installation is done in child emacs.")
+
+(defface async-package-message
+ '((t (:foreground "yellow")))
+ "Face used for mode-line message."
+ :group 'async)
+
+(defun async-package-do-action (action packages error-file)
+ "Execute ACTION asynchronously on PACKAGES.
+Argument ACTION can be one of \\='install, \\='upgrade, \\='reinstall.
+Argument PACKAGES is a list of packages (symbols).
+Argument ERROR-FILE is the file where errors are logged, if some."
+ (require 'async-bytecomp)
+ (let ((fn (pcase action
+ ('install 'package-install)
+ ('upgrade 'package-upgrade)
+ ('reinstall 'package-reinstall)))
+ (action-string (pcase action
+ ('install "Installing")
+ ('upgrade "Upgrading")
+ ('reinstall "Reinstalling")))
+ ;; As PACKAGES are installed and compiled in a single async
+ ;; process we don't need to compute log-file in child process
+ ;; i.e. we use the same log-file for all PACKAGES.
+ (log-file (make-temp-file
+ (expand-file-name
+ (file-name-nondirectory async-byte-compile-log-file)
+ temporary-file-directory))))
+ (message "%s %s package(s)..." action-string (length packages))
+ (process-put
+ (async-start
+ `(lambda ()
+ (require 'bytecomp)
+ (setq package-archives ',package-archives
+ package-pinned-packages ',package-pinned-packages
+ package-archive-contents ',package-archive-contents
+ package-user-dir ,package-user-dir
+ package-alist ',package-alist
+ load-path ',load-path)
+ ;; Ensure `async-bytecomp-package-mode' doesn't kick in
+ ;; (issue #194) as some packages may enable it
+ ;; inconditionally. We don't need to compile async as we are
+ ;; already async and in a clean environment.
+ (require 'async-bytecomp)
+ (setq async-bytecomp-allowed-packages nil)
+ (prog1
+ (condition-case err
+ (mapc ',fn ',packages)
+ (error
+ (with-temp-file ,error-file
+ (insert
+ (format
+ "%S:\n Please refresh package list before %s"
+ err ,action-string)))))
+ (when (get-buffer byte-compile-log-buffer)
+ (let ((error-data (with-current-buffer byte-compile-log-buffer
+ (buffer-substring-no-properties
+ (point-min) (point-max)))))
+ (unless (string= error-data "")
+ (with-temp-file ,log-file
+ (erase-buffer)
+ (insert error-data)))))))
+ (lambda (result)
+ (if (file-exists-p error-file)
+ (let ((buf (find-file-noselect error-file)))
+ (pop-to-buffer
+ buf '(nil . ((window-height . fit-window-to-buffer))))
+ (special-mode)
+ (delete-file error-file)
+ (async-package--modeline-mode -1))
+ (when result
+ (let ((pkgs (if (listp result) result (list result))))
+ (when (eq action 'install)
+ (customize-save-variable
+ 'package-selected-packages
+ (delete-dups (append pkgs package-selected-packages))))
+ (package-load-all-descriptors) ; refresh package-alist.
+ (mapc #'package-activate pkgs) ; load packages.
+ (async-package--modeline-mode -1)
+ (message "%s %s packages done" action-string (length packages))
+ (run-with-timer
+ 0.1 nil
+ (lambda (lst str)
+ (dired-async-mode-line-message
+ "%s %d package(s) done"
+ 'async-package-message
+ str (length lst)))
+ packages action-string)
+ (if (zerop (nth 7 (file-attributes log-file)))
+ (delete-file log-file)
+ (async-bytecomp--file-to-comp-buffer-1 log-file)))))
+ (run-hooks 'async-pkg-install-after-hook)))
+ 'async-pkg-install t)
+ (async-package--modeline-mode 1)))
+
+(provide 'async-package)
+
+;;; async-package.el ends here
--- /dev/null
+;; -*- no-byte-compile: t; lexical-binding: nil -*-
+(define-package "async" "20260318.1803"
+ "Asynchronous processing in Emacs."
+ '((emacs "24.4"))
+ :url "https://github.com/jwiegley/emacs-async"
+ :commit "5faab28916603bb324d9faba057021ce028ca847"
+ :revdesc "5faab2891660"
+ :keywords '("async")
+ :authors '(("John Wiegley" . "jwiegleyNOSPAMgmail.com"))
+ :maintainers '(("Thierry Volpiatto" . "thievolNOSPAMposteo.net")))
--- /dev/null
+;;; async.el --- Asynchronous processing in Emacs -*- lexical-binding: t -*-
+
+;; Copyright (C) 2012-2022 Free Software Foundation, Inc.
+
+;; Author: John Wiegley <jwiegleyNOSPAMgmail.com>
+;; Maintainer: Thierry Volpiatto <thievolNOSPAMposteo.net>
+
+;; Created: 18 Jun 2012
+;; Package-Version: 20260318.1803
+;; Package-Revision: 5faab2891660
+;; Package-Requires: ((emacs "24.4"))
+
+;; Keywords: 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 3 of the License, 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 this program. If not, see <https://www.gnu.org/licenses/>.
+\f
+;;; Commentary:
+
+;; Adds the ability to call asynchronous functions and process with ease. See
+;; the documentation for `async-start' and `async-start-process'.
+\f
+;;; Code:
+
+(eval-when-compile (require 'cl-lib))
+
+(defvar tramp-password-prompt-regexp)
+
+(defgroup async nil
+ "Simple asynchronous processing in Emacs"
+ :group 'lisp)
+
+(defcustom async-variables-noprops-function #'async--purecopy
+ "Default function to remove text properties in variables."
+ :type 'function)
+
+(defcustom async-prompt-for-password t
+ "Prompt for password in parent Emacs if needed when non nil.
+When this is nil child Emacs will hang forever when a user interaction
+for password is required unless a password is stored in a \".authinfo\" file."
+ :type 'boolean)
+
+(defvar async-process-noquery-on-exit nil
+ "Used as the :noquery argument to `make-process'.
+
+Intended to be let-bound around a call to `async-start' or
+`async-start-process'. If non-nil, the child Emacs process will
+be silently killed if the user exits the parent Emacs.")
+
+(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
+ "Non-nil if the subprocess is not Emacs executing a lisp form.")
+(defvar async-callback-value nil)
+(defvar async-callback-value-set nil)
+(defvar async-current-process nil)
+(defvar async--procvar nil)
+(defvar async-read-marker nil
+ "Position from which we read the last message packet.
+
+Message packets are delivered from client line-by-line as base64
+encoded strings.")
+(defvar async-child-init nil
+ "Initialisation file for async child Emacs.
+
+If defined this allows for an init file to setup the child Emacs. It
+should not be your normal init.el as that would likely load more
+things that you require. It should limit itself to ensuring paths have
+been setup so any async code can load libraries you expect.")
+
+;; For emacs<29 (only exists in emacs-29+).
+(defvar print-symbols-bare)
+
+(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)))
+
+(defvar async-inject-variables-exclude-regexps '("-syntax-table\\'" "-abbrev-table\\'")
+ "A list of regexps that `async-inject-variables' should ignore.")
+
+(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) and variables matching one of
+`async-inject-variables-exclude-regexps'.
+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)
+ (when (and sname
+ (or (null include-regexp)
+ (string-match include-regexp sname))
+ (or (null exclude-regexp)
+ (not (string-match exclude-regexp sname)))
+ (cl-loop for re in async-inject-variables-exclude-regexps
+ never (string-match-p re sname)))
+ (setq value (symbol-value sym))
+ (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
+ ;; we need to check this because theoretically
+ ;; `async-callback' could've killed it already
+ (when (buffer-live-p (process-buffer proc))
+ (kill-buffer (process-buffer proc)))))
+ (set (make-local-variable 'async-callback-value) proc)
+ (set (make-local-variable 'async-callback-value-set) t))
+ ;; Maybe strip out unreadable "#"; They are replaced by
+ ;; empty string unless they are prefixing a special
+ ;; object like a marker. See issue #145.
+ (widen)
+ (goto-char (point-min))
+ (save-excursion
+ ;; Transform markers in list like
+ ;; (marker (moves after insertion) at 2338 in
+ ;; test\.org) so that remap text properties function
+ ;; can parse it to restitute marker.
+ (while (re-search-forward "#<\\([^>]*\\)>" nil t)
+ (replace-match (concat "(" (match-string 1) ")") t t)))
+ (while (re-search-forward "#(" nil t)
+ (replace-match "(" t t))
+ (goto-char (point-max))
+ (backward-sexp)
+ (let ((value (read (current-buffer))))
+ (async-handle-result async-callback value (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-read-from-client (proc string &optional prompt-for-pwd)
+ "Process text from client process.
+
+The string chunks usually arrive in maximum of 4096 bytes, so a
+long client message might be split into multiple calls of this
+function.
+
+We use a marker `async-read-marker' to track the position of the
+lasts complete line. Every time we get new input, we try to look
+for newline, and if found, process the entire line and bump the
+marker position to the end of this next line.
+
+Argument PROMPT-FOR-PWD allow binding lexically the value of
+`async-prompt-for-password', if unspecified its global value
+is used."
+ (with-current-buffer (process-buffer proc)
+ (when (and prompt-for-pwd
+ (boundp 'tramp-password-prompt-regexp)
+ tramp-password-prompt-regexp
+ (string-match tramp-password-prompt-regexp string))
+ (process-send-string
+ proc (concat (read-passwd (match-string 0 string)) "\n")))
+ (goto-char (point-max))
+ (save-excursion
+ (insert string))
+
+ (while (search-forward "\n" nil t)
+ (save-excursion
+ (save-restriction
+ (widen)
+ (narrow-to-region async-read-marker (point))
+ (goto-char (point-min))
+ (let (msg)
+ (condition-case nil
+ ;; It is safe to throw errors in the read because we
+ ;; send messages always on their own line, and they
+ ;; are always a base64 encoded string, so a message
+ ;; will always read. We will also ignore the rest
+ ;; of this line since there won't be anything
+ ;; interesting.
+ (while (setq msg (read (current-buffer)))
+ (let ((msg-decoded (ignore-errors (base64-decode-string msg))))
+ (when msg-decoded
+ (setq msg-decoded (car (read-from-string msg-decoded)))
+ (when (and (listp msg-decoded)
+ (async-message-p msg-decoded)
+ async-callback)
+ (funcall async-callback msg-decoded)))))
+ ;; This is OK, we reached the end of the chunk subprocess sent
+ ;; at this time.
+ (invalid-read-syntax t)
+ (end-of-file t)))
+ (goto-char (point-max))
+ (move-marker async-read-marker (point)))))))
+
+(defun async--receive-sexp (&optional stream)
+ ;; We use `utf-8-emacs-unix' for the communication channel between
+ ;; parent and child Emacs processes. This encoding can represent any
+ ;; character that Emacs is capable of processing and gives us full
+ ;; control over the EOL format. (See bug#165)
+ (let ((sexp (decode-coding-string (base64-decode-string (read stream))
+ 'utf-8-emacs-unix))
+ ;; Parent expects utf-8-emacs-unix encoded text.
+ (coding-system-for-write 'utf-8-emacs-unix))
+ (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 t)))
+
+(defun async--insert-sexp (sexp)
+ (let (print-level
+ print-length
+ (print-escape-nonascii t)
+ (print-circle t)
+ ;; Fix bug#153 in emacs-29 with symbol's positions.
+ (print-symbols-bare 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-emacs-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
+ (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-emacs-unix,
+ ;; as parent process expects.
+ (let ((coding-system-for-write 'utf-8-emacs-unix)
+ (args-left command-line-args-left))
+ (setq async-in-child-emacs t
+ debug-on-error async-debug
+ command-line-args-left nil)
+ (condition-case-unless-debug err
+ (let ((ret (funcall
+ (async--receive-sexp (unless async-send-over-pipe
+ args-left)))))
+ ;; The newlines makes client messages more robust and also
+ ;; handle some weird line-buffering issues on windows.
+ ;; Sometimes, the last "chunk" was not read by the filter,
+ ;; so a newline here should force a buffer flush.
+ (princ "\n")
+ (prin1 ret)
+ (princ "\n"))
+ (error
+ (progn
+ (princ "\n")
+ (prin1 (list 'async-signal err))
+ (princ "\n"))))))
+
+(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 if VALUE is an async.el message packet."
+ (and (listp value)
+ (plist-get value :async-message)))
+
+(defun async-send (process-or-key &rest args)
+ "Send the given message to the asynchronous child or parent Emacs.
+
+To send messages from the parent to a child, PROCESS-OR-KEY is
+the child process object. ARGS is a plist. Example:
+
+ (async-send proc :operation :load-file :file \"this file\")
+
+To send messages from the child to the parent, PROCESS-OR-KEY is
+the first key of the plist, ARGS is a value followed by
+optionally more key-value pairs. Example:
+
+ (async-send :status \"finished\" :file-size 123)"
+ (let ((args (append args '(:async-message t))))
+ (if async-in-child-emacs
+ ;; `princ' because async--insert-sexp already quotes everything.
+ (princ
+ (with-temp-buffer
+ (async--insert-sexp (cons process-or-key args))
+ ;; always make sure that one message package has its own
+ ;; line as there can be any random debug garbage printed
+ ;; above it.
+ (concat "\n" (buffer-string))))
+ (async--transmit-sexp process-or-key (list 'quote args)))))
+
+(defun async-receive ()
+ "Receive message from parent Emacs.
+
+The child process blocks until a message is received.
+
+Message is a plist with one key :async-message set to t always
+automatically added to signify this plist is an async message.
+
+You can use `async-message-p' to test if the payload was a
+message.
+
+Use
+
+ (let ((msg (async-receive))) ...)
+
+to read and process a message."
+ (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 "*")))
+ (buf-err (generate-new-buffer (concat "*" name ":err*")))
+ (prt-for-pwd async-prompt-for-password)
+ (proc (let ((process-connection-type nil))
+ (make-process
+ :name name
+ :buffer buf
+ :stderr buf-err
+ :command (cons program program-args)
+ :noquery async-process-noquery-on-exit))))
+ (set-process-sentinel
+ (get-buffer-process buf-err)
+ (lambda (proc _change)
+ (unless (or async-debug (process-live-p proc))
+ (kill-buffer (process-buffer proc)))))
+ (with-current-buffer buf
+ (set (make-local-variable 'async-callback) finish-func)
+ (set (make-local-variable 'async-read-marker)
+ (set-marker (make-marker) (point-min) buf))
+ (set-marker-insertion-type async-read-marker nil)
+ (set-process-sentinel proc #'async-when-done)
+ ;; Pass the value of `async-prompt-for-password' to the process
+ ;; filter fn through the lexical local var prt-for-pwd (Issue#182).
+ (set-process-filter proc (lambda (proc string)
+ (async-read-from-client
+ proc string prt-for-pwd)))
+ (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.")
+
+(defvar async-library nil
+ "Cache async library path.
+It is useful only when you run multiple async processes in a loop, to
+avoid calling many times `locate-library' which is costly.
+This variable should be let bound around an `async-start' call and not
+used globally. Should be found with `locate-library'.")
+
+(defun async--emacs-program-args (&optional sexp)
+ "Return a list of arguments for invoking the child Emacs."
+ ;; Using `locate-library' ensure we use the right file
+ ;; when the .elc have been deleted, its result can be cached in
+ ;; `async-library' see Issue#193.
+ (let ((args (list async-quiet-switch "-l" (or async-library
+ (locate-library "async")))))
+ (when async-child-init
+ (setq args (append args (list "-l" async-child-init))))
+ (append args (list "-batch" "-f" "async-batch-invoke"
+ (if sexp
+ (with-temp-buffer
+ (async--insert-sexp (list 'quote sexp))
+ (buffer-string))
+ "<none>")))))
+
+;;;###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 you call `async-send' from a child process, the message will
+be also passed to the FINISH-FUNC. You can test RESULT to see if
+it is a message by using `async-message-p'. If nil, it means
+this is the final result. Example of the FINISH-FUNC:
+
+ (lambda (result)
+ (if (async-message-p result)
+ (message \"Received a message from child process: %s\" result)
+ (message \"Async process done, result: %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)
+
+Special case:
+If the output of START-FUNC is a string with properties
+e.g. (buffer-string) RESULT will be transformed in a list where the
+car is the string itself (without props) and the cdr the rest of
+properties, this allows using in FINISH-FUNC the string without
+properties and then apply the properties in cdr to this string (if
+needed).
+Properties handling special objects like markers are returned as
+list to allow restoring them later.
+See <https://github.com/jwiegley/emacs-async/issues/145> for more infos.
+
+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-emacs-unix.
+ (coding-system-for-read 'utf-8-emacs-unix))
+ (setq async--procvar
+ (apply 'async-start-process
+ "emacs" (file-truename
+ (expand-file-name invocation-name
+ invocation-directory))
+ finish-func
+ (async--emacs-program-args (if (not async-send-over-pipe) sexp))))
+
+ (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
--- /dev/null
+;;; dired-async.el --- Asynchronous dired actions -*- lexical-binding: t -*-
+
+;; Copyright (C) 2012-2019 Free Software Foundation, Inc.
+
+;; Authors: John Wiegley <jwiegleyNOSPAMgmail.com>
+;; Thierry Volpiatto <thievolNOSPAMposteo.net>
+
+;; Keywords: dired async network
+;; 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 3 of the License, 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 this program. If not, see <https://www.gnu.org/licenses/>.
+\f
+;;; 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:
+\f
+(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)
+
+(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'."
+ :type 'function)
+
+(defcustom dired-async-log-file "/tmp/dired-async.log"
+ "File use to communicate errors from Child Emacs to host Emacs."
+ :type 'string)
+
+(defcustom dired-async-mode-lighter '(:eval
+ (when (eq major-mode 'dired-mode)
+ " Async"))
+ "Mode line lighter used for `dired-async-mode'."
+ :risky t
+ :type 'sexp)
+
+(defcustom dired-async-skip-fast nil
+ "If non-nil, skip async for fast operations.
+Same device renames and copying and renaming files smaller than
+`dired-async-small-file-max' are considered fast.
+If the total size of all files exceed `dired-async-small-file-max'
+operation is not considered fast."
+ :risky t
+ :type 'boolean)
+
+(defcustom dired-async-small-file-max 5000000
+ "Files smaller than this in bytes are considered fast to copy
+or rename for `dired-async-skip-fast'."
+ :risky t
+ :type 'integer)
+
+(defcustom dired-async-large-file-warning-threshold large-file-warning-threshold
+ "Same as `large-file-warning-threshold' but for dired-async."
+ :type 'integer)
+
+(defface dired-async-message
+ '((t (:foreground "yellow")))
+ "Face used for mode-line message.")
+
+(defface dired-async-failures
+ '((t (:foreground "red")))
+ "Face used for mode-line message.")
+
+(defface dired-async-mode-message
+ '((t (:foreground "Gold")))
+ "Face used for `dired-async--modeline-mode' lighter.")
+
+(define-minor-mode dired-async--modeline-mode
+ "Notify mode-line that an async process run."
+ :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 (&optional propname)
+ (cl-loop for p in (process-list)
+ when (process-get p (or propname 'dired-async-process))
+ 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))))))
+
+(defsubst dired-async--directory-p (attributes)
+ "Return non-nil if ATTRIBUTES is for a directory.
+See `file-attributes'."
+ ;; Can also be a string for symlinks, so check for t explicitly.
+ (eq (file-attribute-type attributes) t))
+
+(defsubst dired-async--same-device-p (f1 f2)
+ "Return non-nil if F1 and F2 have the same device number."
+ ;; file-attribute-device-number may be a cons cell, so use equal for
+ ;; testing (See Emacs bug/58446).
+ (equal (file-attribute-device-number (file-attributes f1))
+ (file-attribute-device-number (file-attributes f2))))
+
+(defun dired-async--small-file-p (file &optional attrs)
+ "Return non-nil if FILE is considered small.
+
+File is considered small if it size is smaller than
+`dired-async-small-file-max'."
+ (let ((a (or attrs (file-attributes file))))
+ ;; Directories are always large since we can't easily figure out
+ ;; their total size.
+ (and (not (dired-async--directory-p a))
+ (< (file-attribute-size a) dired-async-small-file-max))))
+
+(defun dired-async--skip-async-p (file-creator file name-constructor &optional attrs)
+ "Return non-nil if we should skip async for FILE.
+See `dired-create-files' for FILE-CREATOR and NAME-CONSTRUCTOR."
+ ;; Skip async for small files.
+ (or (dired-async--small-file-p file attrs)
+ ;; Also skip async for same device renames.
+ (and (eq file-creator 'dired-rename-file)
+ (let ((new (funcall name-constructor file)))
+ (dired-async--same-device-p file (file-name-directory new))))))
+
+(defun dired-async--smart-create-files (old-func file-creator
+ operation fn-list name-constructor
+ &optional marker-char)
+ "Around advice for `dired-create-files'.
+Uses async like `dired-async-create-files' but skips certain fast
+cases if `dired-async-skip-fast' is non-nil."
+ (let ((total-size 0)
+ async-list quick-list)
+ (if (or (eq file-creator 'backup-file)
+ (null dired-async-skip-fast))
+ (setq async-list fn-list)
+ (dolist (old fn-list)
+ (let ((attrs (file-attributes old)))
+ (if (dired-async--skip-async-p
+ file-creator old name-constructor attrs)
+ (progn
+ (push old quick-list)
+ (setq total-size (+ total-size (nth 7 attrs))))
+ (push old async-list)))))
+ (when (> total-size dired-async-small-file-max)
+ (setq async-list (append quick-list async-list)
+ quick-list nil))
+ (when async-list
+ (dired-async-create-files
+ file-creator operation (nreverse async-list)
+ name-constructor marker-char))
+ (when quick-list
+ (funcall old-func file-creator operation
+ (nreverse quick-list) name-constructor marker-char))))
+
+(defun dired-async--abort-if-file-too-large (size op-type filename)
+ "Warn when FILENAME larger than `dired-async-large-file-warning-threshold'.
+Same as `abort-if-file-too-large' but without user-error."
+ (when (and dired-async-large-file-warning-threshold size
+ (> size dired-async-large-file-warning-threshold))
+ (files--ask-user-about-large-file
+ size op-type filename nil)))
+
+(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 create-dir)
+ (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)))
+ ;; Skip file if it is too large.
+ (if (and (member operation '("Copy" "Rename"))
+ dired-async-large-file-warning-threshold
+ (eq (dired-async--abort-if-file-too-large
+ (file-attribute-size
+ (file-attributes (file-truename from)))
+ (downcase operation) from)
+ 'abort))
+ (push from skipped)
+ (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)))))))
+ (let ((dirp (file-directory-p to))
+ (dest (file-name-directory to)))
+ (when (boundp 'dired-create-destination-dirs)
+ (setq create-dir
+ (cl-case dired-create-destination-dirs
+ (always 'always)
+ (ask (and (null dirp)
+ (null (file-directory-p dest))
+ (y-or-n-p (format "Create directory `%s'? " dest)))
+ 'always))))))
+ ;; Start async process.
+ (when async-fn-list
+ (process-put
+ (async-start `(lambda ()
+ (require 'cl-lib) (require 'dired-aux) (require 'dired-x)
+ ,(async-inject-variables dired-async-env-variables-regexp)
+ (advice-add #'files--ask-user-about-large-file
+ :override (lambda (&rest args) nil))
+ (let ((dired-recursive-copies (quote always))
+ (dired-copy-preserve-time
+ ,dired-copy-preserve-time)
+ (dired-create-destination-dirs ',create-dir)
+ (dired-vc-rename-file ,dired-vc-rename-file)
+ auth-source-save-behavior)
+ (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)
+ 'dired-async-process t)
+ ;; 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)))
+
+;;;###autoload
+(define-minor-mode dired-async-mode
+ "Do dired actions asynchronously."
+ :lighter dired-async-mode-lighter
+ :global t
+ (if dired-async-mode
+ (progn
+ (advice-add 'dired-create-files :around #'dired-async--smart-create-files)
+ (advice-add 'wdired-do-renames :around #'dired-async-wdired-do-renames))
+ (progn
+ (advice-remove 'dired-create-files #'dired-async--smart-create-files)
+ (advice-remove 'wdired-do-renames #'dired-async-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
--- /dev/null
+;;; smtpmail-async.el --- Send e-mail with smtpmail.el asynchronously -*- lexical-binding: t -*-
+
+;; Copyright (C) 2012-2022 Free Software Foundation, Inc.
+
+;; Author: John Wiegley <jwiegleyNOSPAMgmail.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 3 of the License, 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 this program. If not, see <https://www.gnu.org/licenses/>.
+\f
+;;; 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
projects / emacsconfig.git / commitdiff