bug#53877: 29.0.50; [PATCH] async Gnus/nnml

bug#53877: 29.0.50; [PATCH] async Gnus/nnml

[Manuel Giraud]

[-- Attachment #1: Type: text/plain, Size: 278 bytes --]


Hi,

I'm trying to have an asynchronous Gnus nnml backend. In the process, I
found some things that I'd like to have first in nnmail.el and
mail-sources.el (see patches).

There is nothing asynchronous so far so Gnus behaviour shouldn't have
changed that much.

Best regards,


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-just-use-temp-buffer-for-nnmail-article-buffer.patch --]
[-- Type: text/x-patch, Size: 1541 bytes --]

From 21a6dfc1648cf5ec3a773d7624806a24c9b358a4 Mon Sep 17 00:00:00 2001
From: Manuel Giraud <manuel@ledu-giraud.fr>
Date: Tue, 8 Feb 2022 13:19:44 +0100
Subject: [PATCH 1/4] just use temp-buffer for `nnmail-article-buffer'.

It is used in one and only place as a temporary buffer.
---
 lisp/gnus/nnmail.el | 9 ++-------
 1 file changed, 2 insertions(+), 7 deletions(-)

diff --git a/lisp/gnus/nnmail.el b/lisp/gnus/nnmail.el
index c71627f83a..af9c439280 100644
--- a/lisp/gnus/nnmail.el
+++ b/lisp/gnus/nnmail.el
@@ -571,9 +571,6 @@ nnmail-debug-splitting
 
 ;;; Internal variables.
 
-(defvar nnmail-article-buffer " *nnmail incoming*"
-  "The buffer used for splitting incoming mails.")
-
 (defvar nnmail-split-history nil
   "List of group/article elements that say where the previous split put messages.")
 
@@ -1043,8 +1040,7 @@ nnmail-split-incoming
 				  (list (list group ""))
 				nnmail-split-methods)))
     ;; Insert the incoming file.
-    (with-current-buffer (gnus-get-buffer-create nnmail-article-buffer)
-      (erase-buffer)
+    (with-temp-buffer
       (if (bufferp incoming)
 	  (insert-buffer-substring incoming)
 	;; The following coding system is set to
@@ -1072,8 +1068,7 @@ nnmail-split-incoming
 		  (t
 		   (nnmail-process-unix-mail-format func artnum-func))))
 	(when exit-func
-	  (funcall exit-func))
-	(kill-buffer (current-buffer))))))
+	  (funcall exit-func))))))
 
 (defun nnmail-article-group (func &optional trace junk-func)
   "Look at the headers and return an alist of groups that match.
-- 
2.35.1


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0002-uniquify-mail-source-crash-box-on-each-different-mai.patch --]
[-- Type: text/x-patch, Size: 20306 bytes --]

From 798555baaa3f4afca663a6ac29bc42bf313144bc Mon Sep 17 00:00:00 2001
From: Manuel Giraud <manuel@ledu-giraud.fr>
Date: Wed, 2 Feb 2022 10:50:57 +0100
Subject: [PATCH 2/4] uniquify mail-source-crash-box on each different
 mail-source fetcher.

---
 lisp/gnus/mail-source.el | 386 ++++++++++++++++++++-------------------
 1 file changed, 202 insertions(+), 184 deletions(-)

diff --git a/lisp/gnus/mail-source.el b/lisp/gnus/mail-source.el
index 5d0c0e2654..4498ea13f6 100644
--- a/lisp/gnus/mail-source.el
+++ b/lisp/gnus/mail-source.el
@@ -238,10 +238,12 @@ mail-source-flash
   "If non-nil, flash periodically when mail is available."
   :type 'boolean)
 
-(defcustom mail-source-crash-box "~/.emacs-mail-crash-box"
-  "File where mail will be stored while processing it."
+(defcustom mail-source-crash-box-prefix "~/.emacs-mail-crash-box-"
+  "Prefix of files where mail will be stored while processing it."
   :type 'file)
 
+(make-obsolete-variable 'mail-source-crash-box 'mail-source-crash-box-prefix "29.1")
+
 (defcustom mail-source-directory message-directory
   "Directory where incoming mail source files (if any) will be stored."
   :type 'directory)
@@ -518,6 +520,18 @@ mail-source-value
 
 (autoload 'nnheader-message "nnheader")
 
+(defun mail-source-fetcher (source)
+  (cadr (assq (car source) mail-source-fetcher-alist)))
+
+(defun mail-source-crash-box ()
+  (make-temp-name mail-source-crash-box-prefix))
+
+(defun mail-source-existing-crash-boxes ()
+  (let ((directory (file-name-directory mail-source-crash-box-prefix))
+        (partial (file-name-nondirectory mail-source-crash-box-prefix)))
+    (mapcar #'(lambda (name) (file-name-concat directory name))
+            (file-name-all-completions partial directory))))
+
 (defun mail-source-fetch (source callback &optional method)
   "Fetch mail from SOURCE and call CALLBACK zero or more times.
 CALLBACK will be called with the name of the file where (some of)
@@ -536,21 +550,20 @@ mail-source-fetch
 				  (format "%s: " method)
 				"")
 			      (car source)))
-	  (let ((function (cadr (assq (car source) mail-source-fetcher-alist)))
+	  (let ((fetcher (mail-source-fetcher source))
 		(found 0))
-	    (unless function
+	    (unless fetcher
 	      (error "%S is an invalid mail source specification" source))
-	    ;; If there's anything in the crash box, we do it first.
-	    (when (file-exists-p mail-source-crash-box)
-	      (message "Processing mail from %s..." mail-source-crash-box)
-	      (setq found (mail-source-callback
-			   callback mail-source-crash-box))
-	      (mail-source-delete-crash-box))
+	    ;; If there's anything in some crash boxes, we do it first.
+            (dolist (box (mail-source-existing-crash-boxes))
+	      (message "Processing mail from %s..." box)
+	      (setq found (mail-source-callback callback box box))
+	      (mail-source-delete-crash-box box))
 	    (+ found
 	       (if (or debug-on-quit debug-on-error)
-		   (funcall function source callback)
+		   (funcall fetcher source callback)
 		 (condition-case err
-		     (funcall function source callback)
+		     (funcall fetcher source callback)
 		   (error
                     (gnus-error
                      5
@@ -596,24 +609,24 @@ mail-source-delete-old-incoming
 		     t))
 	  (delete-file ffile))))))
 
-(defun mail-source-callback (callback info)
+(defun mail-source-callback (callback info crash-box)
   "Call CALLBACK on the mail file.  Pass INFO on to CALLBACK."
-  (if (or (not (file-exists-p mail-source-crash-box))
+  (if (or (not (file-exists-p crash-box))
 	  (zerop (file-attribute-size
-		  (file-attributes mail-source-crash-box))))
+		  (file-attributes crash-box))))
       (progn
-	(when (file-exists-p mail-source-crash-box)
-	  (delete-file mail-source-crash-box))
+	(when (file-exists-p crash-box)
+	  (delete-file crash-box))
 	0)
-    (funcall callback mail-source-crash-box info)))
+    (funcall callback crash-box info)))
 
 (defvar mail-source-incoming-last-checked-time nil)
 
-(defun mail-source-delete-crash-box ()
-  (when (file-exists-p mail-source-crash-box)
+(defun mail-source-delete-crash-box (crash-box)
+  (when (file-exists-p crash-box)
     ;; Delete or move the incoming mail out of the way.
     (if (eq mail-source-delete-incoming t)
-	(delete-file mail-source-crash-box)
+	(delete-file crash-box)
       (let ((incoming
 	     (make-temp-file
 	      (expand-file-name
@@ -621,7 +634,7 @@ mail-source-delete-crash-box
 	       mail-source-directory))))
 	(unless (file-exists-p (file-name-directory incoming))
 	  (make-directory (file-name-directory incoming) t))
-	(rename-file mail-source-crash-box incoming t)
+	(rename-file crash-box incoming t)
 	;; remove old incoming files?
 	(when (natnump mail-source-delete-incoming)
 	  ;; Don't check for old incoming files more than once per day to
@@ -750,17 +763,18 @@ mail-source-call-script
 (defun mail-source-fetch-file (source callback)
   "Fetcher for single-file sources."
   (mail-source-bind (file source)
-    (mail-source-run-script
-     prescript `((?t . ,mail-source-crash-box))
-     prescript-delay)
-    (let ((mail-source-string (format "file:%s" path)))
-      (if (mail-source-movemail path mail-source-crash-box)
-	  (prog1
-	      (mail-source-callback callback path)
-	    (mail-source-run-script
-             postscript `((?t . ,mail-source-crash-box)))
-	    (mail-source-delete-crash-box))
-	0))))
+    (let ((crash-box (mail-source-crash-box)))
+      (mail-source-run-script
+       prescript `((?t . ,crash-box))
+       prescript-delay)
+      (let ((mail-source-string (format "file:%s" path)))
+        (if (mail-source-movemail path crash-box)
+	    (prog1
+	        (mail-source-callback callback path crash-box)
+	      (mail-source-run-script
+               postscript `((?t . ,crash-box)))
+	      (mail-source-delete-crash-box crash-box))
+	  0)))))
 
 (defun mail-source-fetch-directory (source callback)
   "Fetcher for directory sources."
@@ -768,92 +782,94 @@ mail-source-fetch-directory
     (mail-source-run-script
      prescript `((?t . ,path)) prescript-delay)
     (let ((found 0)
-	  (mail-source-string (format "directory:%s" path)))
+	  (mail-source-string (format "directory:%s" path))
+          (crash-box (mail-source-crash-box)))
       (dolist (file (directory-files
 		     path t (concat (regexp-quote suffix) "$")))
 	(when (and (file-regular-p file)
 		   (funcall predicate file)
-		   (mail-source-movemail file mail-source-crash-box))
-	  (cl-incf found (mail-source-callback callback file))
+		   (mail-source-movemail file crash-box))
+	  (cl-incf found (mail-source-callback callback file crash-box))
           (mail-source-run-script postscript `((?t . ,path)))
-	  (mail-source-delete-crash-box)))
+	  (mail-source-delete-crash-box crash-box)))
       found)))
 
 (defun mail-source-fetch-pop (source callback)
   "Fetcher for single-file sources."
   (mail-source-bind (pop source)
-    ;; fixme: deal with stream type in format specs
-    (mail-source-run-script
-     prescript
-     `((?p . ,password) (?t . ,mail-source-crash-box)
-       (?s . ,server) (?P . ,port) (?u . ,user))
-     prescript-delay)
-    (let ((from (format "%s:%s:%s" server user port))
-	  (mail-source-string (format "pop:%s@%s" user server))
-	  (process-environment (if server
-				   (cons (concat "MAILHOST=" server)
-					 process-environment)
-				 process-environment))
-	  result)
-      (when (eq authentication 'password)
-	(setq password
-	      (or password
-		  (cdr (assoc from mail-source-password-cache))
-		  (read-passwd
-		   (format "Password for %s at %s: " user server)))))
-      (setq result
-	    (cond
-	     (program
-	      (mail-source-fetch-with-program
-	       (format-spec
-		program
-                `((?p . ,password) (?t . ,mail-source-crash-box)
-                  (?s . ,server) (?P . ,port) (?u . ,user)))))
-	     (function
-	      (funcall function mail-source-crash-box))
-	     ;; The default is to use pop3.el.
-	     (t
-	      (require 'pop3)
-	      (dlet ((pop3-password password)
-		     (pop3-maildrop user)
-		     (pop3-mailhost server)
-		     (pop3-port port)
-		     (pop3-authentication-scheme
-		      (if (eq authentication 'apop) 'apop 'pass))
-		     (pop3-stream-type stream)
-		     (pop3-leave-mail-on-server leave))
-		(if (or debug-on-quit debug-on-error)
-		    (save-excursion (pop3-movemail mail-source-crash-box))
-		  (condition-case err
-		      (save-excursion (pop3-movemail mail-source-crash-box))
-		    (error
-		     ;; We nix out the password in case the error
-		     ;; was because of a wrong password being given.
-		     (setq mail-source-password-cache
-			   (delq (assoc from mail-source-password-cache)
-				 mail-source-password-cache))
-		     (signal (car err) (cdr err)))))))))
-      (if result
-	  (progn
-	    (when (eq authentication 'password)
-	      (unless (assoc from mail-source-password-cache)
-		(push (cons from password) mail-source-password-cache)))
-	    (prog1
-		(mail-source-callback callback server)
-	      ;; Update display-time's mail flag, if relevant.
-	      (if (equal source mail-source-primary-source)
-		  (setq mail-source-new-mail-available nil))
-	      (mail-source-run-script
-	       postscript
-               `((?p . ,password) (?t . ,mail-source-crash-box)
-                 (?s . ,server) (?P . ,port) (?u . ,user)))
-	      (mail-source-delete-crash-box)))
-	;; We nix out the password in case the error
-	;; was because of a wrong password being given.
-	(setq mail-source-password-cache
-	      (delq (assoc from mail-source-password-cache)
-		    mail-source-password-cache))
-	0))))
+    (let ((crash-box (mail-source-crash-box)))
+      ;; fixme: deal with stream type in format specs
+      (mail-source-run-script
+       prescript
+       `((?p . ,password) (?t . ,crash-box)
+         (?s . ,server) (?P . ,port) (?u . ,user))
+       prescript-delay)
+      (let ((from (format "%s:%s:%s" server user port))
+	    (mail-source-string (format "pop:%s@%s" user server))
+	    (process-environment (if server
+				     (cons (concat "MAILHOST=" server)
+					   process-environment)
+				   process-environment))
+	    result)
+        (when (eq authentication 'password)
+	  (setq password
+	        (or password
+		    (cdr (assoc from mail-source-password-cache))
+		    (read-passwd
+		     (format "Password for %s at %s: " user server)))))
+        (setq result
+	      (cond
+	       (program
+	        (mail-source-fetch-with-program
+	         (format-spec
+		  program
+                  `((?p . ,password) (?t . ,crash-box)
+                    (?s . ,server) (?P . ,port) (?u . ,user)))))
+	       (function
+	        (funcall function crash-box))
+	       ;; The default is to use pop3.el.
+	       (t
+	        (require 'pop3)
+	        (dlet ((pop3-password password)
+		       (pop3-maildrop user)
+		       (pop3-mailhost server)
+		       (pop3-port port)
+		       (pop3-authentication-scheme
+		        (if (eq authentication 'apop) 'apop 'pass))
+		       (pop3-stream-type stream)
+		       (pop3-leave-mail-on-server leave))
+		  (if (or debug-on-quit debug-on-error)
+		      (save-excursion (pop3-movemail crash-box))
+		    (condition-case err
+		        (save-excursion (pop3-movemail crash-box))
+		      (error
+		       ;; We nix out the password in case the error
+		       ;; was because of a wrong password being given.
+		       (setq mail-source-password-cache
+			     (delq (assoc from mail-source-password-cache)
+				   mail-source-password-cache))
+		       (signal (car err) (cdr err)))))))))
+        (if result
+	    (progn
+	      (when (eq authentication 'password)
+	        (unless (assoc from mail-source-password-cache)
+		  (push (cons from password) mail-source-password-cache)))
+	      (prog1
+		  (mail-source-callback callback server crash-box)
+	        ;; Update display-time's mail flag, if relevant.
+	        (if (equal source mail-source-primary-source)
+		    (setq mail-source-new-mail-available nil))
+	        (mail-source-run-script
+	         postscript
+                 `((?p . ,password) (?t . ,crash-box)
+                   (?s . ,server) (?P . ,port) (?u . ,user)))
+	        (mail-source-delete-crash-box crash-box)))
+	  ;; We nix out the password in case the error
+	  ;; was because of a wrong password being given.
+	  (setq mail-source-password-cache
+	        (delq (assoc from mail-source-password-cache)
+		      mail-source-password-cache))
+	  0)))))
 
 (defun mail-source-check-pop (source)
   "Check whether there is new mail."
@@ -1001,6 +1017,7 @@ mail-source-fetch-maildir
   "Fetcher for maildir sources."
   (mail-source-bind (maildir source)
     (let ((found 0)
+          (crash-box (mail-source-crash-box))
 	  mail-source-string)
       (unless (string-match "/$" path)
 	(setq path (concat path "/")))
@@ -1011,12 +1028,12 @@ mail-source-fetch-maildir
 	    (when (and (not (file-directory-p file))
 		       (not (if function
 				;; `function' should return nil if successful.
-				(funcall function file mail-source-crash-box)
+				(funcall function file crash-box)
 			      (let ((coding-system-for-write
 				     mm-text-coding-system)
 				    (coding-system-for-read
 				     mm-text-coding-system))
-				(with-temp-file mail-source-crash-box
+				(with-temp-file crash-box
 				  (insert-file-contents file)
 				  (goto-char (point-min))
 ;;;				  ;; Unix mail format
@@ -1031,8 +1048,8 @@ mail-source-fetch-maildir
 				  (insert "\001\001\001\001\n"))
 				(delete-file file)
 				nil))))
-	      (cl-incf found (mail-source-callback callback file))
-	      (mail-source-delete-crash-box)))))
+	      (cl-incf found (mail-source-callback callback file crash-box))
+	      (mail-source-delete-crash-box crash-box)))))
       found)))
 
 (autoload 'imap-open "imap")
@@ -1058,78 +1075,79 @@ mail-source-imap-file-coding-system
 (defun mail-source-fetch-imap (source callback)
   "Fetcher for imap sources."
   (mail-source-bind (imap source)
-    (mail-source-run-script
-     prescript
-     `((?p . ,password) (?t . ,mail-source-crash-box)
-       (?s . ,server) (?P . ,port) (?u . ,user))
-     prescript-delay)
-    (let ((from (format "%s:%s:%s" server user port))
-	  (found 0)
-	  (buf (generate-new-buffer " *imap source*"))
-	  (mail-source-string (format "imap:%s:%s" server mailbox))
-	  (imap-shell-program (or (list program) imap-shell-program))
-	  remove)
-      (if (and (imap-open server port stream authentication buf)
-	       (imap-authenticate
-		user (or (cdr (assoc from mail-source-password-cache))
-                         password)
-                buf))
-          (let ((mailbox-list (if (listp mailbox) mailbox (list mailbox))))
-            (dolist (mailbox mailbox-list)
-              (when (imap-mailbox-select mailbox nil buf)
-	  (let ((coding-system-for-write mail-source-imap-file-coding-system)
-		str)
-            (message "Fetching from %s..." mailbox)
-	    (with-temp-file mail-source-crash-box
-	      ;; Avoid converting 8-bit chars from inserted strings to
-	      ;; multibyte.
-	      (mm-disable-multibyte)
-	      ;; remember password
-	      (with-current-buffer buf
-		(when (and imap-password
-			   (not (member (cons from imap-password)
-                                        mail-source-password-cache)))
-		  (push (cons from imap-password) mail-source-password-cache)))
-	      ;; if predicate is nil, use all uids
-	      (dolist (uid (imap-search (or predicate "1:*") buf))
-		(when (setq str
-			    (if (imap-capability 'IMAP4rev1 buf)
-				(caddar (imap-fetch uid "BODY.PEEK[]"
-						    'BODYDETAIL nil buf))
-			      (imap-fetch uid "RFC822.PEEK" 'RFC822 nil buf)))
-		  (push uid remove)
-		  (insert "From imap " (current-time-string) "\n")
-		  (save-excursion
-		    (insert str "\n\n"))
-		  (while (let ((case-fold-search nil))
-			   (re-search-forward "^From " nil t))
-		    (replace-match ">From "))
-		  (goto-char (point-max))))
-	      (nnheader-ms-strip-cr))
-	    (cl-incf found (mail-source-callback callback server))
-	    (mail-source-delete-crash-box)
-	    (when (and remove fetchflag)
-	      (setq remove (nreverse remove))
-	      (imap-message-flags-add
-	       (imap-range-to-message-set (gnus-compress-sequence remove))
-	       fetchflag nil buf))
-	    (if dontexpunge
-		(imap-mailbox-unselect buf)
-              (imap-mailbox-close nil buf)))))
-            (imap-close buf))
-	(imap-close buf)
-	;; We nix out the password in case the error
-	;; was because of a wrong password being given.
-	(setq mail-source-password-cache
-	      (delq (assoc from mail-source-password-cache)
-		    mail-source-password-cache))
-	(error "IMAP error: %s" (imap-error-text buf)))
-      (kill-buffer buf)
+    (let ((crash-box (mail-source-crash-box)))
       (mail-source-run-script
-       postscript
-       `((?p . ,password) (?t . ,mail-source-crash-box)
-         (?s . ,server) (?P . ,port) (?u . ,user)))
-      found)))
+       prescript
+       `((?p . ,password) (?t . ,crash-box)
+         (?s . ,server) (?P . ,port) (?u . ,user))
+       prescript-delay)
+      (let ((from (format "%s:%s:%s" server user port))
+	    (found 0)
+	    (buf (generate-new-buffer " *imap source*"))
+	    (mail-source-string (format "imap:%s:%s" server mailbox))
+	    (imap-shell-program (or (list program) imap-shell-program))
+	    remove)
+        (if (and (imap-open server port stream authentication buf)
+	         (imap-authenticate
+		  user (or (cdr (assoc from mail-source-password-cache))
+                           password)
+                  buf))
+            (let ((mailbox-list (if (listp mailbox) mailbox (list mailbox))))
+              (dolist (mailbox mailbox-list)
+                (when (imap-mailbox-select mailbox nil buf)
+	          (let ((coding-system-for-write mail-source-imap-file-coding-system)
+		        str)
+                    (message "Fetching from %s..." mailbox)
+	            (with-temp-file crash-box
+	              ;; Avoid converting 8-bit chars from inserted strings to
+	              ;; multibyte.
+	              (mm-disable-multibyte)
+	              ;; remember password
+	              (with-current-buffer buf
+		        (when (and imap-password
+			           (not (member (cons from imap-password)
+                                                mail-source-password-cache)))
+		          (push (cons from imap-password) mail-source-password-cache)))
+	              ;; if predicate is nil, use all uids
+	              (dolist (uid (imap-search (or predicate "1:*") buf))
+		        (when (setq str
+			            (if (imap-capability 'IMAP4rev1 buf)
+				        (caddar (imap-fetch uid "BODY.PEEK[]"
+						            'BODYDETAIL nil buf))
+			              (imap-fetch uid "RFC822.PEEK" 'RFC822 nil buf)))
+		          (push uid remove)
+		          (insert "From imap " (current-time-string) "\n")
+		          (save-excursion
+		            (insert str "\n\n"))
+		          (while (let ((case-fold-search nil))
+			           (re-search-forward "^From " nil t))
+		            (replace-match ">From "))
+		          (goto-char (point-max))))
+	              (nnheader-ms-strip-cr))
+	            (cl-incf found (mail-source-callback callback server crash-box))
+	            (mail-source-delete-crash-box crash-box)
+	            (when (and remove fetchflag)
+	              (setq remove (nreverse remove))
+	              (imap-message-flags-add
+	               (imap-range-to-message-set (gnus-compress-sequence remove))
+	               fetchflag nil buf))
+	            (if dontexpunge
+		        (imap-mailbox-unselect buf)
+                      (imap-mailbox-close nil buf)))))
+              (imap-close buf))
+	  (imap-close buf)
+	  ;; We nix out the password in case the error
+	  ;; was because of a wrong password being given.
+	  (setq mail-source-password-cache
+	        (delq (assoc from mail-source-password-cache)
+		      mail-source-password-cache))
+	  (error "IMAP error: %s" (imap-error-text buf)))
+        (kill-buffer buf)
+        (mail-source-run-script
+         postscript
+         `((?p . ,password) (?t . ,crash-box)
+           (?s . ,server) (?P . ,port) (?u . ,user)))
+        found))))
 
 (provide 'mail-source)
 
-- 
2.35.1


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0003-mutex-on-nnmail-cache.patch --]
[-- Type: text/x-patch, Size: 5118 bytes --]

