unofficial mirror of emacs-devel@gnu.org 
 help / color / mirror / code / Atom feed
* async Gnus
@ 2022-01-24 16:58 Manuel Giraud
  2022-01-25 17:29 ` Eric Abrahamsen
  0 siblings, 1 reply; 9+ messages in thread
From: Manuel Giraud @ 2022-01-24 16:58 UTC (permalink / raw)
  To: emacs-devel

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

Hi,

I'd like to have Gnus being able to fetch some mails (and news
obviously ;-) without freezing emacs completely. I'm currently
trying the attached dumb patch that so far seems to fly with a gnus
demon handler like this:

(gnus-demon-add-handler 'gnus-group-get-new-news 5 nil)

My questions are:

   - Is this the right place to discuss Gnus dev?
   - This patch seems too simple: what am I missing?

Best regards,

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-a-thread-for-Gnus-fetching.patch --]
[-- Type: text/x-patch, Size: 24093 bytes --]

From 12185a4cf37be07e491d5003f1c88cd8499bab5f Mon Sep 17 00:00:00 2001
From: Manuel Giraud <manuel@ledu-giraud.fr>
Date: Mon, 24 Jan 2022 17:29:13 +0100
Subject: [PATCH] a thread for Gnus fetching.

---
 lisp/gnus/gnus-demon.el  |   6 +-
 lisp/gnus/gnus-group.el  | 117 +++++++++++++++++++------------------
 lisp/gnus/gnus-int.el    |  41 +++++++------
 lisp/gnus/gnus-search.el | 121 +++++++++++++++++++--------------------
 lisp/gnus/gnus-sum.el    |  61 ++++++++++----------
 lisp/gnus/nnselect.el    |  85 ++++++++++++++-------------
 6 files changed, 215 insertions(+), 216 deletions(-)

diff --git a/lisp/gnus/gnus-demon.el b/lisp/gnus/gnus-demon.el
index d9da8529eb..c14a10eb78 100644
--- a/lisp/gnus/gnus-demon.el
+++ b/lisp/gnus/gnus-demon.el
@@ -70,8 +70,8 @@ gnus-demon-timestep
 
 (defvar gnus-demon-timers nil
   "Plist of idle timers which are running.")
-(defvar gnus-inhibit-demon nil
-  "If non-nil, no daemonic function will be run.")
+(defvar gnus-fetching-mutex)
+(make-obsolete-variable 'gnus-inhibit-demon nil "29.0.50")
 
 ;;; Functions.
 
@@ -98,7 +98,7 @@ gnus-demon-run-callback
 If not, and a TIME is given, restart a new idle timer, so FUNC
 can be called at the next opportunity.  Such a special idle run
 is marked with SPECIAL."
-  (unless gnus-inhibit-demon
+  (with-mutex gnus-fetching-mutex
     (cl-block run-callback
       (when (eq idle t)
         (setq idle 0.001))
diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el
index d3a94e9f4e..769f843547 100644
--- a/lisp/gnus/gnus-group.el
+++ b/lisp/gnus/gnus-group.el
@@ -500,7 +500,7 @@ gnus-tmp-subscribed
 (defvar gnus-tmp-summary-live)
 (defvar gnus-tmp-user-defined)
 
-(defvar gnus-inhibit-demon)
+(defvar gnus-fetching-mutex (make-mutex "Gnus is fetching"))
 (defvar gnus-pick-mode)
 (defvar gnus-tmp-marked-mark)
 (defvar gnus-tmp-number-of-unread)
@@ -4185,6 +4185,31 @@ gnus-activate-all-groups
 	(gnus-activate-foreign-newsgroups level))
     (gnus-group-get-new-news)))
 
+(defun gnus-group-get-new-news-1 (arg one-level)
+  (with-mutex gnus-fetching-mutex
+    (let (;; Binding this variable will inhibit multiple fetchings
+	  ;; of the same mail source.
+	  (nnmail-fetched-sources (list t)))
+      (gnus-run-hooks 'gnus-get-top-new-news-hook)
+      (gnus-run-hooks 'gnus-get-new-news-hook)
+
+      ;; Read any child files.
+      (unless gnus-child
+        (gnus-parent-read-child-newsrc))
+
+      (gnus-get-unread-articles (gnus-group-default-level arg t)
+			        nil one-level)
+
+      ;; If the user wants it, we scan for new groups.
+      (when (eq gnus-check-new-newsgroups 'always)
+        (gnus-find-new-newsgroups))
+
+      (gnus-check-reasonable-setup)
+      (gnus-run-hooks 'gnus-after-getting-new-news-hook)
+      (gnus-group-list-groups (and (numberp arg) arg))
+      (when gnus-group-use-permanent-levels
+        (setq gnus-group-use-permanent-levels (gnus-group-default-level arg))))))
+
 (defun gnus-group-get-new-news (&optional arg one-level)
   "Get newly arrived articles.
 If ARG is a number, it specifies which levels you are interested in
@@ -4194,29 +4219,7 @@ gnus-group-get-new-news
 otherwise all levels below ARG will be scanned too."
   (interactive "P" gnus-group-mode)
   (require 'nnmail)
-  (let ((gnus-inhibit-demon t)
-	;; Binding this variable will inhibit multiple fetchings
-	;; of the same mail source.
-	(nnmail-fetched-sources (list t)))
-    (gnus-run-hooks 'gnus-get-top-new-news-hook)
-    (gnus-run-hooks 'gnus-get-new-news-hook)
-
-    ;; Read any child files.
-    (unless gnus-child
-      (gnus-parent-read-child-newsrc))
-
-    (gnus-get-unread-articles (gnus-group-default-level arg t)
-			      nil one-level)
-
-    ;; If the user wants it, we scan for new groups.
-    (when (eq gnus-check-new-newsgroups 'always)
-      (gnus-find-new-newsgroups))
-
-    (gnus-check-reasonable-setup)
-    (gnus-run-hooks 'gnus-after-getting-new-news-hook)
-    (gnus-group-list-groups (and (numberp arg) arg))
-    (when gnus-group-use-permanent-levels
-      (setq gnus-group-use-permanent-levels (gnus-group-default-level arg)))))
+  (make-thread #'(lambda () (gnus-group-get-new-news-1 arg one-level))))
 
 (defun gnus-group-get-new-news-this-group (&optional n dont-scan)
   "Check for newly arrived news in the current group (and the N-1 next groups).
@@ -4229,42 +4232,42 @@ gnus-group-get-new-news-this-group
 	 (beg (unless n
 		(point-marker)))
 	 group method
-	 (gnus-inhibit-demon t)
 	 ;; Binding this variable will inhibit multiple fetchings
 	 ;; of the same mail source.
 	 (nnmail-fetched-sources (list t)))
-    (gnus-run-hooks 'gnus-get-new-news-hook)
-    (while (setq group (pop groups))
-      (gnus-group-remove-mark group)
-      ;; Bypass any previous denials from the server.
-      (gnus-remove-denial (setq method (gnus-find-method-for-group group)))
-      (if (if (and (not dont-scan)
-		   ;; Prefer request-group-scan if the backend supports it.
-		   (gnus-check-backend-function 'request-group-scan group))
-	      (progn
-		;; Ensure that the server is already open.
-		(gnus-activate-group group nil nil method)
-		(gnus-request-group-scan group (gnus-get-info group)))
-	    (gnus-activate-group group (if dont-scan nil 'scan) nil method))
-	  (let ((info (gnus-get-info group))
-		(active (gnus-active group)))
-	    (when info
-	      (gnus-request-update-info info method))
-	    (gnus-get-unread-articles-in-group info active)
-	    (unless (gnus-virtual-group-p group)
-	      (gnus-close-group group))
-	    (when gnus-agent
-	      (gnus-agent-save-group-info
-	       method (gnus-group-real-name group) active))
-	    (gnus-group-update-group group nil t))
-	(gnus-error 3 "%s error: %s" group (gnus-status-message group))))
-    (gnus-run-hooks 'gnus-after-getting-new-news-hook)
-    (when beg
-      (goto-char beg))
-    (when gnus-goto-next-group-when-activating
-      (gnus-group-next-unread-group 1 t))
-    (gnus-group-position-point)
-    ret))
+    (with-mutex gnus-fetching-mutex
+      (gnus-run-hooks 'gnus-get-new-news-hook)
+      (while (setq group (pop groups))
+        (gnus-group-remove-mark group)
+        ;; Bypass any previous denials from the server.
+        (gnus-remove-denial (setq method (gnus-find-method-for-group group)))
+        (if (if (and (not dont-scan)
+		     ;; Prefer request-group-scan if the backend supports it.
+		     (gnus-check-backend-function 'request-group-scan group))
+	        (progn
+		  ;; Ensure that the server is already open.
+		  (gnus-activate-group group nil nil method)
+		  (gnus-request-group-scan group (gnus-get-info group)))
+	      (gnus-activate-group group (if dont-scan nil 'scan) nil method))
+	    (let ((info (gnus-get-info group))
+		  (active (gnus-active group)))
+	      (when info
+	        (gnus-request-update-info info method))
+	      (gnus-get-unread-articles-in-group info active)
+	      (unless (gnus-virtual-group-p group)
+	        (gnus-close-group group))
+	      (when gnus-agent
+	        (gnus-agent-save-group-info
+	         method (gnus-group-real-name group) active))
+	      (gnus-group-update-group group nil t))
+	  (gnus-error 3 "%s error: %s" group (gnus-status-message group))))
+      (gnus-run-hooks 'gnus-after-getting-new-news-hook)
+      (when beg
+        (goto-char beg))
+      (when gnus-goto-next-group-when-activating
+        (gnus-group-next-unread-group 1 t))
+      (gnus-group-position-point)
+      ret)))
 
 (defun gnus-group-describe-group (force &optional group)
   "Display a description of the current newsgroup."
diff --git a/lisp/gnus/gnus-int.el b/lisp/gnus/gnus-int.el
index f00f2a0d04..256f13e7c0 100644
--- a/lisp/gnus/gnus-int.el
+++ b/lisp/gnus/gnus-int.el
@@ -755,21 +755,20 @@ gnus-request-expunge-group
              (nth 1 gnus-command-method))))
 
 (defvar mail-source-plugged)
-(defvar gnus-inhibit-demon)
 
 (defun gnus-request-scan (group command-method)
   "Request a SCAN being performed in GROUP from COMMAND-METHOD.
 If GROUP is nil, all groups on COMMAND-METHOD are scanned."
   (let ((gnus-command-method
 	 (if group (gnus-find-method-for-group group) command-method))
-	(gnus-inhibit-demon t)
 	(mail-source-plugged gnus-plugged))
-    (when (or gnus-plugged
-	      (not (gnus-agent-method-p gnus-command-method)))
-      (setq gnus-internal-registry-spool-current-method gnus-command-method)
-      (funcall (gnus-get-function gnus-command-method 'request-scan)
-	       (and group (gnus-group-real-name group))
-	       (nth 1 gnus-command-method)))))
+    (with-mutex gnus-fetching-mutex
+      (when (or gnus-plugged
+	        (not (gnus-agent-method-p gnus-command-method)))
+        (setq gnus-internal-registry-spool-current-method gnus-command-method)
+        (funcall (gnus-get-function gnus-command-method 'request-scan)
+	         (and group (gnus-group-real-name group))
+	         (nth 1 gnus-command-method))))))
 
 (defun gnus-request-update-info (info command-method)
   (when (gnus-check-backend-function
@@ -812,18 +811,18 @@ gnus-request-expire-articles
          ;; expired here.
          (articles
           (delq nil (mapcar (lambda (n) (and (>= n 0) n)) articles)))
-	 (gnus-inhibit-demon t)
 	 (not-deleted
 	  (funcall
 	   (gnus-get-function gnus-command-method 'request-expire-articles)
 	   articles (gnus-group-real-name group) (nth 1 gnus-command-method)
 	   force)))
-    (when (and gnus-agent
-	       (gnus-agent-method-p gnus-command-method))
-      (let ((expired-articles (gnus-sorted-difference articles not-deleted)))
-        (when expired-articles
-          (gnus-agent-expire expired-articles group 'force))))
-    not-deleted))
+    (with-mutex gnus-fetching-mutex
+      (when (and gnus-agent
+	         (gnus-agent-method-p gnus-command-method))
+        (let ((expired-articles (gnus-sorted-difference articles not-deleted)))
+          (when expired-articles
+            (gnus-agent-expire expired-articles group 'force))))
+      not-deleted)))
 
 (defun gnus-request-move-article (article group _server accept-function
 					  &optional last move-is-internal)
@@ -928,13 +927,13 @@ gnus-request-rename-group
 (defun gnus-close-backends ()
   ;; Send a close request to all backends that support such a request.
   (let ((methods gnus-valid-select-methods)
-	(gnus-inhibit-demon t)
 	func gnus-command-method)
-    (while (setq gnus-command-method (pop methods))
-      (when (fboundp (setq func (intern
-				 (concat (car gnus-command-method)
-					 "-request-close"))))
-	(funcall func)))))
+    (with-mutex gnus-fetching-mutex
+      (while (setq gnus-command-method (pop methods))
+        (when (fboundp (setq func (intern
+				   (concat (car gnus-command-method)
+					   "-request-close"))))
+	  (funcall func))))))
 
 (defun gnus-asynchronous-p (command-method)
   (let ((func (gnus-get-function command-method 'asynchronous-p t)))
diff --git a/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el
index bf88abae76..572a2b92c1 100644
--- a/lisp/gnus/gnus-search.el
+++ b/lisp/gnus/gnus-search.el
@@ -87,7 +87,6 @@
 (autoload 'eieio-build-class-alist "eieio-opt")
 (autoload 'nnmaildir-base-name-to-article-number "nnmaildir")
 
-(defvar gnus-inhibit-demon)
 (defvar gnus-english-month-names)
 
 ;;; Internal Variables:
@@ -1015,70 +1014,70 @@ gnus-search-run-search
 				      srv query groups)
   (save-excursion
     (let ((server (cadr (gnus-server-to-method srv)))
-          (gnus-inhibit-demon t)
 	  ;; We're using the message id to look for a single message.
 	  (single-search (gnus-search-single-p query))
 	  (grouplist (or groups (gnus-search-get-active srv)))
 	  q-string artlist group)
-      (gnus-message 7 "Opening server %s" server)
-      (gnus-open-server srv)
-      ;; We should only be doing this once, in
-      ;; `nnimap-open-connection', but it's too frustrating to try to
-      ;; get to the server from the process buffer.
-      (with-current-buffer (nnimap-buffer)
-	(setf (slot-value engine 'literal-plus)
-	      (when (nnimap-capability "LITERAL+") t))
-	;; MULTISEARCH not yet implemented.
-	(setf (slot-value engine 'multisearch)
-	      (when (nnimap-capability "MULTISEARCH") t))
-	;; FUZZY only partially supported: the command is sent to the
-	;; server (and presumably acted upon), but we don't yet
-	;; request a RELEVANCY score as part of the response.
-	(setf (slot-value engine 'fuzzy)
-	      (when (nnimap-capability "SEARCH=FUZZY") t)))
-
-      (setq q-string
-	    (gnus-search-make-query-string engine query))
-
-      ;; A bit of backward-compatibility slash convenience: if the
-      ;; query string doesn't start with any known IMAP search
-      ;; keyword, assume it is a "TEXT" search.
-      (unless (or (eql ?\( (aref q-string 0))
-		  (and (string-match "\\`[^[:blank:]]+" q-string)
-		       (memql (intern-soft (downcase
-					    (match-string 0 q-string)))
-			      gnus-search-imap-search-keys)))
-	(setq q-string (concat "TEXT " q-string)))
-
-      ;; If it's a thread query, make sure that all message-id
-      ;; searches are also references searches.
-      (when (alist-get 'thread query)
-	(setq q-string
-	      (replace-regexp-in-string
-	       "HEADER Message-Id \\([^ )]+\\)"
-	       "(OR HEADER Message-Id \\1 HEADER References \\1)"
-	       q-string)))
-
-      (while (and (setq group (pop grouplist))
-		  (or (null single-search) (= 0 (length artlist))))
-	(when (nnimap-change-group
-	       (gnus-group-short-name group) server)
-	  (with-current-buffer (nnimap-buffer)
-	    (gnus-message 7 "Searching %s..." group)
-	    (let ((result
-		   (gnus-search-imap-search-command engine q-string)))
-	      (when (car result)
-		(setq artlist
-		      (vconcat
-		       (mapcar
-			(lambda (artnum)
-			  (let ((artn (string-to-number artnum)))
-			    (when (> artn 0)
-			      (vector group artn 100))))
-			(cdr (assoc "SEARCH" (cdr result))))
-		       artlist))))
-	    (gnus-message 7 "Searching %s...done" group))))
-      (nreverse artlist))))
+      (with-mutex gnus-fetching-mutex
+        (gnus-message 7 "Opening server %s" server)
+        (gnus-open-server srv)
+        ;; We should only be doing this once, in
+        ;; `nnimap-open-connection', but it's too frustrating to try to
+        ;; get to the server from the process buffer.
+        (with-current-buffer (nnimap-buffer)
+	  (setf (slot-value engine 'literal-plus)
+	        (when (nnimap-capability "LITERAL+") t))
+	  ;; MULTISEARCH not yet implemented.
+	  (setf (slot-value engine 'multisearch)
+	        (when (nnimap-capability "MULTISEARCH") t))
+	  ;; FUZZY only partially supported: the command is sent to the
+	  ;; server (and presumably acted upon), but we don't yet
+	  ;; request a RELEVANCY score as part of the response.
+	  (setf (slot-value engine 'fuzzy)
+	        (when (nnimap-capability "SEARCH=FUZZY") t)))
+
+        (setq q-string
+	      (gnus-search-make-query-string engine query))
+
+        ;; A bit of backward-compatibility slash convenience: if the
+        ;; query string doesn't start with any known IMAP search
+        ;; keyword, assume it is a "TEXT" search.
+        (unless (or (eql ?\( (aref q-string 0))
+		    (and (string-match "\\`[^[:blank:]]+" q-string)
+		         (memql (intern-soft (downcase
+					      (match-string 0 q-string)))
+			        gnus-search-imap-search-keys)))
+	  (setq q-string (concat "TEXT " q-string)))
+
+        ;; If it's a thread query, make sure that all message-id
+        ;; searches are also references searches.
+        (when (alist-get 'thread query)
+	  (setq q-string
+	        (replace-regexp-in-string
+	         "HEADER Message-Id \\([^ )]+\\)"
+	         "(OR HEADER Message-Id \\1 HEADER References \\1)"
+	         q-string)))
+
+        (while (and (setq group (pop grouplist))
+		    (or (null single-search) (= 0 (length artlist))))
+	  (when (nnimap-change-group
+	         (gnus-group-short-name group) server)
+	    (with-current-buffer (nnimap-buffer)
+	      (gnus-message 7 "Searching %s..." group)
+	      (let ((result
+		     (gnus-search-imap-search-command engine q-string)))
+	        (when (car result)
+		  (setq artlist
+		        (vconcat
+		         (mapcar
+			  (lambda (artnum)
+			    (let ((artn (string-to-number artnum)))
+			      (when (> artn 0)
+			        (vector group artn 100))))
+			  (cdr (assoc "SEARCH" (cdr result))))
+		         artlist))))
+	      (gnus-message 7 "Searching %s...done" group))))
+        (nreverse artlist)))))
 
 (cl-defmethod gnus-search-imap-search-command ((engine gnus-search-imap)
 					       (query string))
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index 8fb07d5905..4894402516 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -30,7 +30,6 @@ tool-bar-mode
 (defvar gnus-category-predicate-alist)
 (defvar gnus-category-predicate-cache)
 (defvar gnus-inhibit-article-treatments)
-(defvar gnus-inhibit-demon)
 (defvar gnus-tmp-article-number)
 (defvar gnus-tmp-closing-bracket)
 (defvar gnus-tmp-current)
@@ -8713,17 +8712,17 @@ gnus-summary-limit-include-dormant
 
 (defun gnus-summary-include-articles (articles)
   "Fetch the headers for ARTICLES and then display the summary lines."
-  (let ((gnus-inhibit-demon t)
-	(gnus-agent nil)
+  (let ((gnus-agent nil)
 	(gnus-read-all-available-headers t))
-    (setq gnus-newsgroup-headers
-	  (cl-merge
-	   'list gnus-newsgroup-headers
-	   (gnus-fetch-headers articles nil t)
-	   'gnus-article-sort-by-number))
-    (setq gnus-newsgroup-articles
-	  (gnus-sorted-nunion gnus-newsgroup-articles articles))
-    (gnus-summary-limit (append articles gnus-newsgroup-limit))))
+    (with-mutex gnus-fetching-mutex
+      (setq gnus-newsgroup-headers
+	    (cl-merge
+	     'list gnus-newsgroup-headers
+	     (gnus-fetch-headers articles nil t)
+	     'gnus-article-sort-by-number))
+      (setq gnus-newsgroup-articles
+	    (gnus-sorted-nunion gnus-newsgroup-articles articles))
+      (gnus-summary-limit (append articles gnus-newsgroup-limit)))))
 
 (defun gnus-summary-limit-exclude-dormant ()
   "Hide all dormant articles."
@@ -9086,7 +9085,6 @@ gnus-summary-refer-thread
   (interactive "P" gnus-summary-mode)
   (let* ((header (gnus-summary-article-header))
 	 (id (mail-header-id header))
-	 (gnus-inhibit-demon t)
 	 (gnus-summary-ignore-duplicates t)
 	 (gnus-read-all-available-headers t)
 	 (gnus-refer-thread-use-search
@@ -9116,25 +9114,26 @@ gnus-summary-refer-thread
 						  (* 2 limit) limit)
                                   t))))
 	 article-ids new-unreads)
-    (when (listp new-headers)
-      (dolist (header new-headers)
-	(push (mail-header-number header) article-ids))
-      (setq article-ids (nreverse article-ids))
-      (setq new-unreads
-	    (gnus-sorted-intersection gnus-newsgroup-unselected article-ids))
-      (setq gnus-newsgroup-unselected
-	    (gnus-sorted-ndifference gnus-newsgroup-unselected new-unreads))
-      (setq gnus-newsgroup-unreads
-	    (gnus-sorted-nunion gnus-newsgroup-unreads new-unreads))
-      (setq gnus-newsgroup-headers
-            (gnus-delete-duplicate-headers
-             (cl-merge
-              'list gnus-newsgroup-headers new-headers
-              'gnus-article-sort-by-number)))
-      (setq gnus-newsgroup-articles
-	    (gnus-sorted-nunion gnus-newsgroup-articles article-ids))
-      (gnus-summary-limit-include-thread id gnus-refer-thread-limit-to-thread)))
-  (gnus-summary-show-thread))
+    (with-mutex gnus-fetching-mutex
+      (when (listp new-headers)
+        (dolist (header new-headers)
+	  (push (mail-header-number header) article-ids))
+        (setq article-ids (nreverse article-ids))
+        (setq new-unreads
+	      (gnus-sorted-intersection gnus-newsgroup-unselected article-ids))
+        (setq gnus-newsgroup-unselected
+	      (gnus-sorted-ndifference gnus-newsgroup-unselected new-unreads))
+        (setq gnus-newsgroup-unreads
+	      (gnus-sorted-nunion gnus-newsgroup-unreads new-unreads))
+        (setq gnus-newsgroup-headers
+              (gnus-delete-duplicate-headers
+               (cl-merge
+                'list gnus-newsgroup-headers new-headers
+                'gnus-article-sort-by-number)))
+        (setq gnus-newsgroup-articles
+	      (gnus-sorted-nunion gnus-newsgroup-articles article-ids))
+        (gnus-summary-limit-include-thread id gnus-refer-thread-limit-to-thread)))
+    (gnus-summary-show-thread)))
 
 (defun gnus-summary-open-group-with-article (message-id)
   "Open a group containing the article with the given MESSAGE-ID."
diff --git a/lisp/gnus/nnselect.el b/lisp/gnus/nnselect.el
index 205456a57d..2d09d62dce 100644
--- a/lisp/gnus/nnselect.el
+++ b/lisp/gnus/nnselect.el
@@ -61,7 +61,6 @@ nnselect
 
 ;;; Internal Variables:
 
-(defvar gnus-inhibit-demon)
 (defvar gnus-message-group-art)
 
 ;; For future use
@@ -316,53 +315,53 @@ nnselect-retrieve-headers
     (with-current-buffer (gnus-summary-buffer-name group)
       (setq gnus-newsgroup-selection (or gnus-newsgroup-selection
 					 (nnselect-get-artlist group)))
-      (let ((gnus-inhibit-demon t)
-	    (gartids (ids-by-group articles))
+      (let ((gartids (ids-by-group articles))
 	    headers)
-	(with-current-buffer nntp-server-buffer
-	  (pcase-dolist (`(,artgroup . ,artids) gartids)
-	    (let ((artlist (sort (mapcar #'cdr artids) #'<))
-		  (gnus-override-method (gnus-find-method-for-group artgroup))
-		  (fetch-old
-		   (or
-		    (car-safe
-		     (gnus-group-find-parameter artgroup
-						'gnus-fetch-old-headers t))
-		    fetch-old)))
-	      (erase-buffer)
-	      (pcase (setq gnus-headers-retrieved-by
-			   (or
-			    (and
-			     nnselect-retrieve-headers-override-function
-			     (funcall
-			      nnselect-retrieve-headers-override-function
-			      artlist artgroup))
-			    (gnus-retrieve-headers
-			     artlist artgroup fetch-old)))
-		('nov
-		 (goto-char (point-min))
-		 (while (not (eobp))
-		   (nnselect-add-novitem
-		    (nnheader-parse-nov))
-		   (forward-line 1)))
-		('headers
-		 (gnus-run-hooks 'gnus-parse-headers-hook)
-		 (let ((nnmail-extra-headers gnus-extra-headers))
+        (with-mutex gnus-fetching-mutex
+	  (with-current-buffer nntp-server-buffer
+	    (pcase-dolist (`(,artgroup . ,artids) gartids)
+	      (let ((artlist (sort (mapcar #'cdr artids) #'<))
+		    (gnus-override-method (gnus-find-method-for-group artgroup))
+		    (fetch-old
+		     (or
+		      (car-safe
+		       (gnus-group-find-parameter artgroup
+						  'gnus-fetch-old-headers t))
+		      fetch-old)))
+	        (erase-buffer)
+	        (pcase (setq gnus-headers-retrieved-by
+			     (or
+			      (and
+			       nnselect-retrieve-headers-override-function
+			       (funcall
+			        nnselect-retrieve-headers-override-function
+			        artlist artgroup))
+			      (gnus-retrieve-headers
+			       artlist artgroup fetch-old)))
+		  ('nov
 		   (goto-char (point-min))
 		   (while (not (eobp))
 		     (nnselect-add-novitem
-		      (nnheader-parse-head))
-		     (forward-line 1))))
-		((pred listp)
-		 (dolist (novitem gnus-headers-retrieved-by)
-		   (nnselect-add-novitem novitem)))
-		(_ (error "Unknown header type %s while requesting articles \
+		      (nnheader-parse-nov))
+		     (forward-line 1)))
+		  ('headers
+		   (gnus-run-hooks 'gnus-parse-headers-hook)
+		   (let ((nnmail-extra-headers gnus-extra-headers))
+		     (goto-char (point-min))
+		     (while (not (eobp))
+		       (nnselect-add-novitem
+		        (nnheader-parse-head))
+		       (forward-line 1))))
+		  ((pred listp)
+		   (dolist (novitem gnus-headers-retrieved-by)
+		     (nnselect-add-novitem novitem)))
+		  (_ (error "Unknown header type %s while requesting articles \
                     of group %s" gnus-headers-retrieved-by artgroup)))))
-	  (setq headers
-		(sort
-		 headers
-		 (lambda (x y)
-		   (< (mail-header-number x) (mail-header-number y))))))))))
+	    (setq headers
+		  (sort
+		   headers
+		   (lambda (x y)
+		     (< (mail-header-number x) (mail-header-number y)))))))))))
 
 
 (deffoo nnselect-request-article (article &optional _group server to-buffer)
-- 
2.34.1


[-- Attachment #3: Type: text/plain, Size: 18 bytes --]

-- 
Manuel Giraud

^ permalink raw reply related	[flat|nested] 9+ messages in thread

end of thread, other threads:[~2022-02-01 16:26 UTC | newest]

Thread overview: 9+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2022-01-24 16:58 async Gnus Manuel Giraud
2022-01-25 17:29 ` Eric Abrahamsen
2022-01-26 10:05   ` Manuel Giraud
2022-01-26 13:10     ` Eli Zaretskii
2022-01-26 14:58       ` Manuel Giraud
2022-01-26 15:32         ` Thomas Fitzsimmons
2022-01-26 16:36           ` Manuel Giraud
2022-01-26 17:53             ` Eric Abrahamsen
2022-02-01 16:26               ` Manuel Giraud

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).