>From b184e82d0551fe52a9dcf025b355da7faafc68b2 Mon Sep 17 00:00:00 2001 From: Eric Abrahamsen Date: Thu, 31 Oct 2019 14:14:44 -0700 Subject: [PATCH] WIP on allowing Gnus backends to return headers directly * lisp/gnus/gnus-sum.el (gnus-fetch-headers): Allow the gnus-retrieve-headers backend function to directly return a list of headers, instead of inserting data to parse in the nntp-server-buffer. * lisp/gnus/nnir.el (nnir-retrieve-headers): Handle the same case when nnir calls the "real" backend function. --- lisp/gnus/gnus-sum.el | 55 +++++++++++++++++++++++++++++-------------- lisp/gnus/gnus.el | 9 ++++++- lisp/gnus/nnir.el | 35 ++++++++++++++++----------- 3 files changed, 66 insertions(+), 33 deletions(-) diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index f21bc7584e..142c50cac0 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -5629,25 +5629,44 @@ gnus-summary-remove-list-identifiers (setf (mail-header-subject header) subject)))))) (defun gnus-fetch-headers (articles &optional limit force-new dependencies) - "Fetch headers of ARTICLES." + "Fetch headers of ARTICLES. +This calls the `gnus-retrieve-headers' function of the current +group's backend server. The server can do one of two things: + +1. Write the headers for ARTICLES into the + `nntp-server-buffer' (the current buffer) in a parseable format, or +2. Return the headers directly as a list of vectors. + +In the first case, `gnus-retrieve-headers' returns a symbol +value, either `nov' or `headers'. This value determines which +parsing function is used to read the headers. It is also stored +into the variable `gnus-headers-retrieved-by', which is consulted +later when possibly building full threads." (gnus-message 7 "Fetching headers for %s..." gnus-newsgroup-name) - (prog1 - (if (eq 'nov - (setq gnus-headers-retrieved-by - (gnus-retrieve-headers - articles gnus-newsgroup-name - (or limit - ;; We might want to fetch old headers, but - ;; not if there is only 1 article. - (and (or (and - (not (eq gnus-fetch-old-headers 'some)) - (not (numberp gnus-fetch-old-headers))) - (> (length articles) 1)) - gnus-fetch-old-headers))))) - (gnus-get-newsgroup-headers-xover - articles force-new dependencies gnus-newsgroup-name t) - (gnus-get-newsgroup-headers dependencies force-new)) - (gnus-message 7 "Fetching headers for %s...done" gnus-newsgroup-name))) + (let ((res (setq gnus-headers-retrieved-by + (gnus-retrieve-headers + articles gnus-newsgroup-name + (or limit + ;; We might want to fetch old headers, but + ;; not if there is only 1 article. + (and (or (and + (not (eq gnus-fetch-old-headers 'some)) + (not (numberp gnus-fetch-old-headers))) + (> (length articles) 1)) + gnus-fetch-old-headers)))))) + (prog1 + (pcase res + ('nov + (gnus-get-newsgroup-headers-xover + articles force-new dependencies gnus-newsgroup-name t)) + ;; For now, assume that any backend returning its own + ;; headers takes some effort to do so, so return `headers'. + ((pred listp) + (setq gnus-headers-retrieved-by 'headers) + res) + ;; 'headers is the other likely value. + (_ (gnus-get-newsgroup-headers dependencies force-new))) + (gnus-message 7 "Fetching headers for %s...done" gnus-newsgroup-name)))) (defun gnus-select-newsgroup (group &optional read-all select-articles) "Select newsgroup GROUP. diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index 0673ac15f6..a5b2891477 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -2387,7 +2387,14 @@ gnus-article-unpropagated-mark-lists such as a mark that says whether an article is stored in the cache \(which doesn't make sense in a standalone back end).") -(defvar gnus-headers-retrieved-by nil) +(defvar gnus-headers-retrieved-by nil + "Holds the return value of `gnus-retrieve-headers'. +This is either the symbol `nov' or the symbol `headers'. This +value is checked during the summary creation process, when +building threads. A value of `nov' indicates that header +retrieval is relatively cheap and threading is encouraged to +include more old articles. A value of `headers' indciates that +retrieval is expensive and should be minimized.") (defvar gnus-article-reply nil) (defvar gnus-override-method nil) (defvar gnus-opened-servers nil) diff --git a/lisp/gnus/nnir.el b/lisp/gnus/nnir.el index 7cb2d1615a..48af6067f0 100644 --- a/lisp/gnus/nnir.el +++ b/lisp/gnus/nnir.el @@ -719,22 +719,29 @@ nnir-retrieve-headers (setq parsefunc 'nnheader-parse-nov)) ('headers (setq parsefunc 'nnheader-parse-head)) + ((pred listp) + (setq headers gnus-headers-retrieved-by)) (_ (error "Unknown header type %s while requesting articles \ of group %s" gnus-headers-retrieved-by artgroup))) - (goto-char (point-min)) - (while (not (eobp)) - (let* ((novitem (funcall parsefunc)) - (artno (and novitem - (mail-header-number novitem))) - (art (car (rassq artno articleids)))) - (when art - (setf (mail-header-number novitem) art) - (push novitem headers)) - (forward-line 1))))) - (setq headers - (sort headers - (lambda (x y) - (< (mail-header-number x) (mail-header-number y))))) + (unless headers + (goto-char (point-min)) + (while (not (eobp)) + (push (funcall parsefunc) headers) + (forward-line 1))) + (setq headers + (sort + (delq nil + (mapcar + (lambda (novitem) + (let* ((artno (and novitem + (mail-header-number novitem))) + (art (car-safe (rassq artno articleids)))) + (when art + (setf (mail-header-number novitem) art) + novitem))) + headers)) + (lambda (x y) + (< (mail-header-number x) (mail-header-number y))))))) (erase-buffer) (mapc 'nnheader-insert-nov headers) 'nov))) -- 2.23.0