From ec0c757a61d4c9a6550432e31f88c8d18e6a1e42 Mon Sep 17 00:00:00 2001 From: Andreas Gerler Date: Thu, 23 Nov 2023 19:25:29 +0100 Subject: [PATCH] update async Signed-off-by: Andreas Gerler --- bba.org | 2 +- .../async-autoloads.el | 10 ++ .../async-bytecomp.el | 2 +- .../async-pkg.el | 6 +- .../async.el | 168 +++++++++++++++--- .../dired-async.el | 23 ++- .../smtpmail-async.el | 0 7 files changed, 179 insertions(+), 32 deletions(-) rename elpa/{async-20221103.638 => async-20230528.622}/async-autoloads.el (94%) rename elpa/{async-20221103.638 => async-20230528.622}/async-bytecomp.el (99%) rename elpa/{async-20221103.638 => async-20230528.622}/async-pkg.el (57%) rename elpa/{async-20221103.638 => async-20230528.622}/async.el (72%) rename elpa/{async-20221103.638 => async-20230528.622}/dired-async.el (96%) rename elpa/{async-20221103.638 => async-20230528.622}/smtpmail-async.el (100%) diff --git a/bba.org b/bba.org index d6d65581..1c84f8bb 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-20221103.638") + (add-to-list 'load-path "~/.emacs.d/elpa/async-20230528.622") (require 'async) ) ) diff --git a/elpa/async-20221103.638/async-autoloads.el b/elpa/async-20230528.622/async-autoloads.el similarity index 94% rename from elpa/async-20221103.638/async-autoloads.el rename to elpa/async-20230528.622/async-autoloads.el index 7c6c3d89..8e2db9f5 100644 --- a/elpa/async-20221103.638/async-autoloads.el +++ b/elpa/async-20230528.622/async-autoloads.el @@ -35,6 +35,16 @@ When done, the return value is passed to FINISH-FUNC. Example: (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: diff --git a/elpa/async-20221103.638/async-bytecomp.el b/elpa/async-20230528.622/async-bytecomp.el similarity index 99% rename from elpa/async-20221103.638/async-bytecomp.el rename to elpa/async-20230528.622/async-bytecomp.el index a490cd44..42dbab30 100644 --- a/elpa/async-20221103.638/async-bytecomp.el +++ b/elpa/async-20230528.622/async-bytecomp.el @@ -6,7 +6,7 @@ ;; Thierry Volpiatto ;; Keywords: dired async byte-compile -;; X-URL: https://github.com/jwiegley/dired-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 diff --git a/elpa/async-20221103.638/async-pkg.el b/elpa/async-20230528.622/async-pkg.el similarity index 57% rename from elpa/async-20221103.638/async-pkg.el rename to elpa/async-20230528.622/async-pkg.el index 22260d3a..e6f3baff 100644 --- a/elpa/async-20221103.638/async-pkg.el +++ b/elpa/async-20230528.622/async-pkg.el @@ -1,7 +1,9 @@ -(define-package "async" "20221103.638" "Asynchronous processing in Emacs" +(define-package "async" "20230528.622" "Asynchronous processing in Emacs" '((emacs "24.4")) - :commit "10cedd8ac7173e92a6822317f1782550199d2d6d" :authors + :commit "3ae74c0a4ba223ba373e0cb636c385e08d8838be" :authors '(("John Wiegley" . "jwiegley@gmail.com")) + :maintainers + '(("Thierry Volpiatto" . "thievol@posteo.net")) :maintainer '("Thierry Volpiatto" . "thievol@posteo.net") :keywords diff --git a/elpa/async-20221103.638/async.el b/elpa/async-20230528.622/async.el similarity index 72% rename from elpa/async-20221103.638/async.el rename to elpa/async-20230528.622/async.el index ad91930d..e181773d 100644 --- a/elpa/async-20221103.638/async.el +++ b/elpa/async-20230528.622/async.el @@ -46,11 +46,17 @@ (defvar async-send-over-pipe t) (defvar async-in-child-emacs nil) (defvar async-callback nil) -(defvar async-callback-for-process nil) +(defvar async-callback-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. @@ -171,12 +177,16 @@ It is intended to be used as follows: (prog1 (funcall async-callback proc) (unless async-debug - (kill-buffer (current-buffer)))) + ;; 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 @@ -189,22 +199,70 @@ It is intended to be used as follows: (replace-match "(" t t)) (goto-char (point-max)) (backward-sexp) - (async-handle-result async-callback (read (current-buffer)) - (current-buffer))) + (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) + "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." + (with-current-buffer (process-buffer proc) + (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? + ;; 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-auto)) + 'utf-8-emacs-unix)) ;; Parent expects UTF-8 encoded text. - (coding-system-for-write 'utf-8-auto)) + (coding-system-for-write 'utf-8-emacs-unix)) (if async-debug (message "Received sexp {{{%s}}}" (pp-to-string sexp))) (setq sexp (read sexp)) @@ -221,7 +279,7 @@ It is intended to be used as follows: (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) + (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))) @@ -237,17 +295,27 @@ 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-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 - (prin1 (funcall - (async--receive-sexp (unless async-send-over-pipe - args-left)))) + (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 - (prin1 (list 'async-signal err)))))) + (progn + (princ "\n") + (prin1 (list 'async-signal err)) + (princ "\n")))))) (defun async-ready (future) "Query a FUTURE to see if it is ready. @@ -277,20 +345,51 @@ its FINISH-FUNC is nil." #'identity async-callback-value (current-buffer)))))) (defun async-message-p (value) - "Return non-nil of VALUE is an async.el message packet." + "Return non-nil if VALUE is an async.el message packet." (and (listp value) (plist-get value :async-message))) -(defun async-send (&rest args) - "Send the given messages to the asychronous Emacs PROCESS." +(defun async-send (process-or-key &rest args) + "Send the given message to the asychronous 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 - (if async-callback - (funcall async-callback args)) - (async--transmit-sexp (car args) (list 'quote (cdr args)))))) + ;; `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 () - "Send the given messages to the asychronous Emacs PROCESS." + "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 @@ -302,11 +401,26 @@ 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*"))) (proc (let ((process-connection-type nil)) - (apply #'start-process name buf program program-args)))) + (make-process + :name name + :buffer buf + :stderr buf-err + :command (cons program program-args))))) + (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) + (set-process-filter proc #'async-read-from-client) (unless (string= name "emacs") (set (make-local-variable 'async-callback-for-process) t)) proc))) @@ -348,6 +462,16 @@ When done, the return value is passed to FINISH-FUNC. Example: (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: @@ -392,7 +516,7 @@ returns nil. It can still be useful, however, as an argument to `async-ready' or `async-wait'." (let ((sexp start-func) ;; Subordinate Emacs will send text encoded in UTF-8. - (coding-system-for-read 'utf-8-auto)) + (coding-system-for-read 'utf-8-emacs-unix)) (setq async--procvar (apply 'async-start-process "emacs" (file-truename diff --git a/elpa/async-20221103.638/dired-async.el b/elpa/async-20230528.622/dired-async.el similarity index 96% rename from elpa/async-20221103.638/dired-async.el rename to elpa/async-20230528.622/dired-async.el index 35b0ca10..8294271a 100644 --- a/elpa/async-20221103.638/dired-async.el +++ b/elpa/async-20230528.622/dired-async.el @@ -6,7 +6,7 @@ ;; Thierry Volpiatto ;; Keywords: dired async network -;; X-URL: https://github.com/jwiegley/dired-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 @@ -73,13 +73,13 @@ Should take same args as `message'." Same device renames and copying and renaming files smaller than `dired-async-small-file-max' are considered fast." :risky t - :type 'bool) + :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 'int) + :type 'integer) (defface dired-async-message '((t (:foreground "yellow"))) @@ -251,7 +251,7 @@ 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) + async-quiet-switch create-dir) (let (to) (dolist (from fn-list) (setq to (funcall name-constructor from)) @@ -344,7 +344,17 @@ ESC or `q' to not overwrite any of the remaining files, for destp = (file-exists-p to) do (and bf destp (with-current-buffer bf - (set-visited-file-name to t t)))))))) + (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 @@ -353,7 +363,8 @@ ESC or `q' to not overwrite any of the remaining files, ,(async-inject-variables dired-async-env-variables-regexp) (let ((dired-recursive-copies (quote always)) (dired-copy-preserve-time - ,dired-copy-preserve-time)) + ,dired-copy-preserve-time) + (dired-create-destination-dirs ',create-dir)) (setq overwrite-backup-query nil) ;; Inline `backup-file' as long as it is not ;; available in emacs. diff --git a/elpa/async-20221103.638/smtpmail-async.el b/elpa/async-20230528.622/smtpmail-async.el similarity index 100% rename from elpa/async-20221103.638/smtpmail-async.el rename to elpa/async-20230528.622/smtpmail-async.el -- 2.47.3