From: Andreas Gerler Date: Sun, 26 Apr 2026 16:35:11 +0000 (+0200) Subject: update async X-Git-Url: http://git.bundesbrandschatzamt.de/?a=commitdiff_plain;h=d7eacccf74240fe9d37445be1f29c2dbb3af24d1;p=emacsconfig.git update async --- diff --git a/elpa/async-20251005.634/async-autoloads.el b/elpa/async-20251005.634/async-autoloads.el deleted file mode 100644 index 5dbb2341..00000000 --- a/elpa/async-20251005.634/async-autoloads.el +++ /dev/null @@ -1,212 +0,0 @@ -;;; 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))) - - - -;;; 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 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-")) - - -;;; 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-")) - - -;;; Generated autoloads from async-package.el - -(register-definition-prefixes "async-package" '("async-p")) - - -;;; 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-")) - - -;;; Generated autoloads from smtpmail-async.el - -(register-definition-prefixes "smtpmail-async" '("async-smtpmail-")) - -;;; 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 diff --git a/elpa/async-20251005.634/async-bytecomp.el b/elpa/async-20251005.634/async-bytecomp.el deleted file mode 100644 index a5d63709..00000000 --- a/elpa/async-20251005.634/async-bytecomp.el +++ /dev/null @@ -1,241 +0,0 @@ -;;; async-bytecomp.el --- Compile elisp files asynchronously -*- lexical-binding: t -*- - -;; Copyright (C) 2014-2022 Free Software Foundation, Inc. - -;; Authors: John Wiegley -;; Thierry Volpiatto - -;; 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 . - -;;; 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 diff --git a/elpa/async-20251005.634/async-package.el b/elpa/async-20251005.634/async-package.el deleted file mode 100644 index 208d5a0f..00000000 --- a/elpa/async-20251005.634/async-package.el +++ /dev/null @@ -1,145 +0,0 @@ -;;; async-package.el --- Fetch packages asynchronously -*- lexical-binding: t -*- - -;; Copyright (C) 2014-2022 Free Software Foundation, Inc. - -;; Author: Thierry Volpiatto - -;; 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 . - -;;; 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 diff --git a/elpa/async-20251005.634/async-pkg.el b/elpa/async-20251005.634/async-pkg.el deleted file mode 100644 index ebe53e94..00000000 --- a/elpa/async-20251005.634/async-pkg.el +++ /dev/null @@ -1,10 +0,0 @@ -;; -*- 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" . "jwiegley@gmail.com")) - :maintainers '(("Thierry Volpiatto" . "thievol@posteo.net"))) diff --git a/elpa/async-20251005.634/async.el b/elpa/async-20251005.634/async.el deleted file mode 100644 index 4c2b01f2..00000000 --- a/elpa/async-20251005.634/async.el +++ /dev/null @@ -1,619 +0,0 @@ -;;; async.el --- Asynchronous processing in Emacs -*- lexical-binding: t -*- - -;; Copyright (C) 2012-2022 Free Software Foundation, Inc. - -;; Author: John Wiegley -;; Maintainer: Thierry Volpiatto - -;; 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 . - -;;; Commentary: - -;; Adds the ability to call asynchronous functions and process with ease. See -;; the documentation for `async-start' and `async-start-process'. - -;;; Code: - -(eval-when-compile (require 'cl-lib)) - -(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)) - ""))))) - -;;;###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 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 diff --git a/elpa/async-20251005.634/dired-async.el b/elpa/async-20251005.634/dired-async.el deleted file mode 100644 index b044bd12..00000000 --- a/elpa/async-20251005.634/dired-async.el +++ /dev/null @@ -1,501 +0,0 @@ -;;; dired-async.el --- Asynchronous dired actions -*- lexical-binding: t -*- - -;; Copyright (C) 2012-2019 Free Software Foundation, Inc. - -;; Authors: John Wiegley -;; Thierry Volpiatto - -;; 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 . - -;;; Commentary: - -;; This file provide a redefinition of `dired-create-file' function, -;; performs copies, moves and all what is handled by `dired-create-file' -;; in the background using a slave Emacs process, -;; by means of the async.el module. -;; To use it, put this in your .emacs: - -;; (dired-async-mode 1) - -;; This will enable async copy/rename etc... -;; in dired and helm. - -;;; Code: - -(require 'cl-lib) -(require 'dired-aux) -(require 'async) - -(eval-when-compile - (defvar async-callback)) - -(defgroup dired-async nil - "Copy rename files asynchronously from dired." - :group 'dired) - -(defcustom dired-async-env-variables-regexp - "\\`\\(tramp-\\(default\\|connection\\|remote\\)\\|ange-ftp\\)-.*" - "Variables matching this regexp will be loaded on Child Emacs." - :type 'regexp) - -(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 diff --git a/elpa/async-20251005.634/smtpmail-async.el b/elpa/async-20251005.634/smtpmail-async.el deleted file mode 100644 index 404b6e0c..00000000 --- a/elpa/async-20251005.634/smtpmail-async.el +++ /dev/null @@ -1,71 +0,0 @@ -;;; smtpmail-async.el --- Send e-mail with smtpmail.el asynchronously -*- lexical-binding: t -*- - -;; Copyright (C) 2012-2022 Free Software Foundation, Inc. - -;; Author: John Wiegley -;; 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 . - -;;; 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 diff --git a/elpa/async-20260318.1803/README-elpa b/elpa/async-20260318.1803/README-elpa new file mode 100644 index 00000000..ac103499 --- /dev/null +++ b/elpa/async-20260318.1803/README-elpa @@ -0,0 +1,2 @@ +Adds the ability to call asynchronous functions and process with ease. See +the documentation for `async-start' and `async-start-process'. diff --git a/elpa/async-20260318.1803/async-autoloads.el b/elpa/async-20260318.1803/async-autoloads.el new file mode 100644 index 00000000..dd83dabd --- /dev/null +++ b/elpa/async-20260318.1803/async-autoloads.el @@ -0,0 +1,212 @@ +;;; 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))) + + + +;;; 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 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-")) + + +;;; 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-")) + + +;;; Generated autoloads from async-package.el + +(register-definition-prefixes "async-package" '("async-p")) + + +;;; 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-")) + + +;;; Generated autoloads from smtpmail-async.el + +(register-definition-prefixes "smtpmail-async" '("async-smtpmail-")) + +;;; 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 diff --git a/elpa/async-20260318.1803/async-bytecomp.el b/elpa/async-20260318.1803/async-bytecomp.el new file mode 100644 index 00000000..12013bd0 --- /dev/null +++ b/elpa/async-20260318.1803/async-bytecomp.el @@ -0,0 +1,241 @@ +;;; async-bytecomp.el --- Compile elisp files asynchronously -*- lexical-binding: t -*- + +;; Copyright (C) 2014-2022 Free Software Foundation, Inc. + +;; Authors: John Wiegley +;; Thierry Volpiatto + +;; 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 . + +;;; 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 diff --git a/elpa/async-20260318.1803/async-package.el b/elpa/async-20260318.1803/async-package.el new file mode 100644 index 00000000..4d8d270c --- /dev/null +++ b/elpa/async-20260318.1803/async-package.el @@ -0,0 +1,145 @@ +;;; async-package.el --- Fetch packages asynchronously -*- lexical-binding: t -*- + +;; Copyright (C) 2014-2022 Free Software Foundation, Inc. + +;; Author: Thierry Volpiatto + +;; 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 . + +;;; 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 diff --git a/elpa/async-20260318.1803/async-pkg.el b/elpa/async-20260318.1803/async-pkg.el new file mode 100644 index 00000000..3fb33080 --- /dev/null +++ b/elpa/async-20260318.1803/async-pkg.el @@ -0,0 +1,10 @@ +;; -*- 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" . "jwiegley@gmail.com")) + :maintainers '(("Thierry Volpiatto" . "thievol@posteo.net"))) diff --git a/elpa/async-20260318.1803/async.el b/elpa/async-20260318.1803/async.el new file mode 100644 index 00000000..8bfb3c90 --- /dev/null +++ b/elpa/async-20260318.1803/async.el @@ -0,0 +1,617 @@ +;;; async.el --- Asynchronous processing in Emacs -*- lexical-binding: t -*- + +;; Copyright (C) 2012-2022 Free Software Foundation, Inc. + +;; Author: John Wiegley +;; Maintainer: Thierry Volpiatto + +;; 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 . + +;;; Commentary: + +;; Adds the ability to call asynchronous functions and process with ease. See +;; the documentation for `async-start' and `async-start-process'. + +;;; Code: + +(eval-when-compile (require 'cl-lib)) + +(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)) + ""))))) + +;;;###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 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 diff --git a/elpa/async-20260318.1803/dired-async.el b/elpa/async-20260318.1803/dired-async.el new file mode 100644 index 00000000..6f3fbaaf --- /dev/null +++ b/elpa/async-20260318.1803/dired-async.el @@ -0,0 +1,501 @@ +;;; dired-async.el --- Asynchronous dired actions -*- lexical-binding: t -*- + +;; Copyright (C) 2012-2019 Free Software Foundation, Inc. + +;; Authors: John Wiegley +;; Thierry Volpiatto + +;; 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 . + +;;; Commentary: + +;; This file provide a redefinition of `dired-create-file' function, +;; performs copies, moves and all what is handled by `dired-create-file' +;; in the background using a slave Emacs process, +;; by means of the async.el module. +;; To use it, put this in your .emacs: + +;; (dired-async-mode 1) + +;; This will enable async copy/rename etc... +;; in dired and helm. + +;;; Code: + +(require 'cl-lib) +(require 'dired-aux) +(require 'async) + +(eval-when-compile + (defvar async-callback)) + +(defgroup dired-async nil + "Copy rename files asynchronously from dired." + :group 'dired) + +(defcustom dired-async-env-variables-regexp + "\\`\\(tramp-\\(default\\|connection\\|remote\\)\\|ange-ftp\\)-.*" + "Variables matching this regexp will be loaded on Child Emacs." + :type 'regexp) + +(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 diff --git a/elpa/async-20260318.1803/smtpmail-async.el b/elpa/async-20260318.1803/smtpmail-async.el new file mode 100644 index 00000000..404b6e0c --- /dev/null +++ b/elpa/async-20260318.1803/smtpmail-async.el @@ -0,0 +1,71 @@ +;;; smtpmail-async.el --- Send e-mail with smtpmail.el asynchronously -*- lexical-binding: t -*- + +;; Copyright (C) 2012-2022 Free Software Foundation, Inc. + +;; Author: John Wiegley +;; 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 . + +;;; 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