From a1dc119bfb777f813f7967256fc0835c34d2c0be Mon Sep 17 00:00:00 2001
From: Manuel Giraud <manuel@ledu-giraud.fr>
Date: Thu, 3 Feb 2022 13:52:41 +0100
Subject: [PATCH 3/4] mutex on nnmail cache.

---
 lisp/gnus/nnmail.el | 83 ++++++++++++++++++++++++---------------------
 1 file changed, 44 insertions(+), 39 deletions(-)

diff --git a/lisp/gnus/nnmail.el b/lisp/gnus/nnmail.el
index af9c439280..642ca16e28 100644
--- a/lisp/gnus/nnmail.el
+++ b/lisp/gnus/nnmail.el
@@ -1556,6 +1556,7 @@ nnmail-message-id
 ;;;
 
 (defvar nnmail-cache-buffer nil)
+(defvar nnmail-cache-buffer-mutex (make-mutex))
 
 (defun nnmail-cache-open ()
   (if (or (not nnmail-treat-duplicates)
@@ -1574,22 +1575,23 @@ nnmail-cache-close
   (when (and nnmail-treat-duplicates
              (buffer-live-p nnmail-cache-buffer)
 	     (buffer-modified-p nnmail-cache-buffer))
-    (with-current-buffer nnmail-cache-buffer
-      ;; Weed out the excess number of Message-IDs.
-      (goto-char (point-max))
-      (when (search-backward "\n" nil t nnmail-message-id-cache-length)
-	(progn
-	  (beginning-of-line)
-	  (delete-region (point-min) (point))))
-      ;; Save the buffer.
-      (or (file-exists-p (file-name-directory nnmail-message-id-cache-file))
-	  (make-directory (file-name-directory nnmail-message-id-cache-file)
-			  t))
-      (nnmail-write-region (point-min) (point-max)
-			   nnmail-message-id-cache-file nil 'silent)
-      (set-buffer-modified-p nil)
-      (setq nnmail-cache-buffer nil)
-      (gnus-kill-buffer (current-buffer)))))
+    (with-mutex nnmail-cache-buffer-mutex
+      (with-current-buffer nnmail-cache-buffer
+        ;; Weed out the excess number of Message-IDs.
+        (goto-char (point-max))
+        (when (search-backward "\n" nil t nnmail-message-id-cache-length)
+	  (progn
+	    (beginning-of-line)
+	    (delete-region (point-min) (point))))
+        ;; Save the buffer.
+        (or (file-exists-p (file-name-directory nnmail-message-id-cache-file))
+	    (make-directory (file-name-directory nnmail-message-id-cache-file)
+			    t))
+        (nnmail-write-region (point-min) (point-max)
+			     nnmail-message-id-cache-file nil 'silent)
+        (set-buffer-modified-p nil)
+        (setq nnmail-cache-buffer nil)
+        (gnus-kill-buffer (current-buffer))))))
 
 (defun nnmail-cache-insert (id grp &optional subject sender)
   (when (stringp id)
@@ -1605,18 +1607,19 @@ nnmail-cache-insert
       ;; pass the first (of possibly >1) group which matches. -Josh
       (unless (gnus-buffer-live-p nnmail-cache-buffer)
 	(nnmail-cache-open))
-      (with-current-buffer nnmail-cache-buffer
-	(goto-char (point-max))
-	(if (and grp (not (string= "" grp))
-		 (gnus-methods-equal-p gnus-command-method
-				       (nnmail-cache-primary-mail-backend)))
-	    (let ((regexp (if (consp nnmail-cache-ignore-groups)
-			      (mapconcat #'identity nnmail-cache-ignore-groups
-					 "\\|")
-			    nnmail-cache-ignore-groups)))
-	      (unless (and regexp (string-match regexp grp))
-		(insert id "\t" grp "\n")))
-	  (insert id "\n"))))))
+      (with-mutex nnmail-cache-buffer-mutex
+        (with-current-buffer nnmail-cache-buffer
+	  (goto-char (point-max))
+	  (if (and grp (not (string= "" grp))
+		   (gnus-methods-equal-p gnus-command-method
+				         (nnmail-cache-primary-mail-backend)))
+	      (let ((regexp (if (consp nnmail-cache-ignore-groups)
+			        (mapconcat #'identity nnmail-cache-ignore-groups
+					   "\\|")
+			      nnmail-cache-ignore-groups)))
+	        (unless (and regexp (string-match regexp grp))
+		  (insert id "\t" grp "\n")))
+	    (insert id "\n")))))))
 
 (defun nnmail-cache-primary-mail-backend ()
   (let ((be-list (cons gnus-select-method gnus-secondary-select-methods))
@@ -1638,14 +1641,15 @@ nnmail-cache-primary-mail-backend
 ;; cache.
 (defun nnmail-cache-fetch-group (id)
   (when (and nnmail-treat-duplicates nnmail-cache-buffer)
-    (with-current-buffer nnmail-cache-buffer
-      (goto-char (point-max))
-      (when (search-backward id nil t)
-	(beginning-of-line)
-	(skip-chars-forward "^\n\r\t")
-	(unless (looking-at "[\r\n]")
-	  (forward-char 1)
-	  (buffer-substring (point) (point-at-eol)))))))
+    (with-mutex nnmail-cache-buffer-mutex
+      (with-current-buffer nnmail-cache-buffer
+        (goto-char (point-max))
+        (when (search-backward id nil t)
+	  (beginning-of-line)
+	  (skip-chars-forward "^\n\r\t")
+	  (unless (looking-at "[\r\n]")
+	    (forward-char 1)
+	    (buffer-substring (point) (point-at-eol))))))))
 
 ;; Function for nnmail-split-fancy: look up all references in the
 ;; cache and if a match is found, return that group.
@@ -1682,9 +1686,10 @@ nnmail-split-fancy-with-parent
 
 (defun nnmail-cache-id-exists-p (id)
   (when nnmail-treat-duplicates
-    (with-current-buffer nnmail-cache-buffer
-      (goto-char (point-max))
-      (search-backward id nil t))))
+    (with-mutex nnmail-cache-buffer-mutex
+      (with-current-buffer nnmail-cache-buffer
+        (goto-char (point-max))
+        (search-backward id nil t)))))
 
 (defun nnmail-fetch-field (header)
   (save-excursion
-- 
2.35.1


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #5: 0004-separate-update-unread-of-group.patch --]
[-- Type: text/x-patch, Size: 7566 bytes --]

From 07dae695797f2646a1653691cdda7123b2c0e160 Mon Sep 17 00:00:00 2001
From: Manuel Giraud <manuel@ledu-giraud.fr>
Date: Sat, 5 Feb 2022 16:39:01 +0100
Subject: [PATCH 4/4] separate update unread of group.

---
 lisp/gnus/gnus-start.el | 174 ++++++++++++++++++++--------------------
 1 file changed, 88 insertions(+), 86 deletions(-)

diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el
index dd9c277805..edf7296bee 100644
--- a/lisp/gnus/gnus-start.el
+++ b/lisp/gnus/gnus-start.el
@@ -1485,6 +1485,93 @@ gnus-activate-group
 	     ;; Return the new active info.
 	     active)))))
 
