Subject: Re: bug#38011: 27.0.50; [PATCH] WIP on allowing Gnus backends to return header data directly

From: Eric Abrahamsen <[email-masked]>
Date: Fri, 01 Nov 2019 13:52:23 -0700

Eric Abrahamsen <[email-masked]> writes:

> Lars Ingebrigtsen <[email-masked]> writes:
>
>> Eric Abrahamsen <[email-masked]> 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.

>From b184e82d0551fe52a9dcf025b355da7faafc68b2 Mon Sep 17 00:00:00 2001
From: Eric Abrahamsen <[email-masked]>
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