feature/gnus-select2 e841a20 2/2: Allow gnus backends to return a list of headers

[Andrew G Cohen]

branch: feature/gnus-select2
commit e841a206f02bcab97d1fd945548533e374b946c6
Author: Andrew G Cohen <address@hidden>
Commit: Andrew G Cohen <address@hidden>

    Allow gnus backends to return a list of headers
    
    * lisp/gnus/nnselect.el (nnselect-add-novitem): New macro.
    
      (nnselect-retrieve-headers): Allow backends to return headers as a
      list. Return this list rather than re-populating the server buffer
      with 'nov format headers.
    
    * lisp/gnus/gnus-sum.el (gnus-fetch-headers): Allow backends to return
      headers as a list. Make sure the dependencies structure is updated.
---
 lisp/gnus/gnus-sum.el | 42 ++++++++++++++++++++++++++----------------
 lisp/gnus/nnselect.el | 40 ++++++++++++++++++++++------------------
 2 files changed, 48 insertions(+), 34 deletions(-)

diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index e6329ac..f0d6297 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -5646,22 +5646,32 @@ or a straight list of headers."
   "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)))
+      (pcase (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))))
+    ('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)))
 
 (defun gnus-select-newsgroup (group &optional read-all select-articles)
   "Select newsgroup GROUP.
diff --git a/lisp/gnus/nnselect.el b/lisp/gnus/nnselect.el
index 8f5cace..fc2d98b 100644
--- a/lisp/gnus/nnselect.el
+++ b/lisp/gnus/nnselect.el
@@ -65,6 +65,9 @@
 (defvar gnus-inhibit-demon)
 (defvar gnus-message-group-art)
 
+(fset 'nov 'nnheader-parse-nov)
+(fset 'headers 'nnheader-parse-head)
+
 ;; For future use
 (defvoo nnselect-directory gnus-directory
   "Directory for the nnselect backend.")
@@ -218,6 +221,14 @@ as `(keyfunc member)' and the corresponding element is just
      (nnselect-uncompress-artlist
       (gnus-group-get-parameter ,group 'nnselect-artlist t))))
 
+(defmacro nnselect-add-novitem (novitem)
+  `(let* ((novitem ,novitem)
+         (artno (and novitem
+                     (mail-header-number novitem)))
+         (art (car-safe (rassq artno artids))))
+     (when art
+       (setf (mail-header-number novitem) art)
+       (push novitem headers))))
 
 ;;; User Customizable Variables:
 
@@ -296,8 +307,7 @@ If this variable is nil, or if the provided function 
returns nil,
                   (or
                    (car-safe
                     (gnus-group-find-parameter artgroup 
'gnus-fetch-old-headers t))
-                   fetch-old))
-                 parsefunc)
+                   fetch-old)))
              (erase-buffer)
              (pcase (setq gnus-headers-retrieved-by
                           (or
@@ -306,22 +316,17 @@ If this variable is nil, or if the provided function 
returns nil,
                             (funcall 
nnselect-retrieve-headers-override-function
                                      artlist artgroup))
                            (gnus-retrieve-headers artlist artgroup fetch-old)))
-               ('nov
-                (setq parsefunc 'nnheader-parse-nov))
-               ('headers
-                (setq parsefunc 'nnheader-parse-head))
+               ((pred symbol-function)
+                (goto-char (point-min))
+                (while (not (eobp))
+                  (nnselect-add-novitem
+                   (funcall (symbol-function gnus-headers-retrieved-by)))
+                  (forward-line 1)))
+               ((pred listp)
+                (dolist (novitem gnus-headers-retrieved-by)
+                  (nnselect-add-novitem novitem) headers))
                (_ (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 artids))))
-                 (when art
-                   (setf (mail-header-number novitem) art)
-                   (push novitem headers))
-                 (forward-line 1)))))
+                    of group %s" gnus-headers-retrieved-by artgroup)))))
          (setq headers
                (sort headers
                      (lambda (x y)
@@ -330,7 +335,6 @@ If this variable is nil, or if the provided function 
returns nil,
          (mapc 'nnheader-insert-nov headers)
          'nov)))))
 
-
 (deffoo nnselect-request-article (article &optional _group server to-buffer)
   (let* ((gnus-override-method nil)
         servers group-art artlist)