* bug#38011: 27.0.50; [PATCH] WIP on allowing Gnus backends to return header data directly @ 2019-10-31 21:34 Eric Abrahamsen 2019-11-01 14:12 ` Lars Ingebrigtsen 0 siblings, 1 reply; 29+ messages in thread From: Eric Abrahamsen @ 2019-10-31 21:34 UTC (permalink / raw) To: 38011; +Cc: Lars Ingebrigtsen [-- Attachment #1: Type: text/plain, Size: 1789 bytes --] Right now, Gnus backends return article header data by writing it in a parseable format into the `nntp-server-buffer', and returning one of the symbols 'nov or 'headers, indicating how the data should be parsed. This isn't great because it requires backends to first munge their data into a format that looks like the NNTP format, which is then parsed again, which is an extra layer of data transformation. It also makes use of the `nntp-server-buffer', which is something I'd like to work on reducing because it causes problems with threading and introduces potential encoding bugs. This patch provides the possibility for backends to return their own headers (ie a list of vectors), though it doesn't actually change any of the backends to do that -- that will be another patch. I have one question at this stage: the 'nov or 'headers value gets stored into the `gnus-headers-retrieved-by' variable. That variable is later checked in a couple of places like so: (when (and gnus-fetch-old-headers (eq gnus-headers-retrieved-by 'nov)) (if (eq gnus-fetch-old-headers 'invisible) (gnus-build-all-threads) (gnus-build-old-threads))) If the variable is 'headers, the `gnus-build-*-threads' functions don't get called at all. What's the difference between 'nov and 'headers, and why can we build threads in one case and not the other? If backends were to return their own headers, what value should they return? I'll also note that the nnir version of this function returns 'nov regardless of what the "real" backend function returned -- why is that? I would love to use some other, more direct, heuristic to decide about building threads or not, and get rid of the 'nov/'headers/gnus-headers-retrieved-by stuff altogether, but I don't yet know how to do that. Eric [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0001-WIP-on-allowing-Gnus-backends-to-return-headers-dire.patch --] [-- Type: text/x-patch, Size: 4186 bytes --] From d871f95325ef230f0fda7aeecf1c2b6461d23183 Mon Sep 17 00:00:00 2001 From: Eric Abrahamsen <eric@ericabrahamsen.net> 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 | 37 ++++++++++++++++++++----------------- lisp/gnus/nnir.el | 35 +++++++++++++++++++++-------------- 2 files changed, 41 insertions(+), 31 deletions(-) diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index f21bc7584e..e86781bd1a 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -5631,23 +5631,26 @@ gnus-summary-remove-list-identifiers (defun gnus-fetch-headers (articles &optional limit force-new dependencies) "Fetch headers of ARTICLES." (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)) + ((pred listp) 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/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 ^ permalink raw reply related [flat|nested] 29+ messages in thread
* bug#38011: 27.0.50; [PATCH] WIP on allowing Gnus backends to return header data directly 2019-10-31 21:34 bug#38011: 27.0.50; [PATCH] WIP on allowing Gnus backends to return header data directly Eric Abrahamsen @ 2019-11-01 14:12 ` Lars Ingebrigtsen 2019-11-01 18:41 ` Eric Abrahamsen 0 siblings, 1 reply; 29+ messages in thread From: Lars Ingebrigtsen @ 2019-11-01 14:12 UTC (permalink / raw) To: Eric Abrahamsen; +Cc: 38011 Eric Abrahamsen <eric@ericabrahamsen.net> writes: > This patch provides the possibility for backends to return their own > headers (ie a list of vectors), though it doesn't actually change any of > the backends to do that -- that will be another patch. Great! > I have one question at this stage: the 'nov or 'headers value gets > stored into the `gnus-headers-retrieved-by' variable. That variable is > later checked in a couple of places like so: > > (when (and gnus-fetch-old-headers > (eq gnus-headers-retrieved-by 'nov)) > (if (eq gnus-fetch-old-headers 'invisible) > (gnus-build-all-threads) > (gnus-build-old-threads))) > > If the variable is 'headers, the `gnus-build-*-threads' functions don't > get called at all. > > What's the difference between 'nov and 'headers, and why can we build > threads in one case and not the other? If backends were to return their > own headers, what value should they return? It's not about threading per se, but about displaying information about already-read articles (or more precisely -- about articles not in the set that was requested). Threads are build no matter how the backend delivers the data. If nn-*retrieve-headers supports NOV fetching, then certain Gnus variables about filling in threads with "old" articles is switched on, because fetching extra NOV headers is fast (you just say "fetch 100-150" instead of "fetch 100-110,120-130,150"). With the backends that fetch head by head, this is slow, so it's not done. It's basically a distinction between NNTP and almost all the other backends. -- (domestic pets only, the antidote for overdose, milk.) bloggy blog: http://lars.ingebrigtsen.no ^ permalink raw reply [flat|nested] 29+ messages in thread
* bug#38011: 27.0.50; [PATCH] WIP on allowing Gnus backends to return header data directly 2019-11-01 14:12 ` Lars Ingebrigtsen @ 2019-11-01 18:41 ` Eric Abrahamsen 2019-11-01 20:52 ` Eric Abrahamsen 2019-11-02 14:49 ` Lars Ingebrigtsen 0 siblings, 2 replies; 29+ messages in thread From: Eric Abrahamsen @ 2019-11-01 18:41 UTC (permalink / raw) To: Lars Ingebrigtsen; +Cc: 38011 Lars Ingebrigtsen <larsi@gnus.org> writes: > Eric Abrahamsen <eric@ericabrahamsen.net> writes: > >> This patch provides the possibility for backends to return their own >> headers (ie a list of vectors), though it doesn't actually change any of >> the backends to do that -- that will be another patch. > > Great! > >> I have one question at this stage: the 'nov or 'headers value gets >> stored into the `gnus-headers-retrieved-by' variable. That variable is >> later checked in a couple of places like so: >> >> (when (and gnus-fetch-old-headers >> (eq gnus-headers-retrieved-by 'nov)) >> (if (eq gnus-fetch-old-headers 'invisible) >> (gnus-build-all-threads) >> (gnus-build-old-threads))) >> >> If the variable is 'headers, the `gnus-build-*-threads' functions don't >> get called at all. >> >> What's the difference between 'nov and 'headers, and why can we build >> threads in one case and not the other? If backends were to return their >> own headers, what value should they return? > > It's not about threading per se, but about displaying information about > already-read articles (or more precisely -- about articles not in the > set that was requested). Threads are build no matter how the backend > delivers the data. > > If nn-*retrieve-headers supports NOV fetching, then certain Gnus > variables about filling in threads with "old" articles is switched on, > because fetching extra NOV headers is fast (you just say "fetch 100-150" > instead of "fetch 100-110,120-130,150"). With the backends that fetch > head by head, this is slow, so it's not done. > > It's basically a distinction between NNTP and almost all the other > backends. Okay, that makes sense. So it's basically a flag saying header retrieval is cheap enough that we might as well pull in more old messages than we otherwise would. For example, nnmaildir builds and stores nov data (which drives people with large maildirs insane because it takes enormous amounts of time and space), so it returns 'nov, but if we ever got rid of that (or made it optional) it would return 'headers. I'm going to assume that any backend capable of returning its own headers is probably going to... return 'headers. At any rate, as I implement this for various backends, I'll start with the ones that return 'headers to begin with. At some point, though, I'd still like to get rid of this flag and build the distinction into the backend functions themselves. Hmmm... nnmaildir needs some love. Eric ^ permalink raw reply [flat|nested] 29+ messages in thread
* bug#38011: 27.0.50; [PATCH] WIP on allowing Gnus backends to return header data directly 2019-11-01 18:41 ` Eric Abrahamsen @ 2019-11-01 20:52 ` Eric Abrahamsen 2019-11-02 14:49 ` Lars Ingebrigtsen 1 sibling, 0 replies; 29+ messages in thread From: Eric Abrahamsen @ 2019-11-01 20:52 UTC (permalink / raw) To: Lars Ingebrigtsen; +Cc: Andrew Cohen, 38011 [-- Attachment #1: Type: text/plain, Size: 750 bytes --] Eric Abrahamsen <eric@ericabrahamsen.net> writes: > Lars Ingebrigtsen <larsi@gnus.org> writes: > >> Eric Abrahamsen <eric@ericabrahamsen.net> writes: >> >>> This patch provides the possibility for backends to return their own >>> headers (ie a list of vectors), though it doesn't actually change any of >>> the backends to do that -- that will be another patch. >> >> Great! >> >>> I have one question at this stage: the 'nov or 'headers value gets >>> stored into the `gnus-headers-retrieved-by' variable. That variable is >>> later checked in a couple of places like so: Okay, here's the patch as it stands -- I'll do some testing first. Andy, I'm copying you in because this touches nnir.el, and nnselect.el will need to be edited accordingly. [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0001-WIP-on-allowing-Gnus-backends-to-return-headers-dire.patch --] [-- Type: text/x-patch, Size: 6003 bytes --] From b184e82d0551fe52a9dcf025b355da7faafc68b2 Mon Sep 17 00:00:00 2001 From: Eric Abrahamsen <eric@ericabrahamsen.net> 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 ^ permalink raw reply related [flat|nested] 29+ messages in thread
* bug#38011: 27.0.50; [PATCH] WIP on allowing Gnus backends to return header data directly 2019-11-01 18:41 ` Eric Abrahamsen 2019-11-01 20:52 ` Eric Abrahamsen @ 2019-11-02 14:49 ` Lars Ingebrigtsen 2019-11-07 23:21 ` Eric Abrahamsen 1 sibling, 1 reply; 29+ messages in thread From: Lars Ingebrigtsen @ 2019-11-02 14:49 UTC (permalink / raw) To: Eric Abrahamsen; +Cc: 38011 Eric Abrahamsen <eric@ericabrahamsen.net> writes: > Okay, that makes sense. So it's basically a flag saying header retrieval > is cheap enough that we might as well pull in more old messages than we > otherwise would. Yup. > Hmmm... nnmaildir needs some love. Indeed. -- (domestic pets only, the antidote for overdose, milk.) bloggy blog: http://lars.ingebrigtsen.no ^ permalink raw reply [flat|nested] 29+ messages in thread
* bug#38011: 27.0.50; [PATCH] WIP on allowing Gnus backends to return header data directly 2019-11-02 14:49 ` Lars Ingebrigtsen @ 2019-11-07 23:21 ` Eric Abrahamsen 2019-11-08 21:03 ` Lars Ingebrigtsen 0 siblings, 1 reply; 29+ messages in thread From: Eric Abrahamsen @ 2019-11-07 23:21 UTC (permalink / raw) To: Lars Ingebrigtsen; +Cc: 38011 I knew this seemed too simple... Andy Cohen pointed out that `gnus-get-newsgroup-headers{,-xover}' were doing more work (running hooks, and the alter function) that needed to also be done if headers were returned directly. There's a bunch of other overlap between those two functions (and between `gnus-get-newsgroup-headers' and `nnheader-parse-naked-head') that Andy is working on refactoring (I hope). In the meantime there are several other places in the code that use `gnus-retrieve-headers', and will need to be updated to handle the possibility that headers have been returned directly. What I'd really like to do, as much as possible, is to switch to `gnus-fetch-headers', so we get our headers back and don't need to know how that happened. This will also avoid ugliness like `nnvirtual-convert-headers'. I think I can probably figure out how to do this in most spots. gnus-agent and gnus-cache are particularly gnarly, though: what does -braid-nov/-braid-heads actually do? Eric ^ permalink raw reply [flat|nested] 29+ messages in thread
* bug#38011: 27.0.50; [PATCH] WIP on allowing Gnus backends to return header data directly 2019-11-07 23:21 ` Eric Abrahamsen @ 2019-11-08 21:03 ` Lars Ingebrigtsen 2019-11-08 21:43 ` Eric Abrahamsen 0 siblings, 1 reply; 29+ messages in thread From: Lars Ingebrigtsen @ 2019-11-08 21:03 UTC (permalink / raw) To: Eric Abrahamsen; +Cc: 38011 Eric Abrahamsen <eric@ericabrahamsen.net> writes: > I think I can probably figure out how to do this in most spots. > gnus-agent and gnus-cache are particularly gnarly, though: what does > -braid-nov/-braid-heads actually do? Take two sets of nov/head headers and combine them. Basically sort | uniq, but they're already sorted. -- (domestic pets only, the antidote for overdose, milk.) bloggy blog: http://lars.ingebrigtsen.no ^ permalink raw reply [flat|nested] 29+ messages in thread
* bug#38011: 27.0.50; [PATCH] WIP on allowing Gnus backends to return header data directly 2019-11-08 21:03 ` Lars Ingebrigtsen @ 2019-11-08 21:43 ` Eric Abrahamsen 2019-11-08 21:58 ` Lars Ingebrigtsen 0 siblings, 1 reply; 29+ messages in thread From: Eric Abrahamsen @ 2019-11-08 21:43 UTC (permalink / raw) To: Lars Ingebrigtsen; +Cc: 38011 On 11/08/19 22:03 PM, Lars Ingebrigtsen wrote: > Eric Abrahamsen <eric@ericabrahamsen.net> writes: > >> I think I can probably figure out how to do this in most spots. >> gnus-agent and gnus-cache are particularly gnarly, though: what does >> -braid-nov/-braid-heads actually do? > > Take two sets of nov/head headers and combine them. Basically sort | > uniq, but they're already sorted. Okay good -- that should be as easy (easier) to do with an actual list of headers than with text in a buffer. ^ permalink raw reply [flat|nested] 29+ messages in thread
* bug#38011: 27.0.50; [PATCH] WIP on allowing Gnus backends to return header data directly 2019-11-08 21:43 ` Eric Abrahamsen @ 2019-11-08 21:58 ` Lars Ingebrigtsen 2020-03-29 19:50 ` Eric Abrahamsen 0 siblings, 1 reply; 29+ messages in thread From: Lars Ingebrigtsen @ 2019-11-08 21:58 UTC (permalink / raw) To: Eric Abrahamsen; +Cc: 38011 Eric Abrahamsen <eric@ericabrahamsen.net> writes: > Okay good -- that should be as easy (easier) to do with an actual list > of headers than with text in a buffer. Yup; much easier. -- (domestic pets only, the antidote for overdose, milk.) bloggy blog: http://lars.ingebrigtsen.no ^ permalink raw reply [flat|nested] 29+ messages in thread
* bug#38011: 27.0.50; [PATCH] WIP on allowing Gnus backends to return header data directly 2019-11-08 21:58 ` Lars Ingebrigtsen @ 2020-03-29 19:50 ` Eric Abrahamsen 2020-04-30 4:50 ` Lars Ingebrigtsen 0 siblings, 1 reply; 29+ messages in thread From: Eric Abrahamsen @ 2020-03-29 19:50 UTC (permalink / raw) To: Lars Ingebrigtsen; +Cc: 38011 Lars Ingebrigtsen <larsi@gnus.org> writes: > Eric Abrahamsen <eric@ericabrahamsen.net> writes: > >> Okay good -- that should be as easy (easier) to do with an actual list >> of headers than with text in a buffer. > > Yup; much easier. Okay I've had a little more, uh, free time recently to work on Gnus stuff, and am nearly ready with a patch for this. It got gnarly in gnus-agent.el, but I think I've got a handle on it. I have one question right now, about `nnvirtual-update-xref-header', which needs to be rewritten from altering header text in a buffer, to altering the `mail-header-xref' value of an already-parsed header. First of all, it unconditionally adds an xref header to our group and article, even if there wasn't one before. Then it does the following. I'm not sure how to describe this in plain English. I would say it is replacing all the server names with our "prefix", but that doesn't explain the deletion of the group name *and* the article number in the second "(when (re-search-forward" below. Can someone explain what exactly this function is supposed to do? (save-restriction (narrow-to-region (point) (or (search-forward "\t" (point-at-eol) t) (point-at-eol))) (goto-char (point-min)) (when (re-search-forward "Xref: *[^\n:0-9 ]+ *" nil t) (replace-match "" t t)) (goto-char (point-min)) (when (re-search-forward (concat (regexp-quote (gnus-group-real-name group)) ":[0-9]+") nil t) (replace-match "" t t)) (unless (eobp) (insert " ") (when (not (string= "" prefix)) (while (re-search-forward "[^ ]+:[0-9]+" nil t) (save-excursion (goto-char (match-beginning 0)) (insert prefix)))))) ^ permalink raw reply [flat|nested] 29+ messages in thread
* bug#38011: 27.0.50; [PATCH] WIP on allowing Gnus backends to return header data directly 2020-03-29 19:50 ` Eric Abrahamsen @ 2020-04-30 4:50 ` Lars Ingebrigtsen 2020-09-27 4:13 ` Eric Abrahamsen 0 siblings, 1 reply; 29+ messages in thread From: Lars Ingebrigtsen @ 2020-04-30 4:50 UTC (permalink / raw) To: Eric Abrahamsen; +Cc: 38011 Eric Abrahamsen <eric@ericabrahamsen.net> writes: > Can someone explain what exactly this function is supposed to do? Somebody should have written more comments when they wrote that... and, like, made it correct. It transforms this: 64007 Formatting labels used for URL buttons in Gnus articles Narendra Joshi <narendraj9@gmail.com> Sun, 19 Apr 2020 00:31:13 +0200 <mailman.633.1587249088.3066.help-gnu-emacs@gnu.org> <87eesk2zpq.fsf@gmail.com> 3614 14 Xref: reader01.eternal-september.org gnu.emacs.help:57603 Into this: 64007 Formatting labels used for URL buttons in Gnus articles Narendra Joshi <narendraj9@gmail.com> Sun, 19 Apr 2020 00:31:13 +0200 <mailman.633.1587249088.3066.help-gnu-emacs@gnu.org> <87eesk2zpq.fsf@gmail.com> 3614 14 Xref: marnie gnu.emacs.help:57603 01.eternal-september.org Which is wrong, of course -- the "01.eternal-september.org" thing shouldn't be there. Anyway, what it's supposed to do it rewrite Xref: reader01.eternal-september.org foo.bar:2523 gnu.emacs.help:57603 zot.bar:3242 to Xref: whatever gnu.emacs.help:57603 foo.bar:2523 zot.bar:3242 That is, put the group/article we're really selecting first in the Xref header, but leave the remaining as they were. This is because we need those to mark the article as read in those other groups, but we primarily need to know where this article really came from (the first entry). Feel free to adapt this to comments in the code. :-) And rewrite to be correct. I don't understand why it's doing all the regexp stuff (wrongly) in the first place -- it should just split the data into a list and then do its work... Perhaps it was marginally faster to do it this way? -- (domestic pets only, the antidote for overdose, milk.) bloggy blog: http://lars.ingebrigtsen.no ^ permalink raw reply [flat|nested] 29+ messages in thread
* bug#38011: 27.0.50; [PATCH] WIP on allowing Gnus backends to return header data directly 2020-04-30 4:50 ` Lars Ingebrigtsen @ 2020-09-27 4:13 ` Eric Abrahamsen 2020-09-27 12:16 ` Lars Ingebrigtsen 0 siblings, 1 reply; 29+ messages in thread From: Eric Abrahamsen @ 2020-09-27 4:13 UTC (permalink / raw) To: Lars Ingebrigtsen; +Cc: 38011 Lars Ingebrigtsen <larsi@gnus.org> writes: > Eric Abrahamsen <eric@ericabrahamsen.net> writes: > >> Can someone explain what exactly this function is supposed to do? > > Somebody should have written more comments when they wrote that... and, > like, made it correct. > > It transforms this: > > 64007 Formatting labels used for URL buttons in Gnus articles Narendra > Joshi <narendraj9@gmail.com> Sun, 19 Apr 2020 00:31:13 +0200 > <mailman.633.1587249088.3066.help-gnu-emacs@gnu.org> > <87eesk2zpq.fsf@gmail.com> 3614 14 Xref: > reader01.eternal-september.org gnu.emacs.help:57603 > > Into this: > > 64007 Formatting labels used for URL buttons in Gnus articles Narendra > Joshi <narendraj9@gmail.com> Sun, 19 Apr 2020 00:31:13 +0200 > <mailman.633.1587249088.3066.help-gnu-emacs@gnu.org> > <87eesk2zpq.fsf@gmail.com> 3614 14 Xref: marnie gnu.emacs.help:57603 > 01.eternal-september.org > > Which is wrong, of course -- the "01.eternal-september.org" thing > shouldn't be there. > > Anyway, what it's supposed to do it rewrite > > Xref: reader01.eternal-september.org foo.bar:2523 gnu.emacs.help:57603 zot.bar:3242 > > to > > Xref: whatever gnu.emacs.help:57603 foo.bar:2523 zot.bar:3242 > > That is, put the group/article we're really selecting first in the Xref > header, but leave the remaining as they were. This is because we need > those to mark the article as read in those other groups, but we > primarily need to know where this article really came from (the first > entry). Slowly, slowly, I'm getting this done. I'm still a bit confused here, though. The xref elements look like they're not supposed to have spaces in them, but the existing code does this: (insert "Xref: " sysname " " group ":") (princ article (current-buffer)) Which leaves a space between sysname and group. You say the existing xrefs should be left as they are, but the code adds "prefix" to them. Should this be added unconditionally? Here's the new version of the function, operating on a header struct. Does this look right to you? Thanks, Eric (defun nnvirtual-update-xref-header (header group prefix sysname) "Add xref to component GROUP to HEADER. Also add a server PREFIX any existing xref lines." (let ((bits (split-string (mail-header-xref header) nil t "[[:blank:]]")) (art-no (mail-header-number header))) (setq bits (mapcar (lambda (bit) (concat prefix bit)) bits)) (setf (mail-header-xref header) (mapconcat #'identity (cons (format "%s %s:%d" sysname group art-no) bits) " ")))) ^ permalink raw reply [flat|nested] 29+ messages in thread
* bug#38011: 27.0.50; [PATCH] WIP on allowing Gnus backends to return header data directly 2020-09-27 4:13 ` Eric Abrahamsen @ 2020-09-27 12:16 ` Lars Ingebrigtsen 2020-09-27 23:41 ` Eric Abrahamsen 0 siblings, 1 reply; 29+ messages in thread From: Lars Ingebrigtsen @ 2020-09-27 12:16 UTC (permalink / raw) To: Eric Abrahamsen; +Cc: 38011 Eric Abrahamsen <eric@ericabrahamsen.net> writes: >> Xref: reader01.eternal-september.org foo.bar:2523 gnu.emacs.help:57603 zot.bar:3242 [...] > Slowly, slowly, I'm getting this done. I'm still a bit confused here, > though. The xref elements look like they're not supposed to have spaces > in them, but the existing code does this: > > (insert "Xref: " sysname " " group ":") > (princ article (current-buffer)) > > Which leaves a space between sysname and group. I'm not quite sure I understand the question? The sysname is just a part of the syntax of the Xref header and isn't used for anything by Gnus, as far as I know. So there has to be a space? It's certainly not part of the group name. > You say the existing xrefs should be left as they are, but the code adds > "prefix" to them. Should this be added unconditionally? Uhm... I think so? But I'm not sure. > Here's the new version of the function, operating on a header struct. > Does this look right to you? > > Thanks, > Eric > > (defun nnvirtual-update-xref-header (header group prefix sysname) > "Add xref to component GROUP to HEADER. > Also add a server PREFIX any existing xref lines." > (let ((bits (split-string (mail-header-xref header) > nil t "[[:blank:]]")) > (art-no (mail-header-number header))) > (setq bits > (mapcar (lambda (bit) > (concat prefix bit)) > bits)) > (setf (mail-header-xref header) > (mapconcat #'identity > (cons (format "%s %s:%d" > sysname group art-no) > bits) > " ")))) I think so. The body of the let form is perhaps more easily expressed as (setf (mail-header-xref header) (concat (format "%s %s:%d " sysname group art-no) (mapconcat (lambda (bit) (concat prefix bit)) bits " "))) ? -- (domestic pets only, the antidote for overdose, milk.) bloggy blog: http://lars.ingebrigtsen.no ^ permalink raw reply [flat|nested] 29+ messages in thread
* bug#38011: 27.0.50; [PATCH] WIP on allowing Gnus backends to return header data directly 2020-09-27 12:16 ` Lars Ingebrigtsen @ 2020-09-27 23:41 ` Eric Abrahamsen 2021-01-02 3:18 ` Eric Abrahamsen 0 siblings, 1 reply; 29+ messages in thread From: Eric Abrahamsen @ 2020-09-27 23:41 UTC (permalink / raw) To: Lars Ingebrigtsen; +Cc: 38011 [-- Attachment #1: Type: text/plain, Size: 2364 bytes --] Lars Ingebrigtsen <larsi@gnus.org> writes: > Eric Abrahamsen <eric@ericabrahamsen.net> writes: > >>> Xref: reader01.eternal-september.org foo.bar:2523 gnu.emacs.help:57603 zot.bar:3242 > > [...] > >> Slowly, slowly, I'm getting this done. I'm still a bit confused here, >> though. The xref elements look like they're not supposed to have spaces >> in them, but the existing code does this: >> >> (insert "Xref: " sysname " " group ":") >> (princ article (current-buffer)) >> >> Which leaves a space between sysname and group. > > I'm not quite sure I understand the question? The sysname is just a > part of the syntax of the Xref header and isn't used for anything by > Gnus, as far as I know. So there has to be a space? It's certainly not > part of the group name. TBH I only just went and read the RFC for this -- something I'd been trying to avoid! >> You say the existing xrefs should be left as they are, but the code adds >> "prefix" to them. Should this be added unconditionally? > > Uhm... I think so? But I'm not sure. Looking over the code again, I think it's best to only add if the prefix isn't already there. >> Here's the new version of the function, operating on a header struct. >> Does this look right to you? >> >> Thanks, >> Eric >> >> (defun nnvirtual-update-xref-header (header group prefix sysname) >> "Add xref to component GROUP to HEADER. >> Also add a server PREFIX any existing xref lines." >> (let ((bits (split-string (mail-header-xref header) >> nil t "[[:blank:]]")) >> (art-no (mail-header-number header))) >> (setq bits >> (mapcar (lambda (bit) >> (concat prefix bit)) >> bits)) >> (setf (mail-header-xref header) >> (mapconcat #'identity >> (cons (format "%s %s:%d" >> sysname group art-no) >> bits) >> " ")))) > > I think so. The body of the let form is perhaps more easily expressed > as > > (setf (mail-header-xref header) > (concat (format "%s %s:%d " sysname group art-no) > (mapconcat (lambda (bit) > (concat prefix bit)) > bits " "))) > > ? Sure, this was just my halfway-there muddle. I've cleaned this branch, squashed it, and am preparing to test for a while. I'm attaching the full diff in case anyone wants to read it :) A net removal of 562 lines with, I hope, no change in behavior. [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0001-Allow-gnus-retrieve-headers-to-return-headers-direct.patch --] [-- Type: text/x-patch, Size: 47744 bytes --] From d770ff468bb6b4a12a4219d8456b8a35ebb5ab44 Mon Sep 17 00:00:00 2001 From: Eric Abrahamsen <eric@ericabrahamsen.net> Date: Tue, 17 Mar 2020 20:53:05 -0700 Subject: [PATCH] Allow gnus-retrieve-headers to return headers directly --- lisp/gnus/gnus-agent.el | 462 ++++++++++++++++------------------------ lisp/gnus/gnus-async.el | 9 +- lisp/gnus/gnus-cache.el | 127 +++-------- lisp/gnus/gnus-cloud.el | 14 +- lisp/gnus/gnus-sum.el | 65 ++++-- lisp/gnus/gnus.el | 9 +- lisp/gnus/nnir.el | 1 - lisp/gnus/nnvirtual.el | 176 +++++---------- 8 files changed, 329 insertions(+), 534 deletions(-) diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el index f748996acc..4f8caf9278 100644 --- a/lisp/gnus/gnus-agent.el +++ b/lisp/gnus/gnus-agent.el @@ -1789,6 +1789,7 @@ gnus-agent-find-parameter . gnus-agent-enable-expiration) (agent-predicate . gnus-agent-predicate))))))) +;; FIXME: This looks an awful lot like `gnus-agent-retrieve-headers'. (defun gnus-agent-fetch-headers (group) "Fetch interesting headers into the agent. The group's overview file will be updated to include the headers while a list of available @@ -1810,10 +1811,11 @@ gnus-agent-fetch-headers (cdr active)))) (gnus-uncompress-range (gnus-active group))) (gnus-list-of-unread-articles group))) - (gnus-decode-encoded-word-function 'identity) - (gnus-decode-encoded-address-function 'identity) + (gnus-decode-encoded-word-function #'identity) + (gnus-decode-encoded-address-function #'identity) (file (gnus-agent-article-name ".overview" group)) - (file-name-coding-system nnmail-pathname-coding-system)) + (file-name-coding-system nnmail-pathname-coding-system) + headers fetched-headers) (unless fetch-all ;; Add articles with marks to the list of article headers we want to @@ -1824,7 +1826,7 @@ gnus-agent-fetch-headers (dolist (arts (gnus-info-marks (gnus-get-info group))) (unless (memq (car arts) '(seen recent killed cache)) (setq articles (gnus-range-add articles (cdr arts))))) - (setq articles (sort (gnus-uncompress-sequence articles) '<))) + (setq articles (sort (gnus-uncompress-range articles) '<))) ;; At this point, I have the list of articles to consider for ;; fetching. This is the list that I'll return to my caller. Some @@ -1867,38 +1869,46 @@ gnus-agent-fetch-headers 10 "gnus-agent-fetch-headers: undownloaded articles are `%s'" (gnus-compress-sequence articles t))) - (with-current-buffer nntp-server-buffer - (if articles - (progn - (gnus-message 8 "Fetching headers for %s..." group) - - ;; Fetch them. - (gnus-make-directory (nnheader-translate-file-chars - (file-name-directory file) t)) - - (unless (eq 'nov (gnus-retrieve-headers articles group)) - (nnvirtual-convert-headers)) - (gnus-agent-check-overview-buffer) - ;; Move these headers to the overview buffer so that - ;; gnus-agent-braid-nov can merge them with the contents - ;; of FILE. - (copy-to-buffer - gnus-agent-overview-buffer (point-min) (point-max)) - ;; NOTE: Call g-a-brand-nov even when the file does not - ;; exist. As a minimum, it will validate the article - ;; numbers already in the buffer. - (gnus-agent-braid-nov articles file) - (let ((coding-system-for-write - gnus-agent-file-coding-system)) - (gnus-agent-check-overview-buffer) - (write-region (point-min) (point-max) file nil 'silent)) - (gnus-agent-update-view-total-fetched-for group t) - (gnus-agent-save-alist group articles nil) - articles) - (ignore-errors - (erase-buffer) - (nnheader-insert-file-contents file))))) - articles)) + ;; Parse known headers from FILE. + (if (file-exists-p file) + (with-current-buffer gnus-agent-overview-buffer + (erase-buffer) + (let ((nnheader-file-coding-system + gnus-agent-file-coding-system)) + (nnheader-insert-nov-file file (car articles)) + (while (not (eobp)) + (push (nnheader-parse-nov) headers) + (forward-line 1)) + (setq headers (nreverse headers)))) + (gnus-make-directory (nnheader-translate-file-chars + (file-name-directory file) t))) + + ;; Fetch our new headers. + (gnus-message 8 "Fetching headers for %s..." group) + (if articles + (setq fetched-headers (gnus-fetch-headers articles))) + + ;; Merge two sets of headers. + (setq headers + (if (and headers fetched-headers) + (delete-dups + (sort (append headers fetched-headers) + (lambda (l r) + (< (mail-header-number l) + (mail-header-number r))))) + (or headers fetched-headers))) + + ;; Save the new set of headers to FILE. + (let ((coding-system-for-write + gnus-agent-file-coding-system)) + (with-current-buffer gnus-agent-overview-buffer + (erase-buffer) + (mapc #'nnheader-insert-nov headers) + (gnus-agent-check-overview-buffer) + (write-region (point-min) (point-max) file nil 'silent))) + (gnus-agent-update-view-total-fetched-for group t) + (gnus-agent-save-alist group articles nil)) + headers)) (defsubst gnus-agent-read-article-number () "Reads the article number at point. Returns nil when a valid article number can not be read." @@ -1923,96 +1933,6 @@ gnus-agent-copy-nov-line (set-buffer nntp-server-buffer) (insert-buffer-substring gnus-agent-overview-buffer b e)))) -(defun gnus-agent-braid-nov (articles file) - "Merge agent overview data with given file. -Takes unvalidated headers for ARTICLES from -`gnus-agent-overview-buffer' and validated headers from the given -FILE and places the combined valid headers into -`nntp-server-buffer'. This function can be used, when file -doesn't exist, to valid the overview buffer." - (let (start last) - (set-buffer gnus-agent-overview-buffer) - (goto-char (point-min)) - (set-buffer nntp-server-buffer) - (erase-buffer) - (when (file-exists-p file) - (nnheader-insert-file-contents file)) - (goto-char (point-max)) - (forward-line -1) - - (unless (or (= (point-min) (point-max)) - (< (setq last (read (current-buffer))) (car articles))) - ;; Old and new overlap -- We do it the hard way. - (when (nnheader-find-nov-line (car articles)) - ;; Replacing existing NOV entry - (delete-region (point) (progn (forward-line 1) (point)))) - (gnus-agent-copy-nov-line (pop articles)) - - (ignore-errors - (while articles - (while (let ((art (read (current-buffer)))) - (cond ((< art (car articles)) - (forward-line 1) - t) - ((= art (car articles)) - (beginning-of-line) - (delete-region - (point) (progn (forward-line 1) (point))) - nil) - (t - (beginning-of-line) - nil)))) - - (gnus-agent-copy-nov-line (pop articles))))) - - (goto-char (point-max)) - - ;; Append the remaining lines - (when articles - (when last - (set-buffer gnus-agent-overview-buffer) - (setq start (point)) - (set-buffer nntp-server-buffer)) - - (let ((p (point))) - (insert-buffer-substring gnus-agent-overview-buffer start) - (goto-char p)) - - (setq last (or last -134217728)) - (while (catch 'problems - (let (sort art) - (while (not (eobp)) - (setq art (gnus-agent-read-article-number)) - (cond ((not art) - ;; Bad art num - delete this line - (beginning-of-line) - (delete-region (point) (progn (forward-line 1) (point)))) - ((< art last) - ;; Art num out of order - enable sort - (setq sort t) - (forward-line 1)) - ((= art last) - ;; Bad repeat of art number - delete this line - (beginning-of-line) - (delete-region (point) (progn (forward-line 1) (point)))) - (t - ;; Good art num - (setq last art) - (forward-line 1)))) - (when sort - ;; something is seriously wrong as we simply shouldn't see out-of-order data. - ;; First, we'll fix the sort. - (sort-numeric-fields 1 (point-min) (point-max)) - - ;; but now we have to consider that we may have duplicate rows... - ;; so reset to beginning of file - (goto-char (point-min)) - (setq last -134217728) - - ;; and throw a code that restarts this scan - (throw 'problems t)) - nil)))))) - ;; Keeps the compiler from warning about the free variable in ;; gnus-agent-read-agentview. (defvar gnus-agent-read-agentview) @@ -2385,10 +2305,9 @@ gnus-agent-fetch-group-1 (gnus-orphan-score gnus-orphan-score) ;; Maybe some other gnus-summary local variables should also ;; be put here. - + fetched-headers gnus-headers gnus-score - articles predicate info marks ) (unless (gnus-check-group group) @@ -2409,47 +2328,44 @@ gnus-agent-fetch-group-1 (setq info (gnus-get-info group))))))) (when arts (setq marked-articles (nconc (gnus-uncompress-range arts) - marked-articles)) - )))) + marked-articles)))))) (setq marked-articles (sort marked-articles '<)) - ;; Fetch any new articles from the server - (setq articles (gnus-agent-fetch-headers group)) + (setq gnus-newsgroup-dependencies + (or gnus-newsgroup-dependencies + (gnus-make-hashtable))) - ;; Merge new articles with marked - (setq articles (sort (append marked-articles articles) '<)) + ;; Fetch headers for any new articles from the server. + (setq fetched-headers (gnus-agent-fetch-headers group)) - (when articles - ;; Parse them and see which articles we want to fetch. - (setq gnus-newsgroup-dependencies - (or gnus-newsgroup-dependencies - (gnus-make-hashtable (length articles)))) + (when fetched-headers (setq gnus-newsgroup-headers - (or gnus-newsgroup-headers - (gnus-get-newsgroup-headers-xover articles nil nil - group))) - ;; `gnus-agent-overview-buffer' may be killed for - ;; timeout reason. If so, recreate it. + (or gnus-newsgroup-headers + fetched-headers))) + (when marked-articles + ;; `gnus-agent-overview-buffer' may be killed for timeout + ;; reason. If so, recreate it. (gnus-agent-create-buffer) (setq predicate - (gnus-get-predicate - (gnus-agent-find-parameter group 'agent-predicate))) + (gnus-get-predicate + (gnus-agent-find-parameter group 'agent-predicate))) + + ;; If the selection predicate requires scoring, score each header. - ;; If the selection predicate requires scoring, score each header (unless (memq predicate '(gnus-agent-true gnus-agent-false)) (let ((score-param (gnus-agent-find-parameter group 'agent-score-file))) - ;; Translate score-param into real one + ;; Translate score-param into real one. (cond ((not score-param)) ((eq score-param 'file) - (setq score-param (gnus-all-score-files group))) + (setq score-param (gnus-all-score-files group))) ((stringp (car score-param))) (t - (setq score-param (list (list score-param))))) + (setq score-param (list (list score-param))))) (when score-param - (gnus-score-headers score-param)))) + (gnus-score-headers score-param)))) (unless (and (eq predicate 'gnus-agent-false) (not marked-articles)) @@ -2458,50 +2374,50 @@ gnus-agent-fetch-group-1 (alist (gnus-agent-load-alist group)) (marked-articles marked-articles) (gnus-newsgroup-headers gnus-newsgroup-headers)) - (while (setq gnus-headers (pop gnus-newsgroup-headers)) + (while (setq gnus-headers (pop gnus-newsgroup-headers)) (let ((num (mail-header-number gnus-headers))) ;; Determine if this article is already in the cache (while (and alist - (> num (caar alist))) + (> num (caar alist))) (setq alist (cdr alist))) (unless (and (eq num (caar alist)) - (cdar alist)) + (cdar alist)) ;; Determine if this article was marked for download. (while (and marked-articles (> num (car marked-articles))) - (setq marked-articles + (setq marked-articles (cdr marked-articles))) ;; When this article is marked, or selected by the ;; predicate, add it to the download list (when (or (eq num (car marked-articles)) - (let ((gnus-score + (let ((gnus-score (or (cdr (assq num gnus-newsgroup-scored)) gnus-summary-default-score)) (gnus-agent-long-article (gnus-agent-find-parameter - group 'agent-long-article)) + group 'agent-long-article)) (gnus-agent-short-article (gnus-agent-find-parameter - group 'agent-short-article)) + group 'agent-short-article)) (gnus-agent-low-score (gnus-agent-find-parameter - group 'agent-low-score)) + group 'agent-low-score)) (gnus-agent-high-score (gnus-agent-find-parameter - group 'agent-high-score)) + group 'agent-high-score)) (gnus-agent-expire-days (gnus-agent-find-parameter - group 'agent-days-until-old))) + group 'agent-days-until-old))) (funcall predicate))) - (gnus-agent-append-to-list arts-tail num)))))) + (gnus-agent-append-to-list arts-tail num)))))) (let (fetched-articles) - ;; Fetch all selected articles - (setq gnus-newsgroup-undownloaded + ;; Fetch all selected articles + (setq gnus-newsgroup-undownloaded (gnus-sorted-ndifference gnus-newsgroup-undownloaded (setq fetched-articles @@ -2509,14 +2425,14 @@ gnus-agent-fetch-group-1 (gnus-agent-fetch-articles group (cdr arts)) nil)))) - (let ((unfetched-articles + (let ((unfetched-articles (gnus-sorted-ndifference (cdr arts) fetched-articles))) (if gnus-newsgroup-active ;; Update the summary buffer (progn - (dolist (article marked-articles) + (dolist (article marked-articles) (gnus-summary-set-agent-mark article t)) - (dolist (article fetched-articles) + (dolist (article fetched-articles) (when gnus-agent-mark-unread-after-downloaded (setq gnus-newsgroup-downloadable (delq article gnus-newsgroup-downloadable)) @@ -2524,7 +2440,7 @@ gnus-agent-fetch-group-1 article gnus-unread-mark)) (when (gnus-summary-goto-subject article nil t) (gnus-summary-update-download-mark article))) - (dolist (article unfetched-articles) + (dolist (article unfetched-articles) (gnus-summary-mark-article article gnus-canceled-mark))) @@ -2537,7 +2453,7 @@ gnus-agent-fetch-group-1 (dolist (mark gnus-agent-download-marks) (when (eq mark 'download) - (let ((marked-arts + (let ((marked-arts (assq mark (gnus-info-marks (setq info (gnus-get-info group)))))) (when (cdr marked-arts) @@ -3661,11 +3577,11 @@ gnus-agent-uncached-articles (defun gnus-agent-retrieve-headers (articles group &optional fetch-old) (save-excursion (gnus-agent-create-buffer) - (let ((gnus-decode-encoded-word-function 'identity) - (gnus-decode-encoded-address-function 'identity) + (let ((gnus-decode-encoded-word-function #'identity) + (gnus-decode-encoded-address-function #'identity) (file (gnus-agent-article-name ".overview" group)) - uncached-articles - (file-name-coding-system nnmail-pathname-coding-system)) + (file-name-coding-system nnmail-pathname-coding-system) + uncached-articles headers fetched-headers) (gnus-make-directory (nnheader-translate-file-chars (file-name-directory file) t)) @@ -3676,122 +3592,108 @@ gnus-agent-retrieve-headers 1) (car (last articles)))))) - ;; Populate temp buffer with known headers + ;; Parse known headers from FILE. (when (file-exists-p file) (with-current-buffer gnus-agent-overview-buffer (erase-buffer) (let ((nnheader-file-coding-system gnus-agent-file-coding-system)) - (nnheader-insert-nov-file file (car articles))))) + (nnheader-insert-nov-file file (car articles)) + (while (not (eobp)) + (push (nnheader-parse-nov) headers) + (forward-line 1)) + (setq headers (nreverse headers))))) + + (when (setq uncached-articles (gnus-agent-uncached-articles + articles group t)) + (let ((gnus-newsgroup-name group) + gnus-agent) ; Prevent loop. + (when (eq 'nntp (car gnus-current-select-method)) + ;; The author of gnus-get-newsgroup-headers-xover + ;; reports that the XOVER command is commonly + ;; unreliable. The problem is that recently + ;; posted articles may not be entered into the + ;; NOV database in time to respond to my XOVER + ;; query. + ;; + ;; I'm going to use his assumption that the NOV + ;; database is updated in order of ascending + ;; article ID. Therefore, a response containing + ;; article ID N implies that all articles from 1 + ;; to N-1 are up-to-date. Therefore, missing + ;; articles in that range have expired. + + (let* ((fetched-articles + (mapcar #'mail-header-number headers)) + (min (car articles)) + (max (car (last articles)))) + + ;; Clip the list of fetched articles to the headers that + ;; will actually be returned + (setq fetched-articles (gnus-list-range-intersection + fetched-articles + (cons min max))) + + ;; Clip the uncached articles list to exclude + ;; IDs after the last FETCHED header. The + ;; excluded IDs may be fetchable using HEAD. + (when (car (last fetched-articles)) + (setq uncached-articles + (gnus-list-range-intersection + uncached-articles + (cons (car uncached-articles) + (car (last fetched-articles)))))) + + ;; Create the list of articles that were + ;; "successfully" fetched. Success, in this + ;; case, means that the ID should not be + ;; fetched again. In the case of an expired + ;; article, the header will not be fetched. + (setq uncached-articles + (gnus-sorted-nunion fetched-articles + uncached-articles)))) + + ;; Fetch additional headers for the uncached articles. + (setq fetched-headers (gnus-fetch-headers uncached-articles)) + ;; Merge headers we got from `file' with our newly-fetched + ;; headers. We need to sort and delete dups; perhaps this + ;; could be done more efficiently, but for now just do it + ;; the dumb way. Assume that the headers from `file' are + ;; prior to the newly-fetched headers. + (when fetched-headers + (setq headers + (delete-dups + (sort (append headers fetched-headers) + (lambda (l r) + (< (mail-header-number l) + (mail-header-number r))))))) + + ;; Save the new set of known headers to FILE + (let ((coding-system-for-write + gnus-agent-file-coding-system)) + (with-current-buffer gnus-agent-overview-buffer + (erase-buffer) + (mapc #'nnheader-insert-nov headers) + (gnus-agent-check-overview-buffer) + (write-region (point-min) (point-max) file nil 'silent))) - (if (setq uncached-articles (gnus-agent-uncached-articles articles group - t)) - (progn - ;; Populate nntp-server-buffer with uncached headers - (set-buffer nntp-server-buffer) - (erase-buffer) - (cond ((not (eq 'nov (let (gnus-agent) ; Turn off agent - (gnus-retrieve-headers - uncached-articles group)))) - (nnvirtual-convert-headers)) - ((eq 'nntp (car gnus-current-select-method)) - ;; The author of gnus-get-newsgroup-headers-xover - ;; reports that the XOVER command is commonly - ;; unreliable. The problem is that recently - ;; posted articles may not be entered into the - ;; NOV database in time to respond to my XOVER - ;; query. - ;; - ;; I'm going to use his assumption that the NOV - ;; database is updated in order of ascending - ;; article ID. Therefore, a response containing - ;; article ID N implies that all articles from 1 - ;; to N-1 are up-to-date. Therefore, missing - ;; articles in that range have expired. - - (set-buffer nntp-server-buffer) - (let* ((fetched-articles (list nil)) - (tail-fetched-articles fetched-articles) - (min (car articles)) - (max (car (last articles)))) - - ;; Get the list of articles that were fetched - (goto-char (point-min)) - (let ((pm (point-max)) - art) - (while (< (point) pm) - (when (setq art (gnus-agent-read-article-number)) - (gnus-agent-append-to-list tail-fetched-articles art)) - (forward-line 1))) - - ;; Clip this list to the headers that will - ;; actually be returned - (setq fetched-articles (gnus-list-range-intersection - (cdr fetched-articles) - (cons min max))) - - ;; Clip the uncached articles list to exclude - ;; IDs after the last FETCHED header. The - ;; excluded IDs may be fetchable using HEAD. - (if (car tail-fetched-articles) - (setq uncached-articles - (gnus-list-range-intersection - uncached-articles - (cons (car uncached-articles) - (car tail-fetched-articles))))) - - ;; Create the list of articles that were - ;; "successfully" fetched. Success, in this - ;; case, means that the ID should not be - ;; fetched again. In the case of an expired - ;; article, the header will not be fetched. - (setq uncached-articles - (gnus-sorted-nunion fetched-articles - uncached-articles)) - ))) - - ;; Erase the temp buffer - (set-buffer gnus-agent-overview-buffer) - (erase-buffer) + (gnus-agent-update-view-total-fetched-for group t) - ;; Copy the nntp-server-buffer to the temp buffer - (set-buffer nntp-server-buffer) - (copy-to-buffer gnus-agent-overview-buffer (point-min) (point-max)) + ;; Update the group's article alist to include the newly + ;; fetched articles. + (gnus-agent-load-alist group) + (gnus-agent-save-alist group uncached-articles nil))) - ;; Merge the temp buffer with the known headers (found on - ;; disk in FILE) into the nntp-server-buffer - (when uncached-articles - (gnus-agent-braid-nov uncached-articles file)) + (unless (and fetch-old + (not (numberp fetch-old))) + ;; Drop headers that are not within the range of `articles'. + (setq headers (seq-remove + (lambda (h) + (or (< (mail-header-number h) (car articles)) + (> (mail-header-number h) (car (last articles))))) + headers))) - ;; Save the new set of known headers to FILE - (set-buffer nntp-server-buffer) - (let ((coding-system-for-write - gnus-agent-file-coding-system)) - (gnus-agent-check-overview-buffer) - (write-region (point-min) (point-max) file nil 'silent)) - - (gnus-agent-update-view-total-fetched-for group t) - - ;; Update the group's article alist to include the newly - ;; fetched articles. - (gnus-agent-load-alist group) - (gnus-agent-save-alist group uncached-articles nil) - ) - - ;; Copy the temp buffer to the nntp-server-buffer - (set-buffer nntp-server-buffer) - (erase-buffer) - (insert-buffer-substring gnus-agent-overview-buffer))) - - (if (and fetch-old - (not (numberp fetch-old))) - t ; Don't remove anything. - (nnheader-nov-delete-outside-range - (car articles) - (car (last articles))) - t) - - 'nov)) + headers))) (defun gnus-agent-request-article (article group) "Retrieve ARTICLE in GROUP from the agent cache." diff --git a/lisp/gnus/gnus-async.el b/lisp/gnus/gnus-async.el index 9bcb6c33a6..39b5e43837 100644 --- a/lisp/gnus/gnus-async.el +++ b/lisp/gnus/gnus-async.el @@ -350,8 +350,13 @@ gnus-async-prefetch-headers (let ((nntp-server-buffer (current-buffer)) (nnheader-callback-function (lambda (_arg) - (setq gnus-async-header-prefetched - (cons group unread))))) + (setq gnus-async-header-prefetched + (cons group unread))))) + ;; FIXME: If header prefetch is ever put into use, we'll + ;; have to handle the possibility that + ;; `gnus-retrieve-headers' might return a list of header + ;; vectors directly, rather than writing them into the + ;; current buffer. (gnus-retrieve-headers unread group gnus-fetch-old-headers)))))) (defun gnus-async-retrieve-fetched-headers (articles group) diff --git a/lisp/gnus/gnus-cache.el b/lisp/gnus/gnus-cache.el index c31d97d41c..483ee06296 100644 --- a/lisp/gnus/gnus-cache.el +++ b/lisp/gnus/gnus-cache.el @@ -294,49 +294,46 @@ gnus-cache-possibly-alter-active (defun gnus-cache-retrieve-headers (articles group &optional fetch-old) "Retrieve the headers for ARTICLES in GROUP." (let ((cached - (setq gnus-newsgroup-cached (gnus-cache-articles-in-group group)))) + (setq gnus-newsgroup-cached (gnus-cache-articles-in-group group))) + (gnus-newsgroup-name group) + (gnus-fetch-old-headers fetch-old)) (if (not cached) ;; No cached articles here, so we just retrieve them ;; the normal way. (let ((gnus-use-cache nil)) - (gnus-retrieve-headers articles group fetch-old)) + (gnus-fetch-headers articles group)) (let ((uncached-articles (gnus-sorted-difference articles cached)) (cache-file (gnus-cache-file-name group ".overview")) - type - (file-name-coding-system nnmail-pathname-coding-system)) + (file-name-coding-system nnmail-pathname-coding-system) + headers) ;; We first retrieve all the headers that we don't have in ;; the cache. (let ((gnus-use-cache nil)) (when uncached-articles - (setq type (and articles - (gnus-retrieve-headers - uncached-articles group fetch-old))))) - (gnus-cache-save-buffers) - ;; Then we insert the cached headers. - (save-excursion - (cond - ((not (file-exists-p cache-file)) - ;; There are no cached headers. - type) - ((null type) - ;; There were no uncached headers (or retrieval was - ;; unsuccessful), so we use the cached headers exclusively. - (set-buffer nntp-server-buffer) - (erase-buffer) - (let ((coding-system-for-read - gnus-cache-overview-coding-system)) - (insert-file-contents cache-file)) - 'nov) - ((eq type 'nov) - ;; We have both cached and uncached NOV headers, so we - ;; braid them. - (gnus-cache-braid-nov group cached) - type) - (t - ;; We braid HEADs. - (gnus-cache-braid-heads group (gnus-sorted-intersection - cached articles)) - type))))))) + (setq headers (and articles + (gnus-fetch-headers uncached-articles))))) + (when headers + (with-current-buffer (cdr gnus-cache-buffer) + (goto-char (point-min)) + (mapc #'nnheader-insert-nov headers) + (gnus-cache-save-buffers))) + ;; Then we include the cached headers. + (when (file-exists-p cache-file) + (setq headers + (delete-dups + (sort + (append headers + (let ((coding-system-for-read + gnus-cache-overview-coding-system) + (gnus-read-all-available-headers t)) + (set-buffer nntp-server-buffer) + (erase-buffer) + (insert-file-contents cache-file) + (gnus-get-newsgroup-headers-xover nil))) + (lambda (l r) + (< (mail-header-number l) + (mail-header-number r))))))) + headers)))) (defun gnus-cache-enter-article (&optional n) "Enter the next N articles into the cache. @@ -529,70 +526,6 @@ gnus-cache-articles-in-group (setq gnus-cache-active-altered t))) articles))) -(defun gnus-cache-braid-nov (group cached &optional file) - (let ((cache-buf (gnus-get-buffer-create " *gnus-cache*")) - beg end) - (gnus-cache-save-buffers) - (with-current-buffer cache-buf - (erase-buffer) - (let ((coding-system-for-read gnus-cache-overview-coding-system) - (file-name-coding-system nnmail-pathname-coding-system)) - (insert-file-contents - (or file (gnus-cache-file-name group ".overview")))) - (goto-char (point-min)) - (insert "\n") - (goto-char (point-min))) - (set-buffer nntp-server-buffer) - (goto-char (point-min)) - (while cached - (while (and (not (eobp)) - (< (read (current-buffer)) (car cached))) - (forward-line 1)) - (beginning-of-line) - (set-buffer cache-buf) - (if (search-forward (concat "\n" (int-to-string (car cached)) "\t") - nil t) - (setq beg (point-at-bol) - end (progn (end-of-line) (point))) - (setq beg nil)) - (set-buffer nntp-server-buffer) - (when beg - (insert-buffer-substring cache-buf beg end) - (insert "\n")) - (setq cached (cdr cached))) - (kill-buffer cache-buf))) - -(defun gnus-cache-braid-heads (group cached) - (let ((cache-buf (gnus-get-buffer-create " *gnus-cache*"))) - (with-current-buffer cache-buf - (erase-buffer)) - (set-buffer nntp-server-buffer) - (goto-char (point-min)) - (dolist (entry cached) - (while (and (not (eobp)) - (looking-at "2.. +\\([0-9]+\\) ") - (< (progn (goto-char (match-beginning 1)) - (read (current-buffer))) - entry)) - (search-forward "\n.\n" nil 'move)) - (beginning-of-line) - (set-buffer cache-buf) - (erase-buffer) - (let ((coding-system-for-read gnus-cache-coding-system) - (file-name-coding-system nnmail-pathname-coding-system)) - (insert-file-contents (gnus-cache-file-name group entry))) - (goto-char (point-min)) - (insert "220 ") - (princ (pop cached) (current-buffer)) - (insert " Article retrieved.\n") - (search-forward "\n\n" nil 'move) - (delete-region (point) (point-max)) - (forward-char -1) - (insert ".") - (set-buffer nntp-server-buffer) - (insert-buffer-substring cache-buf)) - (kill-buffer cache-buf))) - ;;;###autoload (defun gnus-jog-cache () "Go through all groups and put the articles into the cache. diff --git a/lisp/gnus/gnus-cloud.el b/lisp/gnus/gnus-cloud.el index 3e23e26326..92677029b9 100644 --- a/lisp/gnus/gnus-cloud.el +++ b/lisp/gnus/gnus-cloud.el @@ -30,6 +30,8 @@ (require 'parse-time) (require 'nnimap) +(declare-function gnus-fetch-headers "gnus-sum") +(defvar gnus-alter-header-function) (eval-when-compile (require 'epg)) ;; setf-method for `epg-context-armor' (autoload 'epg-make-context "epg") @@ -407,14 +409,10 @@ gnus-cloud-available-chunks (gnus-activate-group gnus-cloud-group-name nil nil gnus-cloud-method) (let* ((group (gnus-group-full-name gnus-cloud-group-name gnus-cloud-method)) (active (gnus-active group)) - headers head) - (when (gnus-retrieve-headers (gnus-uncompress-range active) group) - (with-current-buffer nntp-server-buffer - (goto-char (point-min)) - (while (setq head (nnheader-parse-head)) - (when gnus-alter-header-function - (funcall gnus-alter-header-function head)) - (push head headers)))) + (gnus-newsgroup-name group) + (headers (gnus-fetch-headers (gnus-uncompress-range active)))) + (when gnus-alter-header-function + (mapc #'gnus-alter-header-function headers)) (sort (nreverse headers) (lambda (h1 h2) (> (gnus-cloud-chunk-sequence (mail-header-subject h1)) diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index b3ed5cb664..629692eb26 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -4548,6 +4548,11 @@ gnus-nov-parse-line (forward-char)) (setq header (nnheader-parse-nov number)) (widen)) + ;; (when (and (string= references "") + ;; (setq in-reply-to (mail-header-extra header)) + ;; (setq in-reply-to (cdr (assq 'In-Reply-To in-reply-to)))) + ;; (setf (mail-header-references header) + ;; (gnus-extract-message-id-from-in-reply-to in-reply-to))) (when gnus-alter-header-function (funcall gnus-alter-header-function header)) (gnus-dependencies-add-header header dependencies force-new))) @@ -5616,10 +5621,21 @@ 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 - (pcase (setq gnus-headers-retrieved-by + (let ((res (setq gnus-headers-retrieved-by (gnus-retrieve-headers articles gnus-newsgroup-name (or limit @@ -5629,22 +5645,29 @@ gnus-fetch-headers (not (eq gnus-fetch-old-headers 'some)) (not (numberp gnus-fetch-old-headers))) (> (length articles) 1)) - gnus-fetch-old-headers)))) - ('nov - (gnus-get-newsgroup-headers-xover - articles force-new dependencies gnus-newsgroup-name t)) - ('headers - (gnus-get-newsgroup-headers dependencies force-new)) - ((pred listp) - (let ((dependencies - (or dependencies - (with-current-buffer gnus-summary-buffer - gnus-newsgroup-dependencies)))) - (delq nil (mapcar #'(lambda (header) - (gnus-dependencies-add-header - header dependencies force-new)) - gnus-headers-retrieved-by))))) - (gnus-message 7 "Fetching headers for %s...done" gnus-newsgroup-name))) + 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) + (let ((dependencies + (or dependencies + (buffer-local-value + gnus-newsgroup-dependencies gnus-summary-buffer)))) + (when (functionp gnus-alter-header-function) + (mapc gnus-alter-header-function res)) + (delq nil (mapcar (lambda (header) + (gnus-dependencies-add-header + header dependencies force-new)) + res)))) + (_ (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. @@ -6399,6 +6422,10 @@ gnus-group-make-articles-read (unless (gnus-ephemeral-group-p group) (gnus-group-update-group group t)))))) +;; FIXME: Refactor this with `gnus-get-newsgroup-headers-xover' and +;; extract the necessary bits for the direct-header-return case. Also +;; look at this and see how similar it is to +;; `nnheader-parse-naked-head'. (defun gnus-get-newsgroup-headers (&optional dependencies force-new) (let ((dependencies (or dependencies diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index cb534260a6..dc4f780245 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -2384,7 +2384,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 20f82e5cbd..c0fb865d51 100644 --- a/lisp/gnus/nnir.el +++ b/lisp/gnus/nnir.el @@ -503,7 +503,6 @@ nnir-method-default-engines ,@(mapcar (lambda (elem) (list 'const (car elem))) nnir-engines))))) - (defmacro nnir-add-result (dirnam artno score prefix server artlist) "Construct a result vector and add it to ARTLIST. DIRNAM, ARTNO, SCORE, PREFIX and SERVER are passed to diff --git a/lisp/gnus/nnvirtual.el b/lisp/gnus/nnvirtual.el index 54c2f7be82..10e8be7f2d 100644 --- a/lisp/gnus/nnvirtual.el +++ b/lisp/gnus/nnvirtual.el @@ -96,15 +96,10 @@ nnvirtual-retrieve-headers (erase-buffer) (if (stringp (car articles)) 'headers - (let ((vbuf (nnheader-set-temp-buffer - (gnus-get-buffer-create " *virtual headers*"))) - (carticles (nnvirtual-partition-sequence articles)) + (let ((carticles (nnvirtual-partition-sequence articles)) (sysname (system-name)) - cgroup carticle article result prefix) - (while carticles - (setq cgroup (caar carticles)) - (setq articles (cdar carticles)) - (pop carticles) + cgroup headers all-headers article prefix) + (pcase-dolist (`(,cgroup . ,articles) carticles) (when (and articles (gnus-check-server (gnus-find-method-for-group cgroup) t) @@ -114,69 +109,37 @@ nnvirtual-retrieve-headers ;; This is probably evil if people have set ;; gnus-use-cache to nil themselves, but I ;; have no way of finding the true value of it. - (let ((gnus-use-cache t)) - (setq result (gnus-retrieve-headers - articles cgroup nil)))) - (set-buffer nntp-server-buffer) - ;; If we got HEAD headers, we convert them into NOV - ;; headers. This is slow, inefficient and, come to think - ;; of it, downright evil. So sue me. I couldn't be - ;; bothered to write a header parse routine that could - ;; parse a mixed HEAD/NOV buffer. - (when (eq result 'headers) - (nnvirtual-convert-headers)) - (goto-char (point-min)) - (while (not (eobp)) - (delete-region (point) - (progn - (setq carticle (read nntp-server-buffer)) - (point))) - - ;; We remove this article from the articles list, if - ;; anything is left in the articles list after going through - ;; the entire buffer, then those articles have been - ;; expired or canceled, so we appropriately update the - ;; component group below. They should be coming up - ;; generally in order, so this shouldn't be slow. - (setq articles (delq carticle articles)) - - (setq article (nnvirtual-reverse-map-article cgroup carticle)) - (if (null article) - ;; This line has no reverse mapping, that means it - ;; was an extra article reference returned by nntp. - (progn - (beginning-of-line) - (delete-region (point) (progn (forward-line 1) (point)))) - ;; Otherwise insert the virtual article number, - ;; and clean up the xrefs. - (princ article nntp-server-buffer) - (nnvirtual-update-xref-header cgroup carticle - prefix sysname) - (forward-line 1)) - ) - - (set-buffer vbuf) - (goto-char (point-max)) - (insert-buffer-substring nntp-server-buffer)) - ;; Anything left in articles is expired or canceled. - ;; Could be smart and not tell it about articles already known? - (when articles - (gnus-group-make-articles-read cgroup articles)) - ) - - ;; The headers are ready for reading, so they are inserted into - ;; the nntp-server-buffer, which is where Gnus expects to find - ;; them. - (prog1 - (with-current-buffer nntp-server-buffer - (erase-buffer) - (insert-buffer-substring vbuf) - ;; FIX FIX FIX, we should be able to sort faster than - ;; this if needed, since each cgroup is sorted, we just - ;; need to merge - (sort-numeric-fields 1 (point-min) (point-max)) - 'nov) - (kill-buffer vbuf))))))) + (let ((gnus-use-cache t) + (gnus-newsgroup-name cgroup) + (gnus-fetch-old-headers nil)) + (setq headers (gnus-fetch-headers articles)))) + (erase-buffer) + ;; Remove all header article numbers from `articles'. + ;; If there's anything left, those are expired or + ;; canceled articles, so we update the component group + ;; below. + (dolist (h headers) + (setq articles (delq (mail-header-number h) articles) + article (nnvirtual-reverse-map-article + cgroup (mail-header-number h))) + ;; Update all the header numbers according to their + ;; reverse mapping, and drop any with no such mapping. + (when article + ;; Do this first, before we re-set the header's + ;; article number. + (nnvirtual-update-xref-header + h cgroup prefix sysname) + (setf (mail-header-number h) article) + (push h all-headers))) + ;; Anything left in articles is expired or canceled. + ;; Could be smart and not tell it about articles already + ;; known? + (when articles + (gnus-group-make-articles-read cgroup articles)))) + + (sort all-headers (lambda (h1 h2) + (< (mail-header-number h1) + (mail-header-number h2))))))))) (defvoo nnvirtual-last-accessed-component-group nil) @@ -367,61 +330,22 @@ nnvirtual-request-expire-articles \f ;;; Internal functions. -(defun nnvirtual-convert-headers () - "Convert HEAD headers into NOV headers." - (with-current-buffer nntp-server-buffer - (let* ((dependencies (make-hash-table :test #'equal)) - (headers (gnus-get-newsgroup-headers dependencies))) - (erase-buffer) - (mapc 'nnheader-insert-nov headers)))) - - -(defun nnvirtual-update-xref-header (group article prefix sysname) - "Edit current NOV header in current buffer to have an xref to the component group, and also server prefix any existing xref lines." - ;; Move to beginning of Xref field, creating a slot if needed. - (beginning-of-line) - (looking-at - "[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t") - (goto-char (match-end 0)) - (unless (search-forward "\t" (point-at-eol) 'move) - (insert "\t")) - - ;; Remove any spaces at the beginning of the Xref field. - (while (eq (char-after (1- (point))) ? ) - (forward-char -1) - (delete-char 1)) - - (insert "Xref: " sysname " " group ":") - (princ article (current-buffer)) - (insert " ") - - ;; If there were existing xref lines, clean them up to have the correct - ;; component server prefix. - (save-restriction - (narrow-to-region (point) - (or (search-forward "\t" (point-at-eol) t) - (point-at-eol))) - (goto-char (point-min)) - (when (re-search-forward "Xref: *[^\n:0-9 ]+ *" nil t) - (replace-match "" t t)) - (goto-char (point-min)) - (when (re-search-forward - (concat (regexp-quote (gnus-group-real-name group)) ":[0-9]+") - nil t) - (replace-match "" t t)) - (unless (eobp) - (insert " ") - (when (not (string= "" prefix)) - (while (re-search-forward "[^ ]+:[0-9]+" nil t) - (save-excursion - (goto-char (match-beginning 0)) - (insert prefix)))))) - - ;; Ensure a trailing \t. - (end-of-line) - (or (eq (char-after (1- (point))) ?\t) - (insert ?\t))) - +(defun nnvirtual-update-xref-header (header group prefix sysname) + "Add xref to component GROUP to HEADER. +Also add a server PREFIX any existing xref lines." + (let ((bits (split-string (mail-header-xref header) + nil t "[[:blank:]]")) + (art-no (mail-header-number header))) + (setf (mail-header-xref header) + (mapconcat #'identity + (cons (format "%s %s:%d" + sysname group art-no) + (mapcar (lambda (bit) + (if (string-prefix-p prefix bit) + bit + (concat prefix bit))) + bits)) + " ")))) (defun nnvirtual-possibly-change-server (server) (or (not server) -- 2.28.0 ^ permalink raw reply related [flat|nested] 29+ messages in thread
* bug#38011: 27.0.50; [PATCH] WIP on allowing Gnus backends to return header data directly 2020-09-27 23:41 ` Eric Abrahamsen @ 2021-01-02 3:18 ` Eric Abrahamsen 2021-01-02 5:59 ` Lars Ingebrigtsen 0 siblings, 1 reply; 29+ messages in thread From: Eric Abrahamsen @ 2021-01-02 3:18 UTC (permalink / raw) To: Lars Ingebrigtsen; +Cc: 38011 [-- Attachment #1: Type: text/plain, Size: 2740 bytes --] Eric Abrahamsen <eric@ericabrahamsen.net> writes: > Lars Ingebrigtsen <larsi@gnus.org> writes: > >> Eric Abrahamsen <eric@ericabrahamsen.net> writes: >> >>>> Xref: reader01.eternal-september.org foo.bar:2523 gnu.emacs.help:57603 zot.bar:3242 >> >> [...] >> >>> Slowly, slowly, I'm getting this done. I'm still a bit confused here, >>> though. The xref elements look like they're not supposed to have spaces >>> in them, but the existing code does this: >>> >>> (insert "Xref: " sysname " " group ":") >>> (princ article (current-buffer)) >>> >>> Which leaves a space between sysname and group. >> >> I'm not quite sure I understand the question? The sysname is just a >> part of the syntax of the Xref header and isn't used for anything by >> Gnus, as far as I know. So there has to be a space? It's certainly not >> part of the group name. > > TBH I only just went and read the RFC for this -- something I'd been > trying to avoid! > >>> You say the existing xrefs should be left as they are, but the code adds >>> "prefix" to them. Should this be added unconditionally? >> >> Uhm... I think so? But I'm not sure. > > Looking over the code again, I think it's best to only add if the prefix > isn't already there. > >>> Here's the new version of the function, operating on a header struct. >>> Does this look right to you? >>> >>> Thanks, >>> Eric >>> >>> (defun nnvirtual-update-xref-header (header group prefix sysname) >>> "Add xref to component GROUP to HEADER. >>> Also add a server PREFIX any existing xref lines." >>> (let ((bits (split-string (mail-header-xref header) >>> nil t "[[:blank:]]")) >>> (art-no (mail-header-number header))) >>> (setq bits >>> (mapcar (lambda (bit) >>> (concat prefix bit)) >>> bits)) >>> (setf (mail-header-xref header) >>> (mapconcat #'identity >>> (cons (format "%s %s:%d" >>> sysname group art-no) >>> bits) >>> " ")))) >> >> I think so. The body of the let form is perhaps more easily expressed >> as >> >> (setf (mail-header-xref header) >> (concat (format "%s %s:%d " sysname group art-no) >> (mapconcat (lambda (bit) >> (concat prefix bit)) >> bits " "))) >> >> ? > > Sure, this was just my halfway-there muddle. > > I've cleaned this branch, squashed it, and am preparing to test for a > while. I'm attaching the full diff in case anyone wants to read it :) > > A net removal of 562 lines with, I hope, no change in behavior. I revisit this every few months, and have to completely relearn all the code each time. With any luck that means that I've looked over these diffs sufficiently to have caught more bugs. At any rate, I think this is finally ready to go. Eric [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0001-Allow-gnus-retrieve-headers-to-return-headers-direct.patch --] [-- Type: text/x-patch, Size: 40521 bytes --] From 0aaf6030b95a6da74fb7f78344ddbc03d12dee94 Mon Sep 17 00:00:00 2001 From: Eric Abrahamsen <eric@ericabrahamsen.net> Date: Tue, 17 Mar 2020 20:53:05 -0700 Subject: [PATCH] Allow gnus-retrieve-headers to return headers directly --- lisp/gnus/gnus-agent.el | 385 +++++++++++++--------------------------- lisp/gnus/gnus-async.el | 9 +- lisp/gnus/gnus-cache.el | 132 ++++---------- lisp/gnus/gnus-cloud.el | 14 +- lisp/gnus/gnus-sum.el | 70 ++++++-- lisp/gnus/gnus.el | 9 +- lisp/gnus/nnvirtual.el | 172 +++++------------- lisp/obsolete/nnir.el | 1 - 8 files changed, 273 insertions(+), 519 deletions(-) diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el index 56640ea830..514e7bf293 100644 --- a/lisp/gnus/gnus-agent.el +++ b/lisp/gnus/gnus-agent.el @@ -1789,6 +1789,7 @@ gnus-agent-find-parameter . gnus-agent-enable-expiration) (agent-predicate . gnus-agent-predicate))))))) +;; FIXME: This looks an awful lot like `gnus-agent-retrieve-headers'. (defun gnus-agent-fetch-headers (group) "Fetch interesting headers into the agent. The group's overview file will be updated to include the headers while a list of available @@ -1810,10 +1811,11 @@ gnus-agent-fetch-headers (cdr active)))) (gnus-uncompress-range (gnus-active group))) (gnus-list-of-unread-articles group))) - (gnus-decode-encoded-word-function 'identity) - (gnus-decode-encoded-address-function 'identity) + (gnus-decode-encoded-word-function #'identity) + (gnus-decode-encoded-address-function #'identity) (file (gnus-agent-article-name ".overview" group)) - (file-name-coding-system nnmail-pathname-coding-system)) + (file-name-coding-system nnmail-pathname-coding-system) + headers fetched-headers) (unless fetch-all ;; Add articles with marks to the list of article headers we want to @@ -1824,7 +1826,7 @@ gnus-agent-fetch-headers (dolist (arts (gnus-info-marks (gnus-get-info group))) (unless (memq (car arts) '(seen recent killed cache)) (setq articles (gnus-range-add articles (cdr arts))))) - (setq articles (sort (gnus-uncompress-sequence articles) '<))) + (setq articles (sort (gnus-uncompress-range articles) '<))) ;; At this point, I have the list of articles to consider for ;; fetching. This is the list that I'll return to my caller. Some @@ -1867,38 +1869,46 @@ gnus-agent-fetch-headers 10 "gnus-agent-fetch-headers: undownloaded articles are `%s'" (gnus-compress-sequence articles t))) - (with-current-buffer nntp-server-buffer - (if articles - (progn - (gnus-message 8 "Fetching headers for %s..." group) - - ;; Fetch them. - (gnus-make-directory (nnheader-translate-file-chars - (file-name-directory file) t)) - - (unless (eq 'nov (gnus-retrieve-headers articles group)) - (nnvirtual-convert-headers)) - (gnus-agent-check-overview-buffer) - ;; Move these headers to the overview buffer so that - ;; gnus-agent-braid-nov can merge them with the contents - ;; of FILE. - (copy-to-buffer - gnus-agent-overview-buffer (point-min) (point-max)) - ;; NOTE: Call g-a-brand-nov even when the file does not - ;; exist. As a minimum, it will validate the article - ;; numbers already in the buffer. - (gnus-agent-braid-nov articles file) - (let ((coding-system-for-write - gnus-agent-file-coding-system)) - (gnus-agent-check-overview-buffer) - (write-region (point-min) (point-max) file nil 'silent)) - (gnus-agent-update-view-total-fetched-for group t) - (gnus-agent-save-alist group articles nil) - articles) - (ignore-errors - (erase-buffer) - (nnheader-insert-file-contents file))))) - articles)) + ;; Parse known headers from FILE. + (if (file-exists-p file) + (with-current-buffer gnus-agent-overview-buffer + (erase-buffer) + (let ((nnheader-file-coding-system + gnus-agent-file-coding-system)) + (nnheader-insert-nov-file file (car articles)) + (while (not (eobp)) + (push (nnheader-parse-nov) headers) + (forward-line 1)) + (setq headers (nreverse headers)))) + (gnus-make-directory (nnheader-translate-file-chars + (file-name-directory file) t))) + + ;; Fetch our new headers. + (gnus-message 8 "Fetching headers for %s..." group) + (if articles + (setq fetched-headers (gnus-fetch-headers articles))) + + ;; Merge two sets of headers. + (setq headers + (if (and headers fetched-headers) + (delete-dups + (sort (append headers fetched-headers) + (lambda (l r) + (< (mail-header-number l) + (mail-header-number r))))) + (or headers fetched-headers))) + + ;; Save the new set of headers to FILE. + (let ((coding-system-for-write + gnus-agent-file-coding-system)) + (with-current-buffer gnus-agent-overview-buffer + (erase-buffer) + (mapc #'nnheader-insert-nov headers) + (gnus-agent-check-overview-buffer) + (write-region (point-min) (point-max) file nil 'silent))) + (gnus-agent-update-view-total-fetched-for group t) + (gnus-agent-save-alist group articles nil)) + headers)) (defsubst gnus-agent-read-article-number () "Read the article number at point. @@ -1924,96 +1934,6 @@ gnus-agent-copy-nov-line (set-buffer nntp-server-buffer) (insert-buffer-substring gnus-agent-overview-buffer b e)))) -(defun gnus-agent-braid-nov (articles file) - "Merge agent overview data with given file. -Takes unvalidated headers for ARTICLES from -`gnus-agent-overview-buffer' and validated headers from the given -FILE and places the combined valid headers into -`nntp-server-buffer'. This function can be used, when file -doesn't exist, to valid the overview buffer." - (let (start last) - (set-buffer gnus-agent-overview-buffer) - (goto-char (point-min)) - (set-buffer nntp-server-buffer) - (erase-buffer) - (when (file-exists-p file) - (nnheader-insert-file-contents file)) - (goto-char (point-max)) - (forward-line -1) - - (unless (or (= (point-min) (point-max)) - (< (setq last (read (current-buffer))) (car articles))) - ;; Old and new overlap -- We do it the hard way. - (when (nnheader-find-nov-line (car articles)) - ;; Replacing existing NOV entry - (delete-region (point) (progn (forward-line 1) (point)))) - (gnus-agent-copy-nov-line (pop articles)) - - (ignore-errors - (while articles - (while (let ((art (read (current-buffer)))) - (cond ((< art (car articles)) - (forward-line 1) - t) - ((= art (car articles)) - (beginning-of-line) - (delete-region - (point) (progn (forward-line 1) (point))) - nil) - (t - (beginning-of-line) - nil)))) - - (gnus-agent-copy-nov-line (pop articles))))) - - (goto-char (point-max)) - - ;; Append the remaining lines - (when articles - (when last - (set-buffer gnus-agent-overview-buffer) - (setq start (point)) - (set-buffer nntp-server-buffer)) - - (let ((p (point))) - (insert-buffer-substring gnus-agent-overview-buffer start) - (goto-char p)) - - (setq last (or last -134217728)) - (while (catch 'problems - (let (sort art) - (while (not (eobp)) - (setq art (gnus-agent-read-article-number)) - (cond ((not art) - ;; Bad art num - delete this line - (beginning-of-line) - (delete-region (point) (progn (forward-line 1) (point)))) - ((< art last) - ;; Art num out of order - enable sort - (setq sort t) - (forward-line 1)) - ((= art last) - ;; Bad repeat of art number - delete this line - (beginning-of-line) - (delete-region (point) (progn (forward-line 1) (point)))) - (t - ;; Good art num - (setq last art) - (forward-line 1)))) - (when sort - ;; something is seriously wrong as we simply shouldn't see out-of-order data. - ;; First, we'll fix the sort. - (sort-numeric-fields 1 (point-min) (point-max)) - - ;; but now we have to consider that we may have duplicate rows... - ;; so reset to beginning of file - (goto-char (point-min)) - (setq last -134217728) - - ;; and throw a code that restarts this scan - (throw 'problems t)) - nil)))))) - ;; Keeps the compiler from warning about the free variable in ;; gnus-agent-read-agentview. (defvar gnus-agent-read-agentview) @@ -2386,10 +2306,9 @@ gnus-agent-fetch-group-1 (gnus-orphan-score gnus-orphan-score) ;; Maybe some other gnus-summary local variables should also ;; be put here. - + fetched-headers gnus-headers gnus-score - articles predicate info marks ) (unless (gnus-check-group group) @@ -2410,38 +2329,35 @@ gnus-agent-fetch-group-1 (setq info (gnus-get-info group))))))) (when arts (setq marked-articles (nconc (gnus-uncompress-range arts) - marked-articles)) - )))) + marked-articles)))))) (setq marked-articles (sort marked-articles '<)) - ;; Fetch any new articles from the server - (setq articles (gnus-agent-fetch-headers group)) + (setq gnus-newsgroup-dependencies + (or gnus-newsgroup-dependencies + (gnus-make-hashtable))) - ;; Merge new articles with marked - (setq articles (sort (append marked-articles articles) '<)) + ;; Fetch headers for any new articles from the server. + (setq fetched-headers (gnus-agent-fetch-headers group)) - (when articles - ;; Parse them and see which articles we want to fetch. - (setq gnus-newsgroup-dependencies - (or gnus-newsgroup-dependencies - (gnus-make-hashtable (length articles)))) + (when fetched-headers (setq gnus-newsgroup-headers - (or gnus-newsgroup-headers - (gnus-get-newsgroup-headers-xover articles nil nil - group))) - ;; `gnus-agent-overview-buffer' may be killed for - ;; timeout reason. If so, recreate it. + (or gnus-newsgroup-headers + fetched-headers))) + (when marked-articles + ;; `gnus-agent-overview-buffer' may be killed for timeout + ;; reason. If so, recreate it. (gnus-agent-create-buffer) (setq predicate - (gnus-get-predicate - (gnus-agent-find-parameter group 'agent-predicate))) + (gnus-get-predicate + (gnus-agent-find-parameter group 'agent-predicate))) + + ;; If the selection predicate requires scoring, score each header. - ;; If the selection predicate requires scoring, score each header (unless (memq predicate '(gnus-agent-true gnus-agent-false)) (let ((score-param (gnus-agent-find-parameter group 'agent-score-file))) - ;; Translate score-param into real one + ;; Translate score-param into real one. (cond ((not score-param)) ((eq score-param 'file) @@ -3661,11 +3577,11 @@ gnus-agent-uncached-articles (defun gnus-agent-retrieve-headers (articles group &optional fetch-old) (save-excursion (gnus-agent-create-buffer) - (let ((gnus-decode-encoded-word-function 'identity) - (gnus-decode-encoded-address-function 'identity) + (let ((gnus-decode-encoded-word-function #'identity) + (gnus-decode-encoded-address-function #'identity) (file (gnus-agent-article-name ".overview" group)) - uncached-articles - (file-name-coding-system nnmail-pathname-coding-system)) + (file-name-coding-system nnmail-pathname-coding-system) + uncached-articles headers fetched-headers) (gnus-make-directory (nnheader-translate-file-chars (file-name-directory file) t)) @@ -3676,122 +3592,61 @@ gnus-agent-retrieve-headers 1) (car (last articles)))))) - ;; Populate temp buffer with known headers - (when (file-exists-p file) - (with-current-buffer gnus-agent-overview-buffer - (erase-buffer) - (let ((nnheader-file-coding-system - gnus-agent-file-coding-system)) - (nnheader-insert-nov-file file (car articles))))) - - (if (setq uncached-articles (gnus-agent-uncached-articles articles group - t)) - (progn - ;; Populate nntp-server-buffer with uncached headers - (set-buffer nntp-server-buffer) - (erase-buffer) - (cond ((not (eq 'nov (let (gnus-agent) ; Turn off agent - (gnus-retrieve-headers - uncached-articles group)))) - (nnvirtual-convert-headers)) - ((eq 'nntp (car gnus-current-select-method)) - ;; The author of gnus-get-newsgroup-headers-xover - ;; reports that the XOVER command is commonly - ;; unreliable. The problem is that recently - ;; posted articles may not be entered into the - ;; NOV database in time to respond to my XOVER - ;; query. - ;; - ;; I'm going to use his assumption that the NOV - ;; database is updated in order of ascending - ;; article ID. Therefore, a response containing - ;; article ID N implies that all articles from 1 - ;; to N-1 are up-to-date. Therefore, missing - ;; articles in that range have expired. - - (set-buffer nntp-server-buffer) - (let* ((fetched-articles (list nil)) - (tail-fetched-articles fetched-articles) - (min (car articles)) - (max (car (last articles)))) - - ;; Get the list of articles that were fetched - (goto-char (point-min)) - (let ((pm (point-max)) - art) - (while (< (point) pm) - (when (setq art (gnus-agent-read-article-number)) - (gnus-agent-append-to-list tail-fetched-articles art)) - (forward-line 1))) - - ;; Clip this list to the headers that will - ;; actually be returned - (setq fetched-articles (gnus-list-range-intersection - (cdr fetched-articles) - (cons min max))) - - ;; Clip the uncached articles list to exclude - ;; IDs after the last FETCHED header. The - ;; excluded IDs may be fetchable using HEAD. - (if (car tail-fetched-articles) - (setq uncached-articles - (gnus-list-range-intersection - uncached-articles - (cons (car uncached-articles) - (car tail-fetched-articles))))) - - ;; Create the list of articles that were - ;; "successfully" fetched. Success, in this - ;; case, means that the ID should not be - ;; fetched again. In the case of an expired - ;; article, the header will not be fetched. - (setq uncached-articles - (gnus-sorted-nunion fetched-articles - uncached-articles)) - ))) - - ;; Erase the temp buffer - (set-buffer gnus-agent-overview-buffer) + ;; See if we've got cached headers for ARTICLES and put them in + ;; HEADERS. Articles with no cached headers go in + ;; UNCACHED-ARTICLES to be fetched from the server. + (if (file-exists-p file) + (with-current-buffer gnus-agent-overview-buffer (erase-buffer) - - ;; Copy the nntp-server-buffer to the temp buffer - (set-buffer nntp-server-buffer) - (copy-to-buffer gnus-agent-overview-buffer (point-min) (point-max)) - - ;; Merge the temp buffer with the known headers (found on - ;; disk in FILE) into the nntp-server-buffer - (when uncached-articles - (gnus-agent-braid-nov uncached-articles file)) - - ;; Save the new set of known headers to FILE - (set-buffer nntp-server-buffer) + (let ((nnheader-file-coding-system + gnus-agent-file-coding-system)) + (nnheader-insert-nov-file file (car articles)) + (goto-char (point-min)) + ;; We're assuming both ARTICLES and the overview buffer + ;; are sorted in ascending order. + (dolist (art-no articles) + (if (re-search-forward + (format "^%d\\>" art-no) + (point-max) t) + (progn + (beginning-of-line) + (push (nnheader-parse-nov) headers) + (forward-line)) + (push art-no uncached-articles))) + (setq headers (nreverse headers)))) + (setq uncached-articles articles)) + + (when uncached-articles + (let ((gnus-newsgroup-name group) + gnus-agent) ; Prevent loop. + ;; Fetch additional headers for the uncached articles. + (setq fetched-headers (gnus-fetch-headers uncached-articles)) + ;; Merge headers we got from the overview file with our + ;; newly-fetched headers. + (when fetched-headers + (setq headers + (delete-dups + (sort (append headers fetched-headers) + (lambda (l r) + (< (mail-header-number l) + (mail-header-number r)))))) + + ;; Add the new set of known headers to the overview file. (let ((coding-system-for-write gnus-agent-file-coding-system)) - (gnus-agent-check-overview-buffer) - (write-region (point-min) (point-max) file nil 'silent)) - - (gnus-agent-update-view-total-fetched-for group t) - - ;; Update the group's article alist to include the newly - ;; fetched articles. - (gnus-agent-load-alist group) - (gnus-agent-save-alist group uncached-articles nil) - ) - - ;; Copy the temp buffer to the nntp-server-buffer - (set-buffer nntp-server-buffer) - (erase-buffer) - (insert-buffer-substring gnus-agent-overview-buffer))) - - (if (and fetch-old - (not (numberp fetch-old))) - t ; Don't remove anything. - (nnheader-nov-delete-outside-range - (car articles) - (car (last articles))) - t) - - 'nov)) + (with-current-buffer gnus-agent-overview-buffer + (goto-char (point-max)) + (mapc #'nnheader-insert-nov fetched-headers) + (gnus-agent-check-overview-buffer) + (write-region (point-min) (point-max) file nil 'silent)))) + + (gnus-agent-update-view-total-fetched-for group t) + + ;; Update the group's article alist to include the newly + ;; fetched articles. + (gnus-agent-load-alist group) + (gnus-agent-save-alist group uncached-articles nil))) + headers))) (defun gnus-agent-request-article (article group) "Retrieve ARTICLE in GROUP from the agent cache." diff --git a/lisp/gnus/gnus-async.el b/lisp/gnus/gnus-async.el index fefd02c7bf..ed948a26c0 100644 --- a/lisp/gnus/gnus-async.el +++ b/lisp/gnus/gnus-async.el @@ -357,8 +357,13 @@ gnus-async-prefetch-headers (let ((nntp-server-buffer (current-buffer)) (nnheader-callback-function (lambda (_arg) - (setq gnus-async-header-prefetched - (cons group unread))))) + (setq gnus-async-header-prefetched + (cons group unread))))) + ;; FIXME: If header prefetch is ever put into use, we'll + ;; have to handle the possibility that + ;; `gnus-retrieve-headers' might return a list of header + ;; vectors directly, rather than writing them into the + ;; current buffer. (gnus-retrieve-headers unread group gnus-fetch-old-headers)))))) (defun gnus-async-retrieve-fetched-headers (articles group) diff --git a/lisp/gnus/gnus-cache.el b/lisp/gnus/gnus-cache.el index 36657e4621..d46eb39ace 100644 --- a/lisp/gnus/gnus-cache.el +++ b/lisp/gnus/gnus-cache.el @@ -294,49 +294,51 @@ gnus-cache-possibly-alter-active (defun gnus-cache-retrieve-headers (articles group &optional fetch-old) "Retrieve the headers for ARTICLES in GROUP." (let ((cached - (setq gnus-newsgroup-cached (gnus-cache-articles-in-group group)))) + (setq gnus-newsgroup-cached (gnus-cache-articles-in-group group))) + (gnus-newsgroup-name group) + (gnus-fetch-old-headers fetch-old)) (if (not cached) ;; No cached articles here, so we just retrieve them ;; the normal way. (let ((gnus-use-cache nil)) - (gnus-retrieve-headers articles group fetch-old)) + (gnus-retrieve-headers articles group)) (let ((uncached-articles (gnus-sorted-difference articles cached)) (cache-file (gnus-cache-file-name group ".overview")) - type - (file-name-coding-system nnmail-pathname-coding-system)) + (file-name-coding-system nnmail-pathname-coding-system) + headers) ;; We first retrieve all the headers that we don't have in ;; the cache. (let ((gnus-use-cache nil)) (when uncached-articles - (setq type (and articles - (gnus-retrieve-headers - uncached-articles group fetch-old))))) - (gnus-cache-save-buffers) - ;; Then we insert the cached headers. - (save-excursion - (cond - ((not (file-exists-p cache-file)) - ;; There are no cached headers. - type) - ((null type) - ;; There were no uncached headers (or retrieval was - ;; unsuccessful), so we use the cached headers exclusively. - (set-buffer nntp-server-buffer) - (erase-buffer) - (let ((coding-system-for-read - gnus-cache-overview-coding-system)) - (insert-file-contents cache-file)) - 'nov) - ((eq type 'nov) - ;; We have both cached and uncached NOV headers, so we - ;; braid them. - (gnus-cache-braid-nov group cached) - type) - (t - ;; We braid HEADs. - (gnus-cache-braid-heads group (gnus-sorted-intersection - cached articles)) - type))))))) + (setq headers (and articles + (gnus-fetch-headers uncached-articles))))) + (when (and headers gnus-cache-buffer) + (with-current-buffer (cdr gnus-cache-buffer) + (goto-char (point-min)) + (mapc #'nnheader-insert-nov headers) + (gnus-cache-save-buffers))) + ;; Then we include the cached headers. + (when (file-exists-p cache-file) + (setq headers + (delete-dups + (sort + (append headers + (let ((coding-system-for-read + gnus-cache-overview-coding-system)) + (with-current-buffer nntp-server-buffer + (erase-buffer) + (insert-file-contents cache-file) + (gnus-get-newsgroup-headers-xover + (gnus-sorted-difference + cached uncached-articles) + nil (buffer-local-value + 'gnus-newsgroup-dependencies + gnus-summary-buffer) + group)))) + (lambda (l r) + (< (mail-header-number l) + (mail-header-number r))))))) + headers)))) (defun gnus-cache-enter-article (&optional n) "Enter the next N articles into the cache. @@ -529,70 +531,6 @@ gnus-cache-articles-in-group (setq gnus-cache-active-altered t))) articles))) -(defun gnus-cache-braid-nov (group cached &optional file) - (let ((cache-buf (gnus-get-buffer-create " *gnus-cache*")) - beg end) - (gnus-cache-save-buffers) - (with-current-buffer cache-buf - (erase-buffer) - (let ((coding-system-for-read gnus-cache-overview-coding-system) - (file-name-coding-system nnmail-pathname-coding-system)) - (insert-file-contents - (or file (gnus-cache-file-name group ".overview")))) - (goto-char (point-min)) - (insert "\n") - (goto-char (point-min))) - (set-buffer nntp-server-buffer) - (goto-char (point-min)) - (while cached - (while (and (not (eobp)) - (< (read (current-buffer)) (car cached))) - (forward-line 1)) - (beginning-of-line) - (set-buffer cache-buf) - (if (search-forward (concat "\n" (int-to-string (car cached)) "\t") - nil t) - (setq beg (point-at-bol) - end (progn (end-of-line) (point))) - (setq beg nil)) - (set-buffer nntp-server-buffer) - (when beg - (insert-buffer-substring cache-buf beg end) - (insert "\n")) - (setq cached (cdr cached))) - (kill-buffer cache-buf))) - -(defun gnus-cache-braid-heads (group cached) - (let ((cache-buf (gnus-get-buffer-create " *gnus-cache*"))) - (with-current-buffer cache-buf - (erase-buffer)) - (set-buffer nntp-server-buffer) - (goto-char (point-min)) - (dolist (entry cached) - (while (and (not (eobp)) - (looking-at "2.. +\\([0-9]+\\) ") - (< (progn (goto-char (match-beginning 1)) - (read (current-buffer))) - entry)) - (search-forward "\n.\n" nil 'move)) - (beginning-of-line) - (set-buffer cache-buf) - (erase-buffer) - (let ((coding-system-for-read gnus-cache-coding-system) - (file-name-coding-system nnmail-pathname-coding-system)) - (insert-file-contents (gnus-cache-file-name group entry))) - (goto-char (point-min)) - (insert "220 ") - (princ (pop cached) (current-buffer)) - (insert " Article retrieved.\n") - (search-forward "\n\n" nil 'move) - (delete-region (point) (point-max)) - (forward-char -1) - (insert ".") - (set-buffer nntp-server-buffer) - (insert-buffer-substring cache-buf)) - (kill-buffer cache-buf))) - ;;;###autoload (defun gnus-jog-cache () "Go through all groups and put the articles into the cache. diff --git a/lisp/gnus/gnus-cloud.el b/lisp/gnus/gnus-cloud.el index f7c71f43ce..8d1d0c6f65 100644 --- a/lisp/gnus/gnus-cloud.el +++ b/lisp/gnus/gnus-cloud.el @@ -30,6 +30,8 @@ (require 'parse-time) (require 'nnimap) +(declare-function gnus-fetch-headers "gnus-sum") +(defvar gnus-alter-header-function) (eval-when-compile (require 'epg)) ;; setf-method for `epg-context-armor' (autoload 'epg-make-context "epg") @@ -407,14 +409,10 @@ gnus-cloud-available-chunks (gnus-activate-group gnus-cloud-group-name nil nil gnus-cloud-method) (let* ((group (gnus-group-full-name gnus-cloud-group-name gnus-cloud-method)) (active (gnus-active group)) - headers head) - (when (gnus-retrieve-headers (gnus-uncompress-range active) group) - (with-current-buffer nntp-server-buffer - (goto-char (point-min)) - (while (setq head (nnheader-parse-head)) - (when gnus-alter-header-function - (funcall gnus-alter-header-function head)) - (push head headers)))) + (gnus-newsgroup-name group) + (headers (gnus-fetch-headers (gnus-uncompress-range active)))) + (when gnus-alter-header-function + (mapc #'gnus-alter-header-function headers)) (sort (nreverse headers) (lambda (h1 h2) (> (gnus-cloud-chunk-sequence (mail-header-subject h1)) diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index b0f9ed4c6f..f9851726bf 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -4590,6 +4590,11 @@ gnus-nov-parse-line (forward-char)) (setq header (nnheader-parse-nov number)) (widen)) + ;; (when (and (string= references "") + ;; (setq in-reply-to (mail-header-extra header)) + ;; (setq in-reply-to (cdr (assq 'In-Reply-To in-reply-to)))) + ;; (setf (mail-header-references header) + ;; (gnus-extract-message-id-from-in-reply-to in-reply-to))) (when gnus-alter-header-function (funcall gnus-alter-header-function header)) (gnus-dependencies-add-header header dependencies force-new))) @@ -5658,10 +5663,21 @@ 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 - (pcase (setq gnus-headers-retrieved-by + (let ((res (setq gnus-headers-retrieved-by (gnus-retrieve-headers articles gnus-newsgroup-name (or limit @@ -5671,22 +5687,34 @@ gnus-fetch-headers (not (eq gnus-fetch-old-headers 'some)) (not (numberp gnus-fetch-old-headers))) (> (length articles) 1)) - gnus-fetch-old-headers)))) - ('nov - (gnus-get-newsgroup-headers-xover - articles force-new dependencies gnus-newsgroup-name t)) - ('headers - (gnus-get-newsgroup-headers dependencies force-new)) - ((pred listp) - (let ((dependencies - (or dependencies - (with-current-buffer gnus-summary-buffer - gnus-newsgroup-dependencies)))) - (delq nil (mapcar #'(lambda (header) - (gnus-dependencies-add-header - header dependencies force-new)) - gnus-headers-retrieved-by))))) - (gnus-message 7 "Fetching headers for %s...done" gnus-newsgroup-name))) + 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) + (let ((dependencies + (or dependencies + (buffer-local-value + 'gnus-newsgroup-dependencies gnus-summary-buffer)))) + (when (functionp gnus-alter-header-function) + (mapc gnus-alter-header-function res)) + (mapc (lambda (header) + ;; The agent or the cache may have already + ;; registered this header in the dependency + ;; table. + (unless (gethash (mail-header-id header) dependencies) + (gnus-dependencies-add-header + header dependencies force-new))) + res) + res)) + (_ (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. @@ -6443,6 +6471,10 @@ gnus-group-make-articles-read (unless (gnus-ephemeral-group-p group) (gnus-group-update-group group t)))))) +;; FIXME: Refactor this with `gnus-get-newsgroup-headers-xover' and +;; extract the necessary bits for the direct-header-return case. Also +;; look at this and see how similar it is to +;; `nnheader-parse-naked-head'. (defun gnus-get-newsgroup-headers (&optional dependencies force-new) (let ((dependencies (or dependencies diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index 3b172db211..b00f66b1d4 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -2388,7 +2388,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/nnvirtual.el b/lisp/gnus/nnvirtual.el index 1e2feda636..c17ac02380 100644 --- a/lisp/gnus/nnvirtual.el +++ b/lisp/gnus/nnvirtual.el @@ -101,15 +101,10 @@ nnvirtual-retrieve-headers (erase-buffer) (if (stringp (car articles)) 'headers - (let ((vbuf (nnheader-set-temp-buffer - (gnus-get-buffer-create " *virtual headers*"))) - (carticles (nnvirtual-partition-sequence articles)) + (let ((carticles (nnvirtual-partition-sequence articles)) (sysname (system-name)) - cgroup carticle article result prefix) - (while carticles - (setq cgroup (caar carticles)) - (setq articles (cdar carticles)) - (pop carticles) + cgroup headers all-headers article prefix) + (pcase-dolist (`(,cgroup . ,articles) carticles) (when (and articles (gnus-check-server (gnus-find-method-for-group cgroup) t) @@ -119,69 +114,37 @@ nnvirtual-retrieve-headers ;; This is probably evil if people have set ;; gnus-use-cache to nil themselves, but I ;; have no way of finding the true value of it. - (let ((gnus-use-cache t)) - (setq result (gnus-retrieve-headers - articles cgroup nil)))) - (set-buffer nntp-server-buffer) - ;; If we got HEAD headers, we convert them into NOV - ;; headers. This is slow, inefficient and, come to think - ;; of it, downright evil. So sue me. I couldn't be - ;; bothered to write a header parse routine that could - ;; parse a mixed HEAD/NOV buffer. - (when (eq result 'headers) - (nnvirtual-convert-headers)) - (goto-char (point-min)) - (while (not (eobp)) - (delete-region (point) - (progn - (setq carticle (read nntp-server-buffer)) - (point))) - - ;; We remove this article from the articles list, if - ;; anything is left in the articles list after going through - ;; the entire buffer, then those articles have been - ;; expired or canceled, so we appropriately update the - ;; component group below. They should be coming up - ;; generally in order, so this shouldn't be slow. - (setq articles (delq carticle articles)) - - (setq article (nnvirtual-reverse-map-article cgroup carticle)) - (if (null article) - ;; This line has no reverse mapping, that means it - ;; was an extra article reference returned by nntp. - (progn - (beginning-of-line) - (delete-region (point) (progn (forward-line 1) (point)))) - ;; Otherwise insert the virtual article number, - ;; and clean up the xrefs. - (princ article nntp-server-buffer) - (nnvirtual-update-xref-header cgroup carticle - prefix sysname) - (forward-line 1)) - ) - - (set-buffer vbuf) - (goto-char (point-max)) - (insert-buffer-substring nntp-server-buffer)) - ;; Anything left in articles is expired or canceled. - ;; Could be smart and not tell it about articles already known? - (when articles - (gnus-group-make-articles-read cgroup articles)) - ) - - ;; The headers are ready for reading, so they are inserted into - ;; the nntp-server-buffer, which is where Gnus expects to find - ;; them. - (prog1 - (with-current-buffer nntp-server-buffer - (erase-buffer) - (insert-buffer-substring vbuf) - ;; FIX FIX FIX, we should be able to sort faster than - ;; this if needed, since each cgroup is sorted, we just - ;; need to merge - (sort-numeric-fields 1 (point-min) (point-max)) - 'nov) - (kill-buffer vbuf))))))) + (let ((gnus-use-cache t) + (gnus-newsgroup-name cgroup) + (gnus-fetch-old-headers nil)) + (setq headers (gnus-fetch-headers articles)))) + (erase-buffer) + ;; Remove all header article numbers from `articles'. + ;; If there's anything left, those are expired or + ;; canceled articles, so we update the component group + ;; below. + (dolist (h headers) + (setq articles (delq (mail-header-number h) articles) + article (nnvirtual-reverse-map-article + cgroup (mail-header-number h))) + ;; Update all the header numbers according to their + ;; reverse mapping, and drop any with no such mapping. + (when article + ;; Do this first, before we re-set the header's + ;; article number. + (nnvirtual-update-xref-header + h cgroup prefix sysname) + (setf (mail-header-number h) article) + (push h all-headers))) + ;; Anything left in articles is expired or canceled. + ;; Could be smart and not tell it about articles already + ;; known? + (when articles + (gnus-group-make-articles-read cgroup articles)))) + + (sort all-headers (lambda (h1 h2) + (< (mail-header-number h1) + (mail-header-number h2))))))))) (defvoo nnvirtual-last-accessed-component-group nil) @@ -372,61 +335,18 @@ nnvirtual-request-expire-articles \f ;;; Internal functions. -(defun nnvirtual-convert-headers () - "Convert HEAD headers into NOV headers." - (with-current-buffer nntp-server-buffer - (let* ((dependencies (make-hash-table :test #'equal)) - (headers (gnus-get-newsgroup-headers dependencies))) - (erase-buffer) - (mapc 'nnheader-insert-nov headers)))) - - -(defun nnvirtual-update-xref-header (group article prefix sysname) - "Edit current NOV header in current buffer to have an xref to the component group, and also server prefix any existing xref lines." - ;; Move to beginning of Xref field, creating a slot if needed. - (beginning-of-line) - (looking-at - "[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t") - (goto-char (match-end 0)) - (unless (search-forward "\t" (point-at-eol) 'move) - (insert "\t")) - - ;; Remove any spaces at the beginning of the Xref field. - (while (eq (char-after (1- (point))) ? ) - (forward-char -1) - (delete-char 1)) - - (insert "Xref: " sysname " " group ":") - (princ article (current-buffer)) - (insert " ") - - ;; If there were existing xref lines, clean them up to have the correct - ;; component server prefix. - (save-restriction - (narrow-to-region (point) - (or (search-forward "\t" (point-at-eol) t) - (point-at-eol))) - (goto-char (point-min)) - (when (re-search-forward "Xref: *[^\n:0-9 ]+ *" nil t) - (replace-match "" t t)) - (goto-char (point-min)) - (when (re-search-forward - (concat (regexp-quote (gnus-group-real-name group)) ":[0-9]+") - nil t) - (replace-match "" t t)) - (unless (eobp) - (insert " ") - (when (not (string= "" prefix)) - (while (re-search-forward "[^ ]+:[0-9]+" nil t) - (save-excursion - (goto-char (match-beginning 0)) - (insert prefix)))))) - - ;; Ensure a trailing \t. - (end-of-line) - (or (eq (char-after (1- (point))) ?\t) - (insert ?\t))) - +(defun nnvirtual-update-xref-header (header group prefix sysname) + "Add xref to component GROUP to HEADER. +Also add a server PREFIX any existing xref lines." + (let ((bits (split-string (mail-header-xref header) + nil t "[[:blank:]]")) + (art-no (mail-header-number header))) + (setf (mail-header-xref header) + (concat + (format "%s %s:%d " sysname group art-no) + (mapconcat (mapcar (lambda (bit) + (concat prefix bit)) + bits " ")))))) (defun nnvirtual-possibly-change-server (server) (or (not server) diff --git a/lisp/obsolete/nnir.el b/lisp/obsolete/nnir.el index 147efed005..0b7d1e454c 100644 --- a/lisp/obsolete/nnir.el +++ b/lisp/obsolete/nnir.el @@ -504,7 +504,6 @@ nnir-method-default-engines ,@(mapcar (lambda (elem) (list 'const (car elem))) nnir-engines))))) - (defmacro nnir-add-result (dirnam artno score prefix server artlist) "Construct a result vector and add it to ARTLIST. DIRNAM, ARTNO, SCORE, PREFIX and SERVER are passed to -- 2.30.0 ^ permalink raw reply related [flat|nested] 29+ messages in thread
* bug#38011: 27.0.50; [PATCH] WIP on allowing Gnus backends to return header data directly 2021-01-02 3:18 ` Eric Abrahamsen @ 2021-01-02 5:59 ` Lars Ingebrigtsen 2021-01-02 20:49 ` Eric Abrahamsen 0 siblings, 1 reply; 29+ messages in thread From: Lars Ingebrigtsen @ 2021-01-02 5:59 UTC (permalink / raw) To: Eric Abrahamsen; +Cc: 38011 Eric Abrahamsen <eric@ericabrahamsen.net> writes: > I revisit this every few months, and have to completely relearn all the > code each time. With any luck that means that I've looked over these > diffs sufficiently to have caught more bugs. > > At any rate, I think this is finally ready to go. Congratulations! That's a big patch, and skimming it, I'm not quite sure I understand it all. Could you put this on a branch so that we can get a bit of testing before merging it? -- (domestic pets only, the antidote for overdose, milk.) bloggy blog: http://lars.ingebrigtsen.no ^ permalink raw reply [flat|nested] 29+ messages in thread
* bug#38011: 27.0.50; [PATCH] WIP on allowing Gnus backends to return header data directly 2021-01-02 5:59 ` Lars Ingebrigtsen @ 2021-01-02 20:49 ` Eric Abrahamsen 2021-01-03 7:45 ` Lars Ingebrigtsen 0 siblings, 1 reply; 29+ messages in thread From: Eric Abrahamsen @ 2021-01-02 20:49 UTC (permalink / raw) To: Lars Ingebrigtsen; +Cc: 38011 Lars Ingebrigtsen <larsi@gnus.org> writes: > Eric Abrahamsen <eric@ericabrahamsen.net> writes: > >> I revisit this every few months, and have to completely relearn all the >> code each time. With any luck that means that I've looked over these >> diffs sufficiently to have caught more bugs. >> >> At any rate, I think this is finally ready to go. > > Congratulations! > > That's a big patch, and skimming it, I'm not quite sure I understand it > all. Could you put this on a branch so that we can get a bit of testing > before merging it? Sure thing. It's in girzel/gnus-headers now. I made a few more sneaky last minute changes, so yes... testing is in order. The basic principle is simple: it gives backends the option of parsing their own article headers, rather than writing text into the nntp-server-buffer to get parsed later. In this sense, the diff on `gnus-fetch-headers' is all there is to it. None of the backends actually do this right now. It gets complicated because the cache and the agent need to mix their saved headers into whatever newly-fetched headers we get from the server. So instead of having them call `gnus-retrieve-headers' and mixing their cached text into the nntp-server-buffer, they now call `gnus-fetch-headers' on the server, which actually returns real headers. That means they also need to be responsible for extracting real headers from their own cache files (rather than letting that happen further down the line). In this patch both do that with `gnus-get-newsgroup-headers-xover' (which efficiently parses only a subset of [potentially very many] cached headers), then merge/sort those headers with what came back from the server. A few points of contention: 1. I'm not sure there's a real difference between `gnus-agent-fetch-headers' and `gnus-agent-retrieve-headers' anymore. Both return actual headers. It would take a quiet afternoon of staring at the code to know for sure. 2. The agent and cache are now using `gnus-get-newsgroup-headers-xover' to parse their cached headers, which does its own dependency building. This means that `gnus-fetch-headers' has to be careful not to double-register headers in the dependency table. It also means that the agent and cache have to reach waaaaaay back to find a reference to the `gnus-dependency-table', which they're both doing with a call to `buffer-local-value', which feels gross and fragile. In general I would much prefer to build the dependency table in one place, preferably after all the headers have been retrieved, preferably in `gnus-select-newsgroup'. Another option would be to not use the higher-level `gnus-get-newsgroup-headers-xover', but instead to scan the cache files for article numbers and use the lower-level `nnheader-parse-nov', which isn't concerned with dependencies. 3. In general it took many extra brain cycles (of which I do not have a surplus) to follow the code flow. I would love it if `gnus-retrieve-headers' -- instead of calling one of `gnus-(cache|agent)-retrieve-headers' and expecting them to re-call `gnus-retrieve-headers' multiple times with various global variables set -- instead called everything consecutively, dumping the article list into each function by turn -- cache, agent, server -- and filtering the list according to which headers we get back. But that's another patch for another time. ^ permalink raw reply [flat|nested] 29+ messages in thread
* bug#38011: 27.0.50; [PATCH] WIP on allowing Gnus backends to return header data directly 2021-01-02 20:49 ` Eric Abrahamsen @ 2021-01-03 7:45 ` Lars Ingebrigtsen 2021-01-03 19:53 ` Eric Abrahamsen 2021-01-03 19:54 ` Eric Abrahamsen 0 siblings, 2 replies; 29+ messages in thread From: Lars Ingebrigtsen @ 2021-01-03 7:45 UTC (permalink / raw) To: Eric Abrahamsen; +Cc: 38011 Eric Abrahamsen <eric@ericabrahamsen.net> writes: > Sure thing. It's in girzel/gnus-headers now. I made a few more sneaky > last minute changes, so yes... testing is in order. I'm now running this branch, and good news: No breakages so far. :-) > It gets complicated because the cache and the agent need to mix their > saved headers into whatever newly-fetched headers we get from the > server. So instead of having them call `gnus-retrieve-headers' and > mixing their cached text into the nntp-server-buffer, they now call > `gnus-fetch-headers' on the server, which actually returns real headers. Yes, that was the main bit I was unsure of. The braiding stuff tries to be efficient and avoid parsing things twice (or more) -- you usually get a bunch of headers from the NNTP server, and then you have even more headers in the agent/cache, and it stitches them all together as text, and parses the resulting mess. (If I remember correctly; it's been at least a decade since I looked at that code.) Are headers parsed more than once now and then merged? -- (domestic pets only, the antidote for overdose, milk.) bloggy blog: http://lars.ingebrigtsen.no ^ permalink raw reply [flat|nested] 29+ messages in thread
* bug#38011: 27.0.50; [PATCH] WIP on allowing Gnus backends to return header data directly 2021-01-03 7:45 ` Lars Ingebrigtsen @ 2021-01-03 19:53 ` Eric Abrahamsen 2021-01-04 9:05 ` Lars Ingebrigtsen 2021-01-03 19:54 ` Eric Abrahamsen 1 sibling, 1 reply; 29+ messages in thread From: Eric Abrahamsen @ 2021-01-03 19:53 UTC (permalink / raw) To: Lars Ingebrigtsen; +Cc: 38011 On 01/03/21 08:45 AM, Lars Ingebrigtsen wrote: > Eric Abrahamsen <eric@ericabrahamsen.net> writes: > >> Sure thing. It's in girzel/gnus-headers now. I made a few more sneaky >> last minute changes, so yes... testing is in order. > > I'm now running this branch, and good news: No breakages so far. :-) Great! >> It gets complicated because the cache and the agent need to mix their >> saved headers into whatever newly-fetched headers we get from the >> server. So instead of having them call `gnus-retrieve-headers' and >> mixing their cached text into the nntp-server-buffer, they now call >> `gnus-fetch-headers' on the server, which actually returns real headers. > > Yes, that was the main bit I was unsure of. The braiding stuff tries to > be efficient and avoid parsing things twice (or more) -- you usually get > a bunch of headers from the NNTP server, and then you have even more > headers in the agent/cache, and it stitches them all together as text, > and parses the resulting mess. (If I remember correctly; it's been at > least a decade since I looked at that code.) > > Are headers parsed more than once now and then merged? I certainly hope they're not parsed more than once, but it would definitely be good to have more eyes on that part of the code. For instance, `gnus-cache-retrieve-headers' finds cached articles in the group, then uses (gnus-sorted-difference articles cached) to find uncached articles. The uncached articles are sent to `gnus-fetch-headers', and the cached articles are parsed from the cache file using: (gnus-get-newsgroup-headers-xover (gnus-sorted-difference cached uncached-articles)) Then the two sets of headers are merged and sorted. The agent does something similar. I don't think the parsing should do any duplicate work, though it's possible that adding the newly-received headers back into the cache file is not optimal: it appends the new headers at the end of the buffer, then re-sorts the whole buffer. Crud, I just realized that the agent will re-sort its cache file using gnus-agent-check-overview-buffer ^ permalink raw reply [flat|nested] 29+ messages in thread
* bug#38011: 27.0.50; [PATCH] WIP on allowing Gnus backends to return header data directly 2021-01-03 19:53 ` Eric Abrahamsen @ 2021-01-04 9:05 ` Lars Ingebrigtsen 2021-01-04 18:09 ` Eric Abrahamsen 0 siblings, 1 reply; 29+ messages in thread From: Lars Ingebrigtsen @ 2021-01-04 9:05 UTC (permalink / raw) To: Eric Abrahamsen; +Cc: 38011 Eric Abrahamsen <eric@ericabrahamsen.net> writes: > I certainly hope they're not parsed more than once, but it would > definitely be good to have more eyes on that part of the code. For > instance, `gnus-cache-retrieve-headers' finds cached articles in the > group, then uses (gnus-sorted-difference articles cached) to find > uncached articles. The uncached articles are sent to > `gnus-fetch-headers', and the cached articles are parsed from the cache > file using: So that sounds OK... is it the same with the Agent? -- (domestic pets only, the antidote for overdose, milk.) bloggy blog: http://lars.ingebrigtsen.no ^ permalink raw reply [flat|nested] 29+ messages in thread
* bug#38011: 27.0.50; [PATCH] WIP on allowing Gnus backends to return header data directly 2021-01-04 9:05 ` Lars Ingebrigtsen @ 2021-01-04 18:09 ` Eric Abrahamsen 2021-01-05 8:47 ` Lars Ingebrigtsen 0 siblings, 1 reply; 29+ messages in thread From: Eric Abrahamsen @ 2021-01-04 18:09 UTC (permalink / raw) To: Lars Ingebrigtsen; +Cc: 38011 On 01/04/21 10:05 AM, Lars Ingebrigtsen wrote: > Eric Abrahamsen <eric@ericabrahamsen.net> writes: > >> I certainly hope they're not parsed more than once, but it would >> definitely be good to have more eyes on that part of the code. For >> instance, `gnus-cache-retrieve-headers' finds cached articles in the >> group, then uses (gnus-sorted-difference articles cached) to find >> uncached articles. The uncached articles are sent to >> `gnus-fetch-headers', and the cached articles are parsed from the cache >> file using: > > So that sounds OK... is it the same with the Agent? Morally the same: the agent has its own `gnus-agent-uncached-articles' function, which consults the .agentview file, so it uses that instead of `gnus-sorted-difference'. But the same idea. (I saw the other bug report about nnmaildir and nov entries, once this patch is in I'm planning on working on nnmaildir next.) ^ permalink raw reply [flat|nested] 29+ messages in thread
* bug#38011: 27.0.50; [PATCH] WIP on allowing Gnus backends to return header data directly 2021-01-04 18:09 ` Eric Abrahamsen @ 2021-01-05 8:47 ` Lars Ingebrigtsen 2021-01-05 17:02 ` Eric Abrahamsen 0 siblings, 1 reply; 29+ messages in thread From: Lars Ingebrigtsen @ 2021-01-05 8:47 UTC (permalink / raw) To: Eric Abrahamsen; +Cc: 38011 Eric Abrahamsen <eric@ericabrahamsen.net> writes: > Morally the same: the agent has its own `gnus-agent-uncached-articles' > function, which consults the .agentview file, so it uses that instead of > `gnus-sorted-difference'. But the same idea. Right. > (I saw the other bug report about nnmaildir and nov entries, once this > patch is in I'm planning on working on nnmaildir next.) Great; nnmaildir needs some tender love and care. Or... a complete rewrite. :-) -- (domestic pets only, the antidote for overdose, milk.) bloggy blog: http://lars.ingebrigtsen.no ^ permalink raw reply [flat|nested] 29+ messages in thread
* bug#38011: 27.0.50; [PATCH] WIP on allowing Gnus backends to return header data directly 2021-01-05 8:47 ` Lars Ingebrigtsen @ 2021-01-05 17:02 ` Eric Abrahamsen 2021-01-17 5:00 ` Eric Abrahamsen 0 siblings, 1 reply; 29+ messages in thread From: Eric Abrahamsen @ 2021-01-05 17:02 UTC (permalink / raw) To: Lars Ingebrigtsen; +Cc: 38011 On 01/05/21 09:47 AM, Lars Ingebrigtsen wrote: > Eric Abrahamsen <eric@ericabrahamsen.net> writes: > >> Morally the same: the agent has its own `gnus-agent-uncached-articles' >> function, which consults the .agentview file, so it uses that instead of >> `gnus-sorted-difference'. But the same idea. > > Right. > >> (I saw the other bug report about nnmaildir and nov entries, once this >> patch is in I'm planning on working on nnmaildir next.) > > Great; nnmaildir needs some tender love and care. Or... a complete > rewrite. :-) Well that doesn't sound like very much fun! I was planning on doing the header return thing, and then providing more options for incrementally building the nov cache files, as the main user complaint seems to be that adopting large collections of messages can result in hours and hours of caching. Then adapting nnmaildir to actually use Gnus' OO stuff, whether that's deffoo or generic functions. Over the years I've gotten the impression that edits purely for coding style are discouraged, but nnmaildir's weird semi-imperative style is *so* hard to parse I think it would be worth just trying to clear some of that out, as well. Anyway, I'll keep looking at this patch for a bit, and see if I can find any more problems with it. ^ permalink raw reply [flat|nested] 29+ messages in thread
* bug#38011: 27.0.50; [PATCH] WIP on allowing Gnus backends to return header data directly 2021-01-05 17:02 ` Eric Abrahamsen @ 2021-01-17 5:00 ` Eric Abrahamsen 2021-01-18 10:48 ` Robert Pluim 2021-01-18 16:37 ` Lars Ingebrigtsen 0 siblings, 2 replies; 29+ messages in thread From: Eric Abrahamsen @ 2021-01-17 5:00 UTC (permalink / raw) To: Lars Ingebrigtsen; +Cc: 38011 Eric Abrahamsen <eric@ericabrahamsen.net> writes: > On 01/05/21 09:47 AM, Lars Ingebrigtsen wrote: >> Eric Abrahamsen <eric@ericabrahamsen.net> writes: >> >>> Morally the same: the agent has its own `gnus-agent-uncached-articles' >>> function, which consults the .agentview file, so it uses that instead of >>> `gnus-sorted-difference'. But the same idea. >> >> Right. [...] > Anyway, I'll keep looking at this patch for a bit, and see if I can find > any more problems with it. I found a couple more, in agent file writing, and have pushed a commit fixing that. So far as I can tell this now works as intended. I've run side-by-side comparisons of master and this feature branch, messing with the cache and the agent, and feel fairly confident that behavior is the same in terms of header fetching, and files written to disk. I think I'd feel okay merging this, but would also be happy to let it mellow longer. Eric ^ permalink raw reply [flat|nested] 29+ messages in thread
* bug#38011: 27.0.50; [PATCH] WIP on allowing Gnus backends to return header data directly 2021-01-17 5:00 ` Eric Abrahamsen @ 2021-01-18 10:48 ` Robert Pluim 2021-01-18 21:12 ` Eric Abrahamsen 2021-01-18 16:37 ` Lars Ingebrigtsen 1 sibling, 1 reply; 29+ messages in thread From: Robert Pluim @ 2021-01-18 10:48 UTC (permalink / raw) To: Eric Abrahamsen; +Cc: Lars Ingebrigtsen, 38011 >>>>> On Sat, 16 Jan 2021 21:00:36 -0800, Eric Abrahamsen <eric@ericabrahamsen.net> said: Eric> Eric Abrahamsen <eric@ericabrahamsen.net> writes: >> On 01/05/21 09:47 AM, Lars Ingebrigtsen wrote: >>> Eric Abrahamsen <eric@ericabrahamsen.net> writes: >>> >>>> Morally the same: the agent has its own `gnus-agent-uncached-articles' >>>> function, which consults the .agentview file, so it uses that instead of >>>> `gnus-sorted-difference'. But the same idea. >>> >>> Right. Eric> [...] >> Anyway, I'll keep looking at this patch for a bit, and see if I can find >> any more problems with it. Eric> I found a couple more, in agent file writing, and have pushed a commit Eric> fixing that. So far as I can tell this now works as intended. I've run Eric> side-by-side comparisons of master and this feature branch, messing with Eric> the cache and the agent, and feel fairly confident that behavior is the Eric> same in terms of header fetching, and files written to disk. I think I'd Eric> feel okay merging this, but would also be happy to let it mellow longer. I think previous experience shows that the only way to find bugs in this kind of code is to foist it on us :-) Robert ^ permalink raw reply [flat|nested] 29+ messages in thread
* bug#38011: 27.0.50; [PATCH] WIP on allowing Gnus backends to return header data directly 2021-01-18 10:48 ` Robert Pluim @ 2021-01-18 21:12 ` Eric Abrahamsen 0 siblings, 0 replies; 29+ messages in thread From: Eric Abrahamsen @ 2021-01-18 21:12 UTC (permalink / raw) To: Robert Pluim; +Cc: Lars Ingebrigtsen, 38011-done Robert Pluim <rpluim@gmail.com> writes: >>>>>> On Sat, 16 Jan 2021 21:00:36 -0800, Eric Abrahamsen <eric@ericabrahamsen.net> said: > > Eric> Eric Abrahamsen <eric@ericabrahamsen.net> writes: > >> On 01/05/21 09:47 AM, Lars Ingebrigtsen wrote: > >>> Eric Abrahamsen <eric@ericabrahamsen.net> writes: > >>> > >>>> Morally the same: the agent has its own `gnus-agent-uncached-articles' > >>>> function, which consults the .agentview file, so it uses that instead of > >>>> `gnus-sorted-difference'. But the same idea. > >>> > >>> Right. > > Eric> [...] > > >> Anyway, I'll keep looking at this patch for a bit, and see if I can find > >> any more problems with it. > > Eric> I found a couple more, in agent file writing, and have pushed a commit > Eric> fixing that. So far as I can tell this now works as intended. I've run > Eric> side-by-side comparisons of master and this feature branch, messing with > Eric> the cache and the agent, and feel fairly confident that behavior is the > Eric> same in terms of header fetching, and files written to disk. I think I'd > Eric> feel okay merging this, but would also be happy to let it mellow longer. > > I think previous experience shows that the only way to find bugs in > this kind of code is to foist it on us :-) Bombs away, then! ^ permalink raw reply [flat|nested] 29+ messages in thread
* bug#38011: 27.0.50; [PATCH] WIP on allowing Gnus backends to return header data directly 2021-01-17 5:00 ` Eric Abrahamsen 2021-01-18 10:48 ` Robert Pluim @ 2021-01-18 16:37 ` Lars Ingebrigtsen 1 sibling, 0 replies; 29+ messages in thread From: Lars Ingebrigtsen @ 2021-01-18 16:37 UTC (permalink / raw) To: Eric Abrahamsen; +Cc: 38011 Eric Abrahamsen <eric@ericabrahamsen.net> writes: > I found a couple more, in agent file writing, and have pushed a commit > fixing that. So far as I can tell this now works as intended. I've run > side-by-side comparisons of master and this feature branch, messing with > the cache and the agent, and feel fairly confident that behavior is the > same in terms of header fetching, and files written to disk. I think I'd > feel okay merging this, but would also be happy to let it mellow longer. Sure, go ahead. -- (domestic pets only, the antidote for overdose, milk.) bloggy blog: http://lars.ingebrigtsen.no ^ permalink raw reply [flat|nested] 29+ messages in thread
* bug#38011: 27.0.50; [PATCH] WIP on allowing Gnus backends to return header data directly 2021-01-03 7:45 ` Lars Ingebrigtsen 2021-01-03 19:53 ` Eric Abrahamsen @ 2021-01-03 19:54 ` Eric Abrahamsen 2021-01-03 21:38 ` Eric Abrahamsen 1 sibling, 1 reply; 29+ messages in thread From: Eric Abrahamsen @ 2021-01-03 19:54 UTC (permalink / raw) To: Lars Ingebrigtsen; +Cc: 38011 On 01/03/21 08:45 AM, Lars Ingebrigtsen wrote: > Eric Abrahamsen <eric@ericabrahamsen.net> writes: > >> Sure thing. It's in girzel/gnus-headers now. I made a few more sneaky >> last minute changes, so yes... testing is in order. > > I'm now running this branch, and good news: No breakages so far. :-) Great! >> It gets complicated because the cache and the agent need to mix their >> saved headers into whatever newly-fetched headers we get from the >> server. So instead of having them call `gnus-retrieve-headers' and >> mixing their cached text into the nntp-server-buffer, they now call >> `gnus-fetch-headers' on the server, which actually returns real headers. > > Yes, that was the main bit I was unsure of. The braiding stuff tries to > be efficient and avoid parsing things twice (or more) -- you usually get > a bunch of headers from the NNTP server, and then you have even more > headers in the agent/cache, and it stitches them all together as text, > and parses the resulting mess. (If I remember correctly; it's been at > least a decade since I looked at that code.) > > Are headers parsed more than once now and then merged? I certainly hope they're not parsed more than once, but it would definitely be good to have more eyes on that part of the code. For instance, `gnus-cache-retrieve-headers' finds cached articles in the group, then uses (gnus-sorted-difference articles cached) to find uncached articles. The uncached articles are sent to `gnus-fetch-headers', and the cached articles are parsed from the cache file using: (gnus-get-newsgroup-headers-xover (gnus-sorted-difference cached uncached-articles)) Then the two sets of headers are merged and sorted. The agent does something similar. I don't think the parsing should do any duplicate work, though it's possible that adding the newly-received headers back into the cache file is not optimal: it appends the new headers at the end of the buffer, then re-sorts the whole buffer. Crud, I just realized that the agent will re-sort its cache file using `gnus-agent-check-overview-buffer', but gnus-cache doesn't do anything similar. So the write process will have to insert the new headers into the buffer in sorted order. Eric ^ permalink raw reply [flat|nested] 29+ messages in thread
* bug#38011: 27.0.50; [PATCH] WIP on allowing Gnus backends to return header data directly 2021-01-03 19:54 ` Eric Abrahamsen @ 2021-01-03 21:38 ` Eric Abrahamsen 0 siblings, 0 replies; 29+ messages in thread From: Eric Abrahamsen @ 2021-01-03 21:38 UTC (permalink / raw) To: Lars Ingebrigtsen; +Cc: 38011 Eric Abrahamsen <eric@ericabrahamsen.net> writes: > On 01/03/21 08:45 AM, Lars Ingebrigtsen wrote: >> Eric Abrahamsen <eric@ericabrahamsen.net> writes: >> >>> Sure thing. It's in girzel/gnus-headers now. I made a few more sneaky >>> last minute changes, so yes... testing is in order. >> >> I'm now running this branch, and good news: No breakages so far. :-) > > Great! > >>> It gets complicated because the cache and the agent need to mix their >>> saved headers into whatever newly-fetched headers we get from the >>> server. So instead of having them call `gnus-retrieve-headers' and >>> mixing their cached text into the nntp-server-buffer, they now call >>> `gnus-fetch-headers' on the server, which actually returns real headers. >> >> Yes, that was the main bit I was unsure of. The braiding stuff tries to >> be efficient and avoid parsing things twice (or more) -- you usually get >> a bunch of headers from the NNTP server, and then you have even more >> headers in the agent/cache, and it stitches them all together as text, >> and parses the resulting mess. (If I remember correctly; it's been at >> least a decade since I looked at that code.) >> >> Are headers parsed more than once now and then merged? > > I certainly hope they're not parsed more than once, but it would > definitely be good to have more eyes on that part of the code. For > instance, `gnus-cache-retrieve-headers' finds cached articles in the > group, then uses (gnus-sorted-difference articles cached) to find > uncached articles. The uncached articles are sent to > `gnus-fetch-headers', and the cached articles are parsed from the cache > file using: > > (gnus-get-newsgroup-headers-xover > (gnus-sorted-difference > cached uncached-articles)) > > Then the two sets of headers are merged and sorted. The agent does > something similar. I don't think the parsing should do any duplicate > work, though it's possible that adding the newly-received headers back > into the cache file is not optimal: it appends the new headers at the end > of the buffer, then re-sorts the whole buffer. > > Crud, I just realized that the agent will re-sort its cache file using > `gnus-agent-check-overview-buffer', but gnus-cache doesn't do anything > similar. So the write process will have to insert the new headers into > the buffer in sorted order. Oh hang on, we're not supposed to be adding any new headers to the gnus-cache cache files here at all. So that chunk of code can just be removed. Just when you thought you had a handle on what was happening... ^ permalink raw reply [flat|nested] 29+ messages in thread
end of thread, other threads:[~2021-01-18 21:12 UTC | newest] Thread overview: 29+ messages (download: mbox.gz follow: Atom feed -- links below jump to the message on this page -- 2019-10-31 21:34 bug#38011: 27.0.50; [PATCH] WIP on allowing Gnus backends to return header data directly Eric Abrahamsen 2019-11-01 14:12 ` Lars Ingebrigtsen 2019-11-01 18:41 ` Eric Abrahamsen 2019-11-01 20:52 ` Eric Abrahamsen 2019-11-02 14:49 ` Lars Ingebrigtsen 2019-11-07 23:21 ` Eric Abrahamsen 2019-11-08 21:03 ` Lars Ingebrigtsen 2019-11-08 21:43 ` Eric Abrahamsen 2019-11-08 21:58 ` Lars Ingebrigtsen 2020-03-29 19:50 ` Eric Abrahamsen 2020-04-30 4:50 ` Lars Ingebrigtsen 2020-09-27 4:13 ` Eric Abrahamsen 2020-09-27 12:16 ` Lars Ingebrigtsen 2020-09-27 23:41 ` Eric Abrahamsen 2021-01-02 3:18 ` Eric Abrahamsen 2021-01-02 5:59 ` Lars Ingebrigtsen 2021-01-02 20:49 ` Eric Abrahamsen 2021-01-03 7:45 ` Lars Ingebrigtsen 2021-01-03 19:53 ` Eric Abrahamsen 2021-01-04 9:05 ` Lars Ingebrigtsen 2021-01-04 18:09 ` Eric Abrahamsen 2021-01-05 8:47 ` Lars Ingebrigtsen 2021-01-05 17:02 ` Eric Abrahamsen 2021-01-17 5:00 ` Eric Abrahamsen 2021-01-18 10:48 ` Robert Pluim 2021-01-18 21:12 ` Eric Abrahamsen 2021-01-18 16:37 ` Lars Ingebrigtsen 2021-01-03 19:54 ` Eric Abrahamsen 2021-01-03 21:38 ` Eric Abrahamsen
Code repositories for project(s) associated with this external index https://git.savannah.gnu.org/cgit/emacs.git https://git.savannah.gnu.org/cgit/emacs/org-mode.git This is an external index of several public inboxes, see mirroring instructions on how to clone and mirror all data and code used by this external index.