unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
From: Eric Abrahamsen <eric@ericabrahamsen.net>
To: Lars Ingebrigtsen <larsi@gnus.org>
Cc: 38011@debbugs.gnu.org
Subject: bug#38011: 27.0.50; [PATCH] WIP on allowing Gnus backends to return header data directly
Date: Sun, 27 Sep 2020 16:41:41 -0700	[thread overview]
Message-ID: <87h7rikcsq.fsf@ericabrahamsen.net> (raw)
In-Reply-To: <87a6xb5sa7.fsf@gnus.org> (Lars Ingebrigtsen's message of "Sun, 27 Sep 2020 14:16:16 +0200")

[-- 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


  reply	other threads:[~2020-09-27 23:41 UTC|newest]

Thread overview: 29+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
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 [this message]
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

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://www.gnu.org/software/emacs/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=87h7rikcsq.fsf@ericabrahamsen.net \
    --to=eric@ericabrahamsen.net \
    --cc=38011@debbugs.gnu.org \
    --cc=larsi@gnus.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

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

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