From: Manuel Giraud <manuel@ledu-giraud.fr>
To: emacs-devel <emacs-devel@gnu.org>
Subject: async Gnus
Date: Mon, 24 Jan 2022 17:58:42 +0100 [thread overview]
Message-ID: <87a6flqddp.fsf@elite.giraud> (raw)
[-- 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
next reply other threads:[~2022-01-24 16:58 UTC|newest]
Thread overview: 9+ messages / expand[flat|nested] mbox.gz Atom feed top
2022-01-24 16:58 Manuel Giraud [this message]
2022-01-25 17:29 ` async Gnus 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
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=87a6flqddp.fsf@elite.giraud \
--to=manuel@ledu-giraud.fr \
--cc=emacs-devel@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
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).