+(defun gnus-update-unread-group (info active)
+  (let* ((range (gnus-info-read info))
+	 (num 0))
+
+    ;; These checks are present in gnus-activate-group but skipped
+    ;; due to setting dont-check in the preceding call.
+
+    ;; If a cache is present, we may have to alter the active info.
+    (when (and gnus-use-cache info)
+      (inline (gnus-cache-possibly-alter-active
+	       (gnus-info-group info) active)))
+
+    ;; If the agent is enabled, we may have to alter the active info.
+    (when (and gnus-agent info)
+      (gnus-agent-possibly-alter-active (gnus-info-group info) active info))
+
+    ;; Modify the list of read articles according to what articles
+    ;; are available; then tally the unread articles and add the
+    ;; number to the group hash table entry.
+    (cond
+     ((zerop (cdr active))
+      (setq num 0))
+     ((not range)
+      (setq num (- (1+ (cdr active)) (car active))))
+     ((not (listp (cdr range)))
+      ;; Fix a single (num . num) range according to the
+      ;; active hash table.
+      ;; Fix by Carsten Bormann <cabo@Informatik.Uni-Bremen.DE>.
+      (and (< (cdr range) (car active)) (setcdr range (1- (car active))))
+      (and (> (cdr range) (cdr active)) (setcdr range (cdr active)))
+      ;; Compute number of unread articles.
+      (setq num (max 0 (- (cdr active) (- (1+ (cdr range)) (car range))))))
+     (t
+      ;; The read list is a list of ranges.  Fix them according to
+      ;; the active hash table.
+      ;; First peel off any elements that are below the lower
+      ;; active limit.
+      (while (and (cdr range)
+		  (>= (car active)
+		      (or (and (atom (cadr range)) (cadr range))
+			  (caadr range))))
+	(if (numberp (car range))
+	    (setcar range
+		    (cons (car range)
+			  (or (and (numberp (cadr range))
+				   (cadr range))
+			      (cdadr range))))
+	  (setcdr (car range)
+		  (or (and (numberp (nth 1 range)) (nth 1 range))
+		      (cdadr range))))
+	(setcdr range (cddr range)))
+      ;; Adjust the first element to be the same as the lower limit.
+      (when (and (not (atom (car range)))
+		 (< (cdar range) (car active)))
+	(setcdr (car range) (1- (car active))))
+      ;; Then we want to peel off any elements that are higher
+      ;; than the upper active limit.
+      (let ((srange range))
+	;; Go past all valid elements.
+	(while (and (cdr srange)
+		    (<= (or (and (atom (cadr srange))
+				 (cadr srange))
+			    (caadr srange))
+			(cdr active)))
+	  (setq srange (cdr srange)))
+	(when (cdr srange)
+	  ;; Nuke all remaining invalid elements.
+	  (setcdr srange nil))
+
+	;; Adjust the final element.
+	(when (and (not (atom (car srange)))
+		   (> (cdar srange) (cdr active)))
+	  (setcdr (car srange) (cdr active))))
+      ;; Compute the number of unread articles.
+      (while range
+	(setq num (+ num (- (1+ (or (and (atom (car range)) (car range))
+				    (cdar range)))
+			    (or (and (atom (car range)) (car range))
+				(caar range)))))
+	(setq range (cdr range)))
+      (setq num (max 0 (- (cdr active) num)))))
+    ;; Set the number of unread articles.
+    (when (and info
+	       (gnus-group-entry (gnus-info-group info)))
+      (setcar (gnus-group-entry (gnus-info-group info)) num))
+    num))
+
 (defun gnus-get-unread-articles-in-group (info active &optional update)
   (when (and info active)
     ;; Allow the backend to update the info in the group.
@@ -1493,92 +1580,7 @@ gnus-get-unread-articles-in-group
 		info (inline (gnus-find-method-for-group
 			      (gnus-info-group info)))))
       (gnus-activate-group (gnus-info-group info) nil t))
