From 7c58fb3deb8c73fc02638693212ff20a1616a902 Mon Sep 17 00:00:00 2001 From: Andreas Gerler Date: Sun, 11 Dec 2022 13:07:41 +0100 Subject: [PATCH] update async Signed-off-by: Andreas Gerler --- bba.org | 2 +- .../async-autoloads.el | 45 +++-- .../async-bytecomp.el | 12 +- .../async-pkg.el | 6 +- .../async.el | 76 ++++---- .../dired-async.el | 162 +++++++++++++----- .../smtpmail-async.el | 2 +- 7 files changed, 208 insertions(+), 97 deletions(-) rename elpa/{async-20220104.1222 => async-20221103.638}/async-autoloads.el (79%) rename elpa/{async-20220104.1222 => async-20221103.638}/async-bytecomp.el (95%) rename elpa/{async-20220104.1222 => async-20221103.638}/async-pkg.el (52%) rename elpa/{async-20220104.1222 => async-20221103.638}/async.el (88%) rename elpa/{async-20220104.1222 => async-20221103.638}/dired-async.el (70%) rename elpa/{async-20220104.1222 => async-20221103.638}/smtpmail-async.el (97%) diff --git a/bba.org b/bba.org index a8a2855e..9b583fa3 100644 --- a/bba.org +++ b/bba.org @@ -235,7 +235,7 @@ Keep track of your important stuff! #+BEGIN_SRC emacs-lisp (if (>= emacs-major-version 24) (progn - (add-to-list 'load-path "~/.emacs.d/elpa/async-20220104.1222") + (add-to-list 'load-path "~/.emacs.d/elpa/async-20221103.638") (require 'async) ) ) diff --git a/elpa/async-20220104.1222/async-autoloads.el b/elpa/async-20221103.638/async-autoloads.el similarity index 79% rename from elpa/async-20220104.1222/async-autoloads.el rename to elpa/async-20221103.638/async-autoloads.el index 1519fe8c..7c6c3d89 100644 --- a/elpa/async-20220104.1222/async-autoloads.el +++ b/elpa/async-20221103.638/async-autoloads.el @@ -1,4 +1,4 @@ -;;; async-autoloads.el --- automatically extracted autoloads +;;; async-autoloads.el --- automatically extracted autoloads -*- lexical-binding: t -*- ;; ;;; Code: @@ -80,7 +80,7 @@ returns nil. It can still be useful, however, as an argument to \(fn START-FUNC &optional FINISH-FUNC)" nil nil) -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "async" '("async-"))) +(register-definition-prefixes "async" '("async-")) ;;;*** @@ -109,10 +109,20 @@ Byte compile asynchronously packages installed with package.el. Async compilation of packages can be controlled by `async-bytecomp-allowed-packages'. -If called interactively, enable Async-Bytecomp-Package mode if -ARG is positive, and disable it if ARG is zero or negative. If -called from Lisp, also enable the mode if ARG is omitted or nil, -and toggle it if ARG is `toggle'; disable the mode otherwise. +This is a 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 nil) @@ -123,7 +133,7 @@ Same as `byte-compile-file' but asynchronous. \(fn FILE)" t nil) -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "async-bytecomp" '("async-"))) +(register-definition-prefixes "async-bytecomp" '("async-")) ;;;*** @@ -143,10 +153,19 @@ or call the function `dired-async-mode'.") (autoload 'dired-async-mode "dired-async" "\ Do dired actions asynchronously. -If called interactively, enable Dired-Async mode if ARG is -positive, and disable it if ARG is zero or negative. If called -from Lisp, also enable the mode if ARG is omitted or nil, and -toggle it if ARG is `toggle'; disable the mode otherwise. +This is a 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 nil) @@ -170,7 +189,7 @@ Run ‘dired-do-rename’ asynchronously. \(fn &optional ARG)" t nil) -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "dired-async" '("dired-async-"))) +(register-definition-prefixes "dired-async" '("dired-async-")) ;;;*** @@ -178,7 +197,7 @@ Run ‘dired-do-rename’ asynchronously. ;;;;;; 0)) ;;; Generated autoloads from smtpmail-async.el -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "smtpmail-async" '("async-smtpmail-"))) +(register-definition-prefixes "smtpmail-async" '("async-smtpmail-")) ;;;*** diff --git a/elpa/async-20220104.1222/async-bytecomp.el b/elpa/async-20221103.638/async-bytecomp.el similarity index 95% rename from elpa/async-20220104.1222/async-bytecomp.el rename to elpa/async-20221103.638/async-bytecomp.el index fe397ae3..a490cd44 100644 --- a/elpa/async-20220104.1222/async-bytecomp.el +++ b/elpa/async-20221103.638/async-bytecomp.el @@ -1,9 +1,9 @@ ;;; async-bytecomp.el --- Compile elisp files asynchronously -*- lexical-binding: t -*- -;; Copyright (C) 2014-2019 Free Software Foundation, Inc. +;; Copyright (C) 2014-2022 Free Software Foundation, Inc. ;; Authors: John Wiegley -;; Thierry Volpiatto +;; Thierry Volpiatto ;; Keywords: dired async byte-compile ;; X-URL: https://github.com/jwiegley/dired-async @@ -38,6 +38,7 @@ (require 'cl-lib) (require 'async) +(require 'bytecomp) (declare-function package-desc-name "package.el") (declare-function package-desc-dir "package.el") @@ -56,6 +57,9 @@ all packages are always compiled asynchronously." (defvar async-byte-compile-log-file (concat user-emacs-directory "async-bytecomp.log")) +(defvar async-bytecomp-load-variable-regexp "\\`load-path\\'" + "The variable used by `async-inject-variables' when (re)compiling async.") + ;;;###autoload (defun async-byte-recompile-directory (directory &optional quiet) "Compile all *.el files in DIRECTORY asynchronously. @@ -92,7 +96,7 @@ All *.elc files are systematically deleted before proceeding." (async-start `(lambda () (require 'bytecomp) - ,(async-inject-variables "\\`\\(?:load-path\\'\\|byte-\\)") + ,(async-inject-variables async-bytecomp-load-variable-regexp) (let ((default-directory (file-name-as-directory ,directory)) error-data) (add-to-list 'load-path default-directory) @@ -189,7 +193,7 @@ Same as `byte-compile-file' but asynchronous." (async-start `(lambda () (require 'bytecomp) - ,(async-inject-variables "\\`load-path\\'") + ,(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) diff --git a/elpa/async-20220104.1222/async-pkg.el b/elpa/async-20221103.638/async-pkg.el similarity index 52% rename from elpa/async-20220104.1222/async-pkg.el rename to elpa/async-20221103.638/async-pkg.el index e6d4c862..22260d3a 100644 --- a/elpa/async-20220104.1222/async-pkg.el +++ b/elpa/async-20221103.638/async-pkg.el @@ -1,9 +1,9 @@ -(define-package "async" "20220104.1222" "Asynchronous processing in Emacs" +(define-package "async" "20221103.638" "Asynchronous processing in Emacs" '((emacs "24.4")) - :commit "0d52411d3accc3e11a2c64838703a8ce9755c77c" :authors + :commit "10cedd8ac7173e92a6822317f1782550199d2d6d" :authors '(("John Wiegley" . "jwiegley@gmail.com")) :maintainer - '("John Wiegley" . "jwiegley@gmail.com") + '("Thierry Volpiatto" . "thievol@posteo.net") :keywords '("async") :url "https://github.com/jwiegley/emacs-async") diff --git a/elpa/async-20220104.1222/async.el b/elpa/async-20221103.638/async.el similarity index 88% rename from elpa/async-20220104.1222/async.el rename to elpa/async-20221103.638/async.el index 6df1b6d2..ad91930d 100644 --- a/elpa/async-20220104.1222/async.el +++ b/elpa/async-20221103.638/async.el @@ -1,10 +1,12 @@ ;;; async.el --- Asynchronous processing in Emacs -*- lexical-binding: t -*- -;; Copyright (C) 2012-2019 Free Software Foundation, Inc. +;; Copyright (C) 2012-2022 Free Software Foundation, Inc. ;; Author: John Wiegley +;; Maintainer: Thierry Volpiatto + ;; Created: 18 Jun 2012 -;; Version: 1.9.5 +;; Version: 1.9.7 ;; Package-Requires: ((emacs "24.4")) ;; Keywords: async @@ -34,7 +36,7 @@ (defgroup async nil "Simple asynchronous processing in Emacs" - :group 'emacs) + :group 'lisp) (defcustom async-variables-noprops-function #'async--purecopy "Default function to remove text properties in variables." @@ -49,6 +51,16 @@ (defvar async-callback-value-set nil) (defvar async-current-process nil) (defvar async--procvar nil) +(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. @@ -204,7 +216,9 @@ It is intended to be used as follows: (let (print-level print-length (print-escape-nonascii t) - (print-circle 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-auto) @@ -223,19 +237,17 @@ It is intended to be used as follows: "Called from the child Emacs process' command line." ;; Make sure 'message' and 'prin1' encode stuff in UTF-8, as parent ;; process expects. - (let ((coding-system-for-write 'utf-8-auto)) + (let ((coding-system-for-write 'utf-8-auto) + (args-left command-line-args-left)) (setq async-in-child-emacs t - debug-on-error async-debug) - (if debug-on-error + debug-on-error async-debug + command-line-args-left nil) + (condition-case-unless-debug err (prin1 (funcall (async--receive-sexp (unless async-send-over-pipe - command-line-args-left)))) - (condition-case err - (prin1 (funcall - (async--receive-sexp (unless async-send-over-pipe - command-line-args-left)))) - (error - (prin1 (list 'async-signal err))))))) + args-left)))) + (error + (prin1 (list 'async-signal err)))))) (defun async-ready (future) "Query a FUTURE to see if it is ready. @@ -305,6 +317,20 @@ 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.") +(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. + (let ((args (list async-quiet-switch "-l" (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. @@ -368,21 +394,13 @@ returns nil. It can still be useful, however, as an argument to ;; Subordinate Emacs will send text encoded in UTF-8. (coding-system-for-read 'utf-8-auto)) (setq async--procvar - (async-start-process - "emacs" (file-truename - (expand-file-name invocation-name - invocation-directory)) - finish-func - async-quiet-switch "-l" - ;; Using `locate-library' ensure we use the right file - ;; when the .elc have been deleted. - (locate-library "async") - "-batch" "-f" "async-batch-invoke" - (if async-send-over-pipe - "" - (with-temp-buffer - (async--insert-sexp (list 'quote sexp)) - (buffer-string))))) + (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)) diff --git a/elpa/async-20220104.1222/dired-async.el b/elpa/async-20221103.638/dired-async.el similarity index 70% rename from elpa/async-20220104.1222/dired-async.el rename to elpa/async-20221103.638/dired-async.el index 4b6f7554..35b0ca10 100644 --- a/elpa/async-20220104.1222/dired-async.el +++ b/elpa/async-20221103.638/dired-async.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2012-2019 Free Software Foundation, Inc. ;; Authors: John Wiegley -;; Thierry Volpiatto +;; Thierry Volpiatto ;; Keywords: dired async network ;; X-URL: https://github.com/jwiegley/dired-async @@ -68,6 +68,19 @@ Should take same args as `message'." :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." + :risky t + :type 'bool) + +(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 'int) + (defface dired-async-message '((t (:foreground "yellow"))) "Face used for mode-line message.") @@ -104,8 +117,7 @@ Should take same args as `message'." (defun dired-async-processes () (cl-loop for p in (process-list) - when (cl-loop for c in (process-command p) thereis - (string= "async-batch-invoke" c)) + when (process-get p 'dired-async-process) collect p)) (defun dired-async-kill-process () @@ -174,6 +186,62 @@ Should take same args as `message'." (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) + "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 (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) + "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) + ;; 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 (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) + (if (dired-async--skip-async-p file-creator old name-constructor) + (push old quick-list) + (push old async-list)))) + (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)))) + (defvar overwrite-query) (defun dired-async-create-files (file-creator operation fn-list name-constructor &optional _marker-char) @@ -279,47 +347,49 @@ ESC or `q' to not overwrite any of the remaining files, (set-visited-file-name to t t)))))))) ;; Start async process. (when async-fn-list - (async-start `(lambda () - (require 'cl-lib) (require 'dired-aux) (require 'dired-x) - ,(async-inject-variables dired-async-env-variables-regexp) - (let ((dired-recursive-copies (quote always)) - (dired-copy-preserve-time - ,dired-copy-preserve-time)) - (setq overwrite-backup-query nil) - ;; Inline `backup-file' as long as it is not - ;; available in emacs. - (defalias 'backup-file - ;; Same feature as "cp -f --backup=numbered from to" - ;; Symlinks are copied as file from source unlike - ;; `dired-copy-file' which is same as cp -d. - ;; Directories are omitted. - (lambda (from to ok) - (cond ((file-directory-p from) (ignore)) - (t (let ((count 0)) - (while (let ((attrs (file-attributes to))) - (and attrs (null (nth 0 attrs)))) - (cl-incf count) - (setq to (concat (file-name-sans-versions to) - (format ".~%s~" count))))) - (condition-case err - (copy-file from to ok dired-copy-preserve-time) - (file-date-error - (dired-log "Can't set date on %s:\n%s\n" from err))))))) - ;; Now run the FILE-CREATOR function on files. - (cl-loop with fn = (quote ,file-creator) - for (from . dest) in (quote ,async-fn-list) - do (condition-case err - (funcall fn from dest t) - (file-error - (dired-log "%s: %s\n" (car err) (cdr err)) - nil))) - (when (get-buffer dired-log-buffer) - (dired-log t) - (with-current-buffer dired-log-buffer - (write-region (point-min) (point-max) - ,dired-async-log-file)))) - ,(dired-async-maybe-kill-ftp)) - callback) + (process-put + (async-start `(lambda () + (require 'cl-lib) (require 'dired-aux) (require 'dired-x) + ,(async-inject-variables dired-async-env-variables-regexp) + (let ((dired-recursive-copies (quote always)) + (dired-copy-preserve-time + ,dired-copy-preserve-time)) + (setq overwrite-backup-query nil) + ;; Inline `backup-file' as long as it is not + ;; available in emacs. + (defalias 'backup-file + ;; Same feature as "cp -f --backup=numbered from to" + ;; Symlinks are copied as file from source unlike + ;; `dired-copy-file' which is same as cp -d. + ;; Directories are omitted. + (lambda (from to ok) + (cond ((file-directory-p from) (ignore)) + (t (let ((count 0)) + (while (let ((attrs (file-attributes to))) + (and attrs (null (nth 0 attrs)))) + (cl-incf count) + (setq to (concat (file-name-sans-versions to) + (format ".~%s~" count))))) + (condition-case err + (copy-file from to ok dired-copy-preserve-time) + (file-date-error + (dired-log "Can't set date on %s:\n%s\n" from err))))))) + ;; Now run the FILE-CREATOR function on files. + (cl-loop with fn = (quote ,file-creator) + for (from . dest) in (quote ,async-fn-list) + do (condition-case err + (funcall fn from dest t) + (file-error + (dired-log "%s: %s\n" (car err) (cdr err)) + nil))) + (when (get-buffer dired-log-buffer) + (dired-log t) + (with-current-buffer dired-log-buffer + (write-region (point-min) (point-max) + ,dired-async-log-file)))) + ,(dired-async-maybe-kill-ftp)) + callback) + 'dired-async-process t) ;; Run mode-line notifications while process running. (dired-async--modeline-mode 1) (message "%s proceeding asynchronously..." operation)))) @@ -340,10 +410,10 @@ ESC or `q' to not overwrite any of the remaining files, :global t (if dired-async-mode (progn - (advice-add 'dired-create-files :override #'dired-async-create-files) + (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-create-files) + (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) diff --git a/elpa/async-20220104.1222/smtpmail-async.el b/elpa/async-20221103.638/smtpmail-async.el similarity index 97% rename from elpa/async-20220104.1222/smtpmail-async.el rename to elpa/async-20221103.638/smtpmail-async.el index 5a1c3205..404b6e0c 100644 --- a/elpa/async-20220104.1222/smtpmail-async.el +++ b/elpa/async-20221103.638/smtpmail-async.el @@ -1,6 +1,6 @@ ;;; smtpmail-async.el --- Send e-mail with smtpmail.el asynchronously -*- lexical-binding: t -*- -;; Copyright (C) 2012-2016 Free Software Foundation, Inc. +;; Copyright (C) 2012-2022 Free Software Foundation, Inc. ;; Author: John Wiegley ;; Created: 18 Jun 2012 -- 2.47.3