-
-    (let* ((range (gnus-info-read info))
-	   (num 0))
-
-      ;; These checks are present in gnus-activate-group but skipped
-      ;; due to setting dont-check in the preceding call.
-
-      ;; If a cache is present, we may have to alter the active info.
-      (when (and gnus-use-cache info)
-	(inline (gnus-cache-possibly-alter-active
-		 (gnus-info-group info) active)))
-
-      ;; If the agent is enabled, we may have to alter the active info.
-      (when (and gnus-agent info)
-	(gnus-agent-possibly-alter-active (gnus-info-group info) active info))
-
-      ;; Modify the list of read articles according to what articles
-      ;; are available; then tally the unread articles and add the
-      ;; number to the group hash table entry.
-      (cond
-       ((zerop (cdr active))
-	(setq num 0))
-       ((not range)
-	(setq num (- (1+ (cdr active)) (car active))))
-       ((not (listp (cdr range)))
-	;; Fix a single (num . num) range according to the
-	;; active hash table.
-	;; Fix by Carsten Bormann <cabo@Informatik.Uni-Bremen.DE>.
-	(and (< (cdr range) (car active)) (setcdr range (1- (car active))))
-	(and (> (cdr range) (cdr active)) (setcdr range (cdr active)))
-	;; Compute number of unread articles.
-	(setq num (max 0 (- (cdr active) (- (1+ (cdr range)) (car range))))))
-       (t
-	;; The read list is a list of ranges.  Fix them according to
-	;; the active hash table.
-	;; First peel off any elements that are below the lower
-	;; active limit.
-	(while (and (cdr range)
-		    (>= (car active)
-			(or (and (atom (cadr range)) (cadr range))
-			    (caadr range))))
-	  (if (numberp (car range))
-	      (setcar range
-		      (cons (car range)
-			    (or (and (numberp (cadr range))
-				     (cadr range))
-				(cdadr range))))
-	    (setcdr (car range)
-		    (or (and (numberp (nth 1 range)) (nth 1 range))
-			(cdadr range))))
-	  (setcdr range (cddr range)))
-	;; Adjust the first element to be the same as the lower limit.
-	(when (and (not (atom (car range)))
-		   (< (cdar range) (car active)))
-	  (setcdr (car range) (1- (car active))))
-	;; Then we want to peel off any elements that are higher
-	;; than the upper active limit.
-	(let ((srange range))
-	  ;; Go past all valid elements.
-	  (while (and (cdr srange)
-		      (<= (or (and (atom (cadr srange))
-				   (cadr srange))
-			      (caadr srange))
-			  (cdr active)))
-	    (setq srange (cdr srange)))
-	  (when (cdr srange)
-	    ;; Nuke all remaining invalid elements.
-	    (setcdr srange nil))
-
-	  ;; Adjust the final element.
-	  (when (and (not (atom (car srange)))
-		     (> (cdar srange) (cdr active)))
-	    (setcdr (car srange) (cdr active))))
-	;; Compute the number of unread articles.
-	(while range
-	  (setq num (+ num (- (1+ (or (and (atom (car range)) (car range))
-				      (cdar range)))
-			      (or (and (atom (car range)) (car range))
-				  (caar range)))))
-	  (setq range (cdr range)))
-	(setq num (max 0 (- (cdr active) num)))))
-      ;; Set the number of unread articles.
-      (when (and info
-		 (gnus-group-entry (gnus-info-group info)))
-	(setcar (gnus-group-entry (gnus-info-group info)) num))
-      num)))
+    (gnus-update-unread-group info active)))
 
 ;; Go though `gnus-newsrc-alist' and compare with `gnus-active-hashtb'
 ;; and compute how many unread articles there are in each group.
-- 
2.35.1


[-- Attachment #6: Type: text/plain, Size: 17762 bytes --]




In GNU Emacs 29.0.50 (build 1, x86_64-unknown-openbsd7.0, X toolkit, cairo version 1.17.4, Xaw scroll bars)
 of 2022-02-08 built on elite.giraud
Repository revision: 798555baaa3f4afca663a6ac29bc42bf313144bc
Repository branch: mgi-gnus2
Windowing system distributor 'The X.Org Foundation', version 11.0.12101001
System Description: OpenBSD elite.giraud 7.0 GENERIC.MP#314 amd64

Configured using:
 'configure --prefix=/home/manuel/emacs --bindir=/home/manuel/bin
 --with-x-toolkit=athena --without-sound --without-compress-install
 CPPFLAGS=-I/usr/local/include LDFLAGS=-L/usr/local/lib'

Configured features:
CAIRO DBUS FREETYPE GIF GLIB GMP GNUTLS GSETTINGS HARFBUZZ JPEG JSON
LCMS2 LIBOTF LIBXML2 M17N_FLT MODULES NOTIFY KQUEUE PDUMPER PNG RSVG
SQLITE3 THREADS TIFF TOOLKIT_SCROLL_BARS WEBP X11 XDBE XIM XPM LUCID
ZLIB

Important settings:
  value of $LC_ALL: en_US.UTF-8
  locale-coding-system: utf-8-unix

Major mode: Magit

Minor modes in effect:
  global-git-commit-mode: t
  magit-auto-revert-mode: t
  icomplete-mode: t
  display-time-mode: t
  shell-dirtrack-mode: t
  repeat-mode: t
  global-eldoc-mode: t
  show-paren-mode: t
  electric-indent-mode: t
  mouse-wheel-mode: t
  menu-bar-mode: t
  file-name-shadow-mode: t
  global-font-lock-mode: t
  font-lock-mode: t
  auto-composition-mode: t
  auto-encryption-mode: t
  auto-compression-mode: t
  buffer-read-only: t
  line-number-mode: t
  indent-tabs-mode: t
  transient-mark-mode: t

Load-path shadows:
/home/manuel/.el/google-maps.el/google-maps hides /home/manuel/.el/google-maps
/home/manuel/.emacs.d/elpa/transient-20220130.1941/transient hides /home/manuel/emacs/share/emacs/29.0.50/lisp/transient
~/emacs-repo/lisp/gnus/gnus-uu hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/gnus-uu
~/emacs-repo/lisp/gnus/gnus-fun hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/gnus-fun
~/emacs-repo/lisp/gnus/spam hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/spam
~/emacs-repo/lisp/gnus/spam-wash hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/spam-wash
~/emacs-repo/lisp/gnus/spam-stat hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/spam-stat
~/emacs-repo/lisp/gnus/spam-report hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/spam-report
~/emacs-repo/lisp/gnus/smime hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/smime
~/emacs-repo/lisp/gnus/smiley hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/smiley
~/emacs-repo/lisp/gnus/score-mode hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/score-mode
~/emacs-repo/lisp/gnus/nnweb hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/nnweb
~/emacs-repo/lisp/gnus/gnus-rmail hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/gnus-rmail
~/emacs-repo/lisp/gnus/nnvirtual hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/nnvirtual
~/emacs-repo/lisp/gnus/nntp hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/nntp
~/emacs-repo/lisp/gnus/nnspool hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/nnspool
~/emacs-repo/lisp/gnus/nnselect hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/nnselect
~/emacs-repo/lisp/gnus/nnrss hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/nnrss
~/emacs-repo/lisp/gnus/nnregistry hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/nnregistry
~/emacs-repo/lisp/gnus/nnoo hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/nnoo
~/emacs-repo/lisp/gnus/nnnil hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/nnnil
~/emacs-repo/lisp/gnus/nnml hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/nnml
~/emacs-repo/lisp/gnus/nnmh hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/nnmh
~/emacs-repo/lisp/gnus/nnmbox hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/nnmbox
~/emacs-repo/lisp/gnus/nnmairix hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/nnmairix
~/emacs-repo/lisp/gnus/gnus-delay hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/gnus-delay
~/emacs-repo/lisp/gnus/nnmaildir hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/nnmaildir
~/emacs-repo/lisp/gnus/nndoc hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/nndoc
~/emacs-repo/lisp/gnus/mml1991 hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/mml1991
~/emacs-repo/lisp/gnus/mml-smime hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/mml-smime
~/emacs-repo/lisp/gnus/gnus-win hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/gnus-win
~/emacs-repo/lisp/gnus/gnus-topic hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/gnus-topic
~/emacs-repo/lisp/gnus/nngateway hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/nngateway
~/emacs-repo/lisp/gnus/nndraft hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/nndraft
~/emacs-repo/lisp/gnus/nndir hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/nndir
~/emacs-repo/lisp/gnus/nndiary hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/nndiary
~/emacs-repo/lisp/gnus/mm-util hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/mm-util
~/emacs-repo/lisp/gnus/mm-extern hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/mm-extern
~/emacs-repo/lisp/gnus/mm-partial hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/mm-partial
~/emacs-repo/lisp/gnus/mm-encode hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/mm-encode
~/emacs-repo/lisp/gnus/mm-bodies hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/mm-bodies
~/emacs-repo/lisp/gnus/gnus-vm hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/gnus-vm
~/emacs-repo/lisp/gnus/gnus-undo hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/gnus-undo
~/emacs-repo/lisp/gnus/gnus-spec hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/gnus-spec
~/emacs-repo/lisp/gnus/gnus-salt hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/gnus-salt
~/emacs-repo/lisp/gnus/gnus-rfc1843 hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/gnus-rfc1843
~/emacs-repo/lisp/gnus/gnus-range hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/gnus-range
~/emacs-repo/lisp/gnus/gnus-picon hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/gnus-picon
~/emacs-repo/lisp/gnus/gnus-notifications hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/gnus-notifications
~/emacs-repo/lisp/gnus/gnus-group hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/gnus-group
~/emacs-repo/lisp/gnus/deuglify hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/deuglify
~/emacs-repo/lisp/gnus/canlock hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/canlock
~/emacs-repo/lisp/gnus/gnus-util hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/gnus-util
~/emacs-repo/lisp/gnus/gnus-mlspl hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/gnus-mlspl
~/emacs-repo/lisp/gnus/gnus-ml hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/gnus-ml
~/emacs-repo/lisp/gnus/gnus-mh hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/gnus-mh
~/emacs-repo/lisp/gnus/gnus-logic hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/gnus-logic
~/emacs-repo/lisp/gnus/gnus-html hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/gnus-html
~/emacs-repo/lisp/gnus/gnus-dup hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/gnus-dup
~/emacs-repo/lisp/gnus/gnus-eform hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/gnus-eform
~/emacs-repo/lisp/gnus/gnus-diary hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/gnus-diary
~/emacs-repo/lisp/gnus/gnus-demon hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/gnus-demon
~/emacs-repo/lisp/gnus/gnus-cus hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/gnus-cus
~/emacs-repo/lisp/gnus/gnus-cite hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/gnus-cite
~/emacs-repo/lisp/gnus/gnus-bcklg hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/gnus-bcklg
~/emacs-repo/lisp/gnus/gnus-score hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/gnus-score
~/emacs-repo/lisp/gnus/gnus-msg hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/gnus-msg
~/emacs-repo/lisp/gnus/gnus hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/gnus
~/emacs-repo/lisp/gnus/gnus-dired hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/gnus-dired
~/emacs-repo/lisp/gnus/gnus-bookmark hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/gnus-bookmark
~/emacs-repo/lisp/gnus/gnus-agent hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/gnus-agent
~/emacs-repo/lisp/gnus/mml hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/mml
~/emacs-repo/lisp/gnus/nneething hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/nneething
~/emacs-repo/lisp/gnus/mml-sec hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/mml-sec
~/emacs-repo/lisp/gnus/mm-url hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/mm-url
~/emacs-repo/lisp/gnus/mail-source hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/mail-source
~/emacs-repo/lisp/gnus/gnus-sieve hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/gnus-sieve
~/emacs-repo/lisp/gnus/nnfolder hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/nnfolder
~/emacs-repo/lisp/gnus/mm-decode hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/mm-decode
~/emacs-repo/lisp/gnus/gnus-srvr hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/gnus-srvr
~/emacs-repo/lisp/gnus/gnus-start hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/gnus-start
~/emacs-repo/lisp/gnus/gnus-draft hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/gnus-draft
~/emacs-repo/lisp/gnus/gnus-cloud hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/gnus-cloud
~/emacs-repo/lisp/gnus/gnus-cache hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/gnus-cache
~/emacs-repo/lisp/gnus/nnbabyl hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/nnbabyl
~/emacs-repo/lisp/gnus/gnus-registry hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/gnus-registry
~/emacs-repo/lisp/gnus/mm-view hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/mm-view
~/emacs-repo/lisp/gnus/message hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/message
~/emacs-repo/lisp/gnus/nnmail hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/nnmail
~/emacs-repo/lisp/gnus/nnimap hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/nnimap
~/emacs-repo/lisp/gnus/nnheader hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/nnheader
~/emacs-repo/lisp/gnus/nnagent hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/nnagent
~/emacs-repo/lisp/gnus/gnus-search hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/gnus-search
~/emacs-repo/lisp/gnus/gnus-art hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/gnus-art
~/emacs-repo/lisp/gnus/gnus-dbus hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/gnus-dbus
~/emacs-repo/lisp/gnus/gnus-sum hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/gnus-sum
~/emacs-repo/lisp/gnus/gnus-async hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/gnus-async
~/emacs-repo/lisp/gnus/mml2015 hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/mml2015
~/emacs-repo/lisp/gnus/mm-uu hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/mm-uu
~/emacs-repo/lisp/gnus/mm-archive hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/mm-archive
~/emacs-repo/lisp/gnus/legacy-gnus-agent hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/legacy-gnus-agent
~/emacs-repo/lisp/gnus/gnus-icalendar hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/gnus-icalendar
~/emacs-repo/lisp/gnus/gssapi hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/gssapi
~/emacs-repo/lisp/gnus/gnus-int hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/gnus-int
~/emacs-repo/lisp/gnus/gnus-kill hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/gnus-kill
~/emacs-repo/lisp/gnus/gnus-gravatar hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/gnus-gravatar
~/emacs-repo/lisp/gnus/gmm-utils hides /home/manuel/emacs/share/emacs/29.0.50/lisp/gnus/gmm-utils

Features:
(goto-addr view cal-china lunar solar cal-dst cal-bahai cal-islam
cal-hebrew holidays hol-loaddefs cal-iso org-element avl-tree ol-eww eww
xdg url-queue ol-rmail ol-mhe ol-irc ol-info ol-gnus nnselect
gnus-search eieio-opt speedbar ezimage dframe ol-docview ol-bibtex
ol-bbdb ol-w3m ol-doi org-link-doi org-agenda org-refile shadow shortdoc
emacsbug whitespace magit-patch gnus-dired cl-print dabbrev rmail
magit-extras face-remap magit-submodule magit-obsolete magit-blame
magit-stash magit-reflog magit-bisect magit-push magit-pull magit-fetch
magit-clone magit-remote magit-commit magit-sequence magit-notes
magit-worktree magit-tag magit-merge magit-branch magit-reset
magit-files magit-refs magit-status magit magit-repos magit-apply
magit-wip magit-log which-func imenu magit-diff smerge-mode diff
git-commit log-edit pcvs-util add-log magit-core magit-autorevert
autorevert filenotify magit-margin magit-transient magit-process
with-editor magit-mode transient magit-git magit-section magit-utils
dash pulse help-fns radix-tree misearch multi-isearch vc-git diff-mode
bug-reference executable mailalias bbdb-message vc-dispatcher vc-svn
sort gnus-cite mail-extr textsec uni-scripts idna-mapping ucs-normalize
uni-confusable textsec-check gnus-async gnus-bcklg gnus-ml gnus-topic
mm-archive url-http url-gw url-auth qp utf-7 imap rfc2104 nnrss mm-url
nndoc nndraft nnmh gnutls network-stream nsm nnfolder bbdb-gnus nnml
gnus-agent gnus-srvr gnus-score score-mode nnvirtual gnus-msg nntp
gnus-cache w3m w3m-hist w3m-fb bookmark-w3m w3m-ems w3m-favicon
w3m-image tab-line w3m-proc w3m-util cl-extra help-mode paredit edmacro
icomplete time battery cus-load exwm-randr xcb-randr exwm-config exwm
exwm-input xcb-keysyms exwm-manage exwm-floating xcb-cursor xcb-render
exwm-layout exwm-workspace exwm-core xcb-ewmh xcb-icccm xcb xcb-xkb
xcb-xproto xcb-types xcb-debug kmacro server modus-operandi-theme
modus-themes pcase google-maps google-maps-static google-maps-geocode
google-maps-base osm-mode url-cache mingus libmpdee gnuplot info-look
transmission color calc-bin calc-ext calc calc-loaddefs rect calc-macs
w3m-load mu4e mu4e-org mu4e-main mu4e-view mu4e-view-gnus gnus-art mm-uu
mml2015 mm-view mml-smime smime dig gnus-sum gnus-group gnus-undo
gnus-start gnus-dbus gnus-cloud nnimap nnmail mail-source utf7 netrc
nnoo gnus-spec gnus-int gnus-range gnus-win gnus nnheader range wid-edit
mu4e-view-common mu4e-headers mu4e-compose mu4e-context mu4e-draft
mu4e-actions ido rfc2368 smtpmail sendmail mu4e-mark mu4e-proc
mu4e-utils doc-view jka-compr image-mode exif mu4e-lists mu4e-message
shr pixel-fill kinsoku svg dom flow-fill mule-util hl-line mu4e-vars
message yank-media rmc puny rfc822 mml mml-sec epa derived epg rfc6068
epg-config gnus-util mm-decode mm-bodies mm-encode mail-parse rfc2231
rfc2047 rfc2045 mm-util ietf-drums mail-prsvr mail-utils gmm-utils
mailheader mu4e-meta supercite regi bbdb-anniv diary-lib diary-loaddefs
bbdb-mua bbdb-com crm mailabbrev bbdb bbdb-site timezone org ob
ob-tangle ob-ref ob-lob ob-table ob-exp org-macro org-footnote org-src
ob-comint org-pcomplete org-list org-faces org-entities org-version
ob-emacs-lisp ob-core ob-eval org-table oc-basic bibtex ol rx org-keys
oc org-compat org-macs org-loaddefs find-func cal-menu calendar
cal-loaddefs visual-basic-mode web-mode disp-table erlang-start
smart-tabs-mode skeleton cc-mode cc-fonts cc-guess cc-menus cc-cmds
cc-styles cc-align cc-engine cc-vars cc-defs movitz-slime cl slime-asdf
grep slime-tramp tramp tramp-loaddefs trampver tramp-integration files-x
tramp-compat shell pcomplete parse-time iso8601 time-date ls-lisp
format-spec slime-fancy slime-indentation slime-cl-indent cl-indent
slime-trace-dialog slime-fontifying-fu slime-package-fu slime-references
slime-compiler-notes-tree advice slime-scratch slime-presentations
bridge slime-macrostep macrostep slime-mdot-fu slime-enclosing-context
slime-fuzzy slime-fancy-trace slime-fancy-inspector slime-c-p-c
slime-editing-commands slime-autodoc slime-repl slime-parse slime
compile text-property-search etags fileloop generator xref project
arc-mode archive-mode noutline outline pp comint ansi-color ring
hyperspec thingatpt slime-autoloads dired-aux dired-x dired
dired-loaddefs notifications dbus xml repeat easy-mmode tex-site info
package browse-url url url-proxy url-privacy url-expand url-methods
url-history url-cookie url-domsuf url-util mailcap url-handlers
url-parse auth-source cl-seq eieio eieio-core cl-macs eieio-loaddefs
password-cache json map url-vars seq gv subr-x byte-opt bytecomp
byte-compile cconv cl-loaddefs cl-lib iso-transl tooltip eldoc paren
electric uniquify ediff-hook vc-hooks lisp-float-type elisp-mode mwheel
term/x-win x-win term/common-win x-dnd tool-bar dnd fontset image
regexp-opt fringe tabulated-list replace newcomment text-mode lisp-mode
prog-mode register page tab-bar menu-bar rfn-eshadow isearch easymenu
timer select scroll-bar mouse jit-lock font-lock syntax font-core
term/tty-colors frame minibuffer cl-generic cham georgian utf-8-lang
misc-lang vietnamese tibetan thai tai-viet lao korean japanese eucjp-ms
cp51932 hebrew greek romanian slovak czech european ethiopic indian
cyrillic chinese composite emoji-zwj charscript charprop case-table
epa-hook jka-cmpr-hook help simple abbrev obarray cl-preloaded nadvice
button loaddefs faces cus-face macroexp files window text-properties
overlay sha1 md5 base64 format env code-pages mule custom widget keymap
hashtable-print-readable backquote threads dbusbind kqueue lcms2
dynamic-setting system-font-setting font-render-setting cairo x-toolkit
x multi-tty make-network-process emacs)

Memory information:
((conses 16 868893 102442)
 (symbols 48 59739 8)
 (strings 32 276306 16458)
 (string-bytes 1 8495369)
 (vectors 16 147772)
 (vector-slots 8 2714405 148428)
 (floats 8 1138 546)
 (intervals 56 12268 4311)
 (buffers 992 47))

-- 
Manuel Giraud

bug#53877: 29.0.50; [PATCH] async Gnus/nnml

[Eric Abrahamsen]

Manuel Giraud <manuel@ledu-giraud.fr> writes:

> Hi,
>
> I'm trying to have an asynchronous Gnus nnml backend. In the process, I
> found some things that I'd like to have first in nnmail.el and
> mail-sources.el (see patches).
>
> There is nothing asynchronous so far so Gnus behaviour shouldn't have
> changed that much.

Hi Manuel,

Thanks for working on this! Getting rid of `nnmail-article-buffer' looks
fine to me.

In the crash box patch, I wonder if we really need to change the name of
the option. It could be used as-is as a prefix, without really needing
to involve the user. Maybe changing the docstring would be enough?

In mail-source-fetch:

+            (dolist (box (mail-source-existing-crash-boxes))
+	      (message "Processing mail from %s..." box)
+	      (setq found (mail-source-callback callback box box))

You'll want to use cl-incf on `found' here (as in the other files).

In the nnmail cache mutex patch, I guess we're preparing for multiple
threads to potentially be writing to/reading from `nnmail-cache-buffer',
right? The mutex prevents concurrent access, but are we sure that
leftover text in the buffer won't confuse the regexp searches? Would it
be safer just to clear the buffer altogether after each transaction?

I'm not quite sure why you're refactoring out
`gnus-update-unread-group', is the idea that that will be used in other
places as well? Or is this the function that will get run in a thread
eventually?

Lastly, have you done your copyright assignment?

Thanks,
Eric

bug#53877: 29.0.50; [PATCH] async Gnus/nnml

[Lars Ingebrigtsen]

Manuel Giraud <manuel@ledu-giraud.fr> writes:

> -(defvar nnmail-article-buffer " *nnmail incoming*"
> -  "The buffer used for splitting incoming mails.")

[...]

> -    (with-current-buffer (gnus-get-buffer-create nnmail-article-buffer)
> -      (erase-buffer)

No, this would break lots of Gnus installations -- people have splitting
rules that go

     (: split-on-body)

where that function looks into nnmail-article-buffer to do whatever they
want.

-- 
(domestic pets only, the antidote for overdose, milk.)
   bloggy blog: http://lars.ingebrigtsen.no

bug#53877: 29.0.50; [PATCH] async Gnus/nnml

[Lars Ingebrigtsen]

Manuel Giraud <manuel@ledu-giraud.fr> writes:

> -(defcustom mail-source-crash-box "~/.emacs-mail-crash-box"
> -  "File where mail will be stored while processing it."
> +(defcustom mail-source-crash-box-prefix "~/.emacs-mail-crash-box-"
> +  "Prefix of files where mail will be stored while processing it."
>    :type 'file)

Is the point here that we want to have several mail-source-fetchers
going in parallel?

> +(defun mail-source-existing-crash-boxes ()
> +  (let ((directory (file-name-directory mail-source-crash-box-prefix))
> +        (partial (file-name-nondirectory mail-source-crash-box-prefix)))
> +    (mapcar #'(lambda (name) (file-name-concat directory name))
> +            (file-name-all-completions partial directory))))

`directory-files' takes a MATCH parameter, and is the way to get
matches -- not the completion machinery.

-- 
(domestic pets only, the antidote for overdose, milk.)
   bloggy blog: http://lars.ingebrigtsen.no

bug#53877: 29.0.50; [PATCH] async Gnus/nnml

[Robert Pluim]

>>>>> On Tue, 08 Feb 2022 12:33:54 -0800, Eric Abrahamsen <eric@ericabrahamsen.net> said:

    Eric> Manuel Giraud <manuel@ledu-giraud.fr> writes:
    >> Hi,
    >> 
    >> I'm trying to have an asynchronous Gnus nnml backend. In the process, I
    >> found some things that I'd like to have first in nnmail.el and
    >> mail-sources.el (see patches).
    >> 
    >> There is nothing asynchronous so far so Gnus behaviour shouldn't have
    >> changed that much.

    Eric> Hi Manuel,

    Eric> Thanks for working on this! Getting rid of `nnmail-article-buffer' looks
    Eric> fine to me.

My paranoid side says that Iʼd rather have a predictable buffer name
when treating incoming email than a temporary buffer.

    Eric> In the crash box patch, I wonder if we really need to change the name of
    Eric> the option. It could be used as-is as a prefix, without really needing
    Eric> to involve the user. Maybe changing the docstring would be enough?

Right. Backwards compatibility is important.

Robert
-- 

bug#53877: 29.0.50; [PATCH] async Gnus/nnml

[Manuel Giraud]

Lars Ingebrigtsen <larsi@gnus.org> writes:

> Manuel Giraud <manuel@ledu-giraud.fr> writes:
>
>> -(defvar nnmail-article-buffer " *nnmail incoming*"
>> -  "The buffer used for splitting incoming mails.")
>
> [...]
>
>> -    (with-current-buffer (gnus-get-buffer-create nnmail-article-buffer)
>> -      (erase-buffer)
>
> No, this would break lots of Gnus installations -- people have splitting
> rules that go
>
>      (: split-on-body)
>
> where that function looks into nnmail-article-buffer to do whatever they
> want.

I've just test this with my patch in place:

--8<---------------cut here---------------start------------->8---
(defun foo-split ()
  (save-excursion
    (save-restriction
      (widen)
      (goto-char (point-min))
      (when (re-search-forward "booga" nil t)
	"booga"))))

;; Mail splitting (XXX order is important)
(setq nnmail-split-methods 'nnmail-split-fancy
      nnmail-split-fancy
      `(| (: foo-split)
          "elsewhere"))
--8<---------------cut here---------------end--------------->8---

…and it works as expected: splitting a mail containing "booga" to
"booga". `nnmail-split-it' does not seems to have a reference to
nnmail-buffer-article and just works on the current buffer:

--8<---------------cut here---------------start------------->8---
     ;; Builtin : operation.
     ((eq (car split) ':)
      (nnmail-log-split split)
      (nnmail-split-it (save-excursion (eval (cdr split) t))))
--8<---------------cut here---------------end--------------->8---
-- 
Manuel Giraud

bug#53877: 29.0.50; [PATCH] async Gnus/nnml

[Lars Ingebrigtsen]

Manuel Giraud <manuel@ledu-giraud.fr> writes:

> I've just test this with my patch in place:

People have code like

(defun split-on-body ()
  (save-excursion
    (set-buffer nnmail-article-buffer)
    (goto-char (point-min))
    (let ((case-fold-search t))
      (cond
       ((re-search-forward
...


-- 
(domestic pets only, the antidote for overdose, milk.)
   bloggy blog: http://lars.ingebrigtsen.no

bug#53877: 29.0.50; [PATCH] async Gnus/nnml

[Manuel Giraud]

Lars Ingebrigtsen <larsi@gnus.org> writes:

> Manuel Giraud <manuel@ledu-giraud.fr> writes:
>
>> -(defcustom mail-source-crash-box "~/.emacs-mail-crash-box"
>> -  "File where mail will be stored while processing it."
>> +(defcustom mail-source-crash-box-prefix "~/.emacs-mail-crash-box-"
>> +  "Prefix of files where mail will be stored while processing it."
>>    :type 'file)
>
> Is the point here that we want to have several mail-source-fetchers
> going in parallel?

Yes that's the point. After those patches, I've started to work on
moving `mail-source-fetch' from «callback method» to «process+sentinel
method». So far, I have done most simple ones: "file" and "directory"
sources.

>> +(defun mail-source-existing-crash-boxes ()
>> +  (let ((directory (file-name-directory mail-source-crash-box-prefix))
>> +        (partial (file-name-nondirectory mail-source-crash-box-prefix)))
>> +    (mapcar #'(lambda (name) (file-name-concat directory name))
>> +            (file-name-all-completions partial directory))))
>
> `directory-files' takes a MATCH parameter, and is the way to get
> matches -- not the completion machinery.

Thanks, I'll change that.
-- 
Manuel Giraud

bug#53877: 29.0.50; [PATCH] async Gnus/nnml

[Manuel Giraud]

Lars Ingebrigtsen <larsi@gnus.org> writes:

> People have code like
>
> (defun split-on-body ()
>   (save-excursion
>     (set-buffer nnmail-article-buffer)
>     (goto-char (point-min))
>     (let ((case-fold-search t))
>       (cond
>        ((re-search-forward
> ...

Ouch! Too bad because I don't think I could achieve multiple mail-source
fetchers in parallel without it. OTOH, this is not the example in the
info file which is correct.
-- 
Manuel Giraud

bug#53877: 29.0.50; [PATCH] async Gnus/nnml

[Lars Ingebrigtsen]

Manuel Giraud <manuel@ledu-giraud.fr> writes:

> Ouch! Too bad because I don't think I could achieve multiple mail-source
> fetchers in parallel without it.

Why can't you bind `nnmail-article-buffer' before calling the splitting
function?

-- 
(domestic pets only, the antidote for overdose, milk.)
   bloggy blog: http://lars.ingebrigtsen.no

bug#53877: 29.0.50; [PATCH] async Gnus/nnml

[Manuel Giraud]

Lars Ingebrigtsen <larsi@gnus.org> writes:

> Manuel Giraud <manuel@ledu-giraud.fr> writes:
>
>> Ouch! Too bad because I don't think I could achieve multiple mail-source
>> fetchers in parallel without it.
>
> Why can't you bind `nnmail-article-buffer' before calling the splitting
> function?

Ah yes of course 😅. Should I resubmit modified patch on this bug report?
-- 
Manuel Giraud

bug#53877: 29.0.50; [PATCH] async Gnus/nnml

[Lars Ingebrigtsen]

Manuel Giraud <manuel@ledu-giraud.fr> writes:

> Ah yes of course 😅. Should I resubmit modified patch on this bug report?

Yes, please.

-- 
(domestic pets only, the antidote for overdose, milk.)
   bloggy blog: http://lars.ingebrigtsen.no

bug#53877: 29.0.50; [PATCH] async Gnus/nnml

[Manuel Giraud]

Lars Ingebrigtsen <larsi@gnus.org> writes:

> Why can't you bind `nnmail-article-buffer' before calling the splitting
> function?

I spoke too quickly. The idea was that with a temporay buffer I could
run multiple splitting in "parallel". But rebinding just *one* global
variable won't help much here.
-- 
Manuel Giraud

bug#53877: 29.0.50; [PATCH] async Gnus/nnml

[Eric Abrahamsen]

Manuel Giraud <manuel@ledu-giraud.fr> writes:

> Lars Ingebrigtsen <larsi@gnus.org> writes:
>
>> Why can't you bind `nnmail-article-buffer' before calling the splitting
>> function?
>
> I spoke too quickly. The idea was that with a temporay buffer I could
> run multiple splitting in "parallel". But rebinding just *one* global
> variable won't help much here.

Are you sure? AFAIK this was Dick Chiang's approach to threading server
updates: let-binding the value of `nntp-server-buffer' within the thread
function. As far as I know it worked okay. The splitting function and
code run within it will have a separate value of
`nnmail-article-buffer'.

bug#53877: 29.0.50; [PATCH] async Gnus/nnml

[Lars Ingebrigtsen]

Manuel Giraud <manuel@ledu-giraud.fr> writes:

> Yes that's the point. After those patches, I've started to work on
> moving `mail-source-fetch' from «callback method» to «process+sentinel
> method». So far, I have done most simple ones: "file" and "directory"
> sources.

Ah, right.  Yeah, I think that's probably a good place to start.

-- 
(domestic pets only, the antidote for overdose, milk.)
   bloggy blog: http://lars.ingebrigtsen.no

bug#53877: 29.0.50; [PATCH] async Gnus/nnml

[Manuel Giraud]

Eric Abrahamsen <eric@ericabrahamsen.net> writes:

> Manuel Giraud <manuel@ledu-giraud.fr> writes:
>
>> Lars Ingebrigtsen <larsi@gnus.org> writes:
>>
>>> Why can't you bind `nnmail-article-buffer' before calling the splitting
>>> function?
>>
>> I spoke too quickly. The idea was that with a temporay buffer I could
>> run multiple splitting in "parallel". But rebinding just *one* global
>> variable won't help much here.
>
> Are you sure? AFAIK this was Dick Chiang's approach to threading
> server updates: let-binding the value of `nntp-server-buffer' within
> the thread function. As far as I know it worked okay. The splitting
> function and code run within it will have a separate value of
> `nnmail-article-buffer'.

I'm trying another approach: seek to the processes in the backend, don't
wait for them to end but instead attach sentinels for what's left to
do. Maybe it is not the best approach because Gnus seems to be heavily
stateful/serial.

I'm not sure about binding in sentinels: do you think it would work as
binding in threads?
-- 
Manuel Giraud

bug#53877: 29.0.50; [PATCH] async Gnus/nnml

[Eric Abrahamsen]

On 02/10/22 10:02 AM, Manuel Giraud wrote:
> Eric Abrahamsen <eric@ericabrahamsen.net> writes:
>
>> Manuel Giraud <manuel@ledu-giraud.fr> writes:
>>
>>> Lars Ingebrigtsen <larsi@gnus.org> writes:
>>>
>>>> Why can't you bind `nnmail-article-buffer' before calling the splitting
>>>> function?
>>>
>>> I spoke too quickly. The idea was that with a temporay buffer I could
>>> run multiple splitting in "parallel". But rebinding just *one* global
>>> variable won't help much here.
>>
>> Are you sure? AFAIK this was Dick Chiang's approach to threading
>> server updates: let-binding the value of `nntp-server-buffer' within
>> the thread function. As far as I know it worked okay. The splitting
>> function and code run within it will have a separate value of
>> `nnmail-article-buffer'.
>
> I'm trying another approach: seek to the processes in the backend, don't
> wait for them to end but instead attach sentinels for what's left to
> do. Maybe it is not the best approach because Gnus seems to be heavily
> stateful/serial.
>
> I'm not sure about binding in sentinels: do you think it would work as
> binding in threads?

Are you sure the original approach won't work? If you set
`nnmail-article-buffer' locally within the thread function, it seems to
work okay. Is this not workable:

(defun test-threads-outer ()
  (dolist (label (list "one" "two" "three"))
    (make-thread (lambda () (test-threads-inner label)) label)))

(defun test-threads-inner (label)
  (let ((nnmail-article-buffer (format "nnmail-incoming-%s" label)))
    (with-current-buffer (get-buffer-create nnmail-article-buffer)
      (insert label))))

That creates three separate buffers, named correctly, and holding the
correct text.

bug#53877: 29.0.50; [PATCH] async Gnus/nnml

[Eric Abrahamsen]

On 02/10/22 10:11 AM, Eric Abrahamsen wrote:
> On 02/10/22 10:02 AM, Manuel Giraud wrote:
>> Eric Abrahamsen <eric@ericabrahamsen.net> writes:
>>
>>> Manuel Giraud <manuel@ledu-giraud.fr> writes:
>>>
>>>> Lars Ingebrigtsen <larsi@gnus.org> writes:
>>>>
>>>>> Why can't you bind `nnmail-article-buffer' before calling the splitting
>>>>> function?
>>>>
>>>> I spoke too quickly. The idea was that with a temporay buffer I could
>>>> run multiple splitting in "parallel". But rebinding just *one* global
>>>> variable won't help much here.
>>>
>>> Are you sure? AFAIK this was Dick Chiang's approach to threading
>>> server updates: let-binding the value of `nntp-server-buffer' within
>>> the thread function. As far as I know it worked okay. The splitting
>>> function and code run within it will have a separate value of
>>> `nnmail-article-buffer'.
>>
>> I'm trying another approach: seek to the processes in the backend, don't
>> wait for them to end but instead attach sentinels for what's left to
>> do. Maybe it is not the best approach because Gnus seems to be heavily
>> stateful/serial.
>>
>> I'm not sure about binding in sentinels: do you think it would work as
>> binding in threads?
>
> Are you sure the original approach won't work? If you set
> `nnmail-article-buffer' locally within the thread function, it seems to
> work okay. Is this not workable:
>
> (defun test-threads-outer ()
>   (dolist (label (list "one" "two" "three"))
>     (make-thread (lambda () (test-threads-inner label)) label)))
>
> (defun test-threads-inner (label)
>   (let ((nnmail-article-buffer (format "nnmail-incoming-%s" label)))
>     (with-current-buffer (get-buffer-create nnmail-article-buffer)
>       (insert label))))
>
> That creates three separate buffers, named correctly, and holding the
> correct text.

Though in this simple example, the copies of the inner function are
actually still being executed consecutively, so maybe this doesn't prove
anything? I don't have much faith in my reasoning about threads.

bug#53877: 29.0.50; [PATCH] async Gnus/nnml

[Eli Zaretskii]

> From: Eric Abrahamsen <eric@ericabrahamsen.net>
> Date: Thu, 10 Feb 2022 10:11:56 -0800
> Cc: 53877@debbugs.gnu.org, Lars Ingebrigtsen <larsi@gnus.org>
> 
> 
> (defun test-threads-outer ()
>   (dolist (label (list "one" "two" "three"))
>     (make-thread (lambda () (test-threads-inner label)) label)))
> 
> (defun test-threads-inner (label)
>   (let ((nnmail-article-buffer (format "nnmail-incoming-%s" label)))
>     (with-current-buffer (get-buffer-create nnmail-article-buffer)
>       (insert label))))
> 
> That creates three separate buffers, named correctly, and holding the
> correct text.

But only if you don't do anything in the main thread, just let it sit
idling.  Right?  Otherwise those other threads won't get an
opportunity to run.

bug#53877: 29.0.50; [PATCH] async Gnus/nnml

[Eric Abrahamsen]

Eli Zaretskii <eliz@gnu.org> writes:

>> From: Eric Abrahamsen <eric@ericabrahamsen.net>
>> Date: Thu, 10 Feb 2022 10:11:56 -0800
>> Cc: 53877@debbugs.gnu.org, Lars Ingebrigtsen <larsi@gnus.org>
>> 
>> 
>> (defun test-threads-outer ()
>>   (dolist (label (list "one" "two" "three"))
>>     (make-thread (lambda () (test-threads-inner label)) label)))
>> 
>> (defun test-threads-inner (label)
>>   (let ((nnmail-article-buffer (format "nnmail-incoming-%s" label)))
>>     (with-current-buffer (get-buffer-create nnmail-article-buffer)
>>       (insert label))))
>> 
>> That creates three separate buffers, named correctly, and holding the
>> correct text.
>
> But only if you don't do anything in the main thread, just let it sit
> idling.  Right?  Otherwise those other threads won't get an
> opportunity to run.

Sure, in real life we'd be yielding to these threads and joining
afterwards before going on with the rest of the code. This example was
just to show that having different locally-bound values for
`nnmail-article-buffer' in each thread was a viable approach.

bug#53877: 29.0.50; [PATCH] async Gnus/nnml

[Manuel Giraud]

Eric Abrahamsen <eric@ericabrahamsen.net> writes:

[...]

> Are you sure the original approach won't work? If you set
> `nnmail-article-buffer' locally within the thread function, it seems to
> work okay. Is this not workable:

Hi Eric,

I was trying just something different. The process/sentinel seems like a
good (established) way to do this in emacs without having to rely on
handling threads yielding (when?). Maybe it won't be fruitful though 😅
-- 
Manuel Giraud

bug#53877: 29.0.50; [PATCH] async Gnus/nnml

[Eric Abrahamsen]

Manuel Giraud <manuel@ledu-giraud.fr> writes:

> Eric Abrahamsen <eric@ericabrahamsen.net> writes:
>
> [...]
>
>> Are you sure the original approach won't work? If you set
>> `nnmail-article-buffer' locally within the thread function, it seems to
>> work okay. Is this not workable:
>
> Hi Eric,
>
> I was trying just something different. The process/sentinel seems like a
> good (established) way to do this in emacs without having to rely on
> handling threads yielding (when?). Maybe it won't be fruitful though 😅

Without having actually gone and written the code myself... my guess is
these two approaches will end up being pretty equivalent in design, only
the details will vary. You're going to launch several "things" in a loop
(the things being either threads, or processes+sentinels), then block
the rest of Emacs while you wait for all of the "things" to be done,
then carry on with main function execution.

Gnus is not set up for these "things" to return at random intervals, ie
we cannot "fire and forget". Not to mention that the "things" will block
Emacs while running elisp, but relinquish control while receiving
process output, which I think would lead to a kind of "stuttering"
responsiveness that would be more annoying than simply blocking Emacs
altogether. No matter which approach you take it will probably have to
wait for all the things to return before it continues, so the only
advantage is in being able to "layer" multiple process io and save a
little time there.

The Trio python library has a neat concept called nurseries, which
guarantees that multiple child threads all have to return before main
code execution continues, that might be interesting to look at:

https://trio.readthedocs.io/en/latest/reference-core.html#nurseries-and-spawning