Fix errors when nnselect-always-regenerate is t (bug#61539)

The group parameter nnselect-always-regenerate causes the list of
articles in the group to be generated each time it is needed. For this
to work reliably the list of articles has to be generated at the
appropriate time and to have a reproducible ordering.

* lisp/gnus/gnus-search.el (gnus-search-run-search): For nnselect
groups if the article list has not been stored, regenerate it.
* lisp/gnus/nnselect.el (nnselect-generate-artlist): Sort the
generated list of articles by RSV, group, and number.  Store the
artlist after generation. When the new optional argument INFO is
non-nil, update the group info.
(nnselect-compress-artlist, nnselect-uncompress-artlist): Preserve the
article list ordering.
(nnselect-get-artlist): Return nil when nnselect-always-regenerate is t.
(nnselect-store-artlist): Store the group active range along with the
artlist. Don't keep the artlist if nnselect-always-regenerate is t.
(nnselect-request-group): The full article list isn't needed at this
stage, only the active range.
(nnselect-retrieve-headers): Regenerate the article list if there
is no stored value. Inhibit gnus-demon while retrieving headers.
(nnselect-request-group-scan): Don't generate the article list when
nnselect-always-regenerate is t since it will be generated again later
on.
(nnselect-request-create-group): Allow the artlist to be passed as an
argument to the function. Update the group info and store the artlist.

diff --git a/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el
index 71980afa0ff45123f73759ad73b09d0dd350de05..12d9dacf13298b4b6dff3b134764362df9457e41 100644 (file)
--- a/lisp/gnus/gnus-search.el
+++ b/lisp/gnus/gnus-search.el
@@ -1066,7 +1066,9 @@ Responsible for handling and, or, and parenthetical expressions.")
                                      _srv query-spec groups)
   (let ((artlist []))
     (dolist (group groups)
-      (let* ((gnus-newsgroup-selection (nnselect-get-artlist group))
+      (let* ((gnus-newsgroup-selection
+              (or
+               (nnselect-get-artlist group) (nnselect-generate-artlist group)))
              (group-spec
               (nnselect-categorize
                (mapcar 'car

diff --git a/lisp/gnus/nnselect.el b/lisp/gnus/nnselect.el
index 3db083c051123c27e071ad4271c4a2345822d87b..c4fbe3a5bd2ff44959f6824549d2f5381fc2aefc 100644 (file)
--- a/lisp/gnus/nnselect.el
+++ b/lisp/gnus/nnselect.el
@@ -86,14 +86,14 @@
     (let (selection)
       (pcase-dolist (`(,artgroup . ,arts)
                      (nnselect-categorize artlist #'nnselect-artitem-group))
-       (let (list)
+        (let (list)
           (pcase-dolist (`(,rsv . ,articles)
-                        (nnselect-categorize
+                         (nnselect-categorize
                           arts #'nnselect-artitem-rsv #'nnselect-artitem-number))
             (push (cons rsv (gnus-compress-sequence (sort articles #'<)))
                   list))
-          (push (cons artgroup list) selection)))
-      selection)))
+          (push (cons artgroup (sort list 'car-less-than-car)) selection)))
+      (sort selection (lambda (x y) (string< (car x) (car y)))))))
 
 (defun nnselect-uncompress-artlist (artlist)
   "Uncompress ARTLIST."
@@ -101,14 +101,16 @@
       artlist
     (let (selection)
       (pcase-dolist (`(,artgroup . ,list) artlist)
-       (pcase-dolist (`(,artrsv . ,artseq) list)
-         (setq selection
-               (vconcat
-                (cl-map 'vector
-                        (lambda (art)
-                           (vector artgroup art artrsv))
-                        (gnus-uncompress-sequence artseq)) selection))))
-      selection)))
+        (pcase-dolist (`(,artrsv . ,artseq) list)
+          (setq selection
+                (vconcat selection
+                         (cl-map 'vector
+                                 (lambda (art)
+                                   (vector artgroup art artrsv))
+                                 (gnus-uncompress-sequence artseq))))))
+      (sort selection
+            (lambda (x y)
+              (< (nnselect-artitem-rsv x) (nnselect-artitem-rsv y)))))))
 
 (make-obsolete 'nnselect-group-server 'gnus-group-server "28.1")
 (make-obsolete 'nnselect-run 'nnselect-generate-artlist "29.1")
@@ -269,45 +271,23 @@ If this variable is nil, or if the provided function returns nil,
   :version "28.1"
   :type '(repeat function))
 
-(defun nnselect-generate-artlist (group &optional specs)
-  "Generate the artlist for GROUP using SPECS.
-SPECS should be an alist including an `nnselect-function' and an
-`nnselect-args'.  The former applied to the latter should create
-the artlist.  If SPECS is nil retrieve the specs from the group
-parameters."
-  (let* ((specs
-          (or specs (gnus-group-get-parameter group 'nnselect-specs t)))
-         (function (alist-get 'nnselect-function specs))
-         (args (alist-get 'nnselect-args specs)))
-    (condition-case-unless-debug err
-        (funcall function args)
-      ;; Don't swallow gnus-search errors; the user should be made
-      ;; aware of them.
-      (gnus-search-error
-       (signal (car err) (cdr err)))
-      (error
-       (gnus-error
-        3
-        "nnselect-generate-artlist: %s on %s gave error %s" function args err)
-       []))))
-
 (defmacro nnselect-get-artlist (group)
-  "Get the list of articles for GROUP.
-If the group parameter `nnselect-get-artlist-override-function' is
-non-nil call this function with argument GROUP to get the
+  "Get the stored list of articles for GROUP.
+If the group parameter `nnselect-get-artlist-override-function'
+is non-nil call this function with argument GROUP to get the
 artlist; if the group parameter `nnselect-always-regenerate' is
-non-nil, regenerate the artlist; otherwise retrieve the artlist
-directly from the group parameters."
+non-nil, return nil to regenerate the artlist; otherwise retrieve
+the stored artlist from the group parameters."
   `(when (gnus-nnselect-group-p ,group)
      (let ((override (gnus-group-get-parameter
-                    ,group
-                    'nnselect-get-artlist-override-function)))
+                      ,group
+                      'nnselect-get-artlist-override-function)))
        (cond
         (override (funcall override ,group))
         ((gnus-group-get-parameter ,group 'nnselect-always-regenerate)
-         (nnselect-generate-artlist ,group))
+         nil)
         (t
-        (nnselect-uncompress-artlist
+         (nnselect-uncompress-artlist
           (gnus-group-get-parameter ,group 'nnselect-artlist t)))))))
 
 (defmacro nnselect-store-artlist  (group artlist)
@@ -315,17 +295,65 @@ directly from the group parameters."
 If the group parameter `nnselect-store-artlist-override-function'
 is non-nil call this function on GROUP and ARTLIST; if the group
 parameter `nnselect-always-regenerate' is non-nil don't store the
-artlist; otherwise store the ARTLIST in the group parameters."
+artlist; otherwise store the ARTLIST in the group parameters.
+The active range is also stored."
   `(let ((override (gnus-group-get-parameter
-                   ,group
-                   'nnselect-store-artlist-override-function)))
+                    ,group
+                    'nnselect-store-artlist-override-function)))
+     (gnus-group-set-parameter ,group 'active
+                               (cons 1 (nnselect-artlist-length ,artlist)))
      (cond
       (override         (funcall override ,group ,artlist))
-      ((gnus-group-get-parameter ,group 'nnselect-always-regenerate) t)
+      ((gnus-group-get-parameter ,group 'nnselect-always-regenerate)
+       (gnus-group-remove-parameter ,group 'nnselect-artlist))
       (t
        (gnus-group-set-parameter ,group 'nnselect-artlist
                                  (nnselect-compress-artlist ,artlist))))))
 
+(defun nnselect-generate-artlist (group &optional specs info)
+  "Generate and return the artlist for GROUP using SPECS.
+The artlist is sorted by rsv, lexically over groups, and by
+article number.  SPECS should be an alist including an
+`nnselect-function' and an `nnselect-args'.  The former applied
+to the latter should create the artlist.  If SPECS is nil
+retrieve the specs from the group parameters.  If INFO update the
+group info."
+  (let* ((specs
+          (or specs (gnus-group-get-parameter group 'nnselect-specs t)))
+         (function (alist-get 'nnselect-function specs))
+         (args (alist-get 'nnselect-args specs)))
+    (condition-case-unless-debug err
+        (progn
+          (let ((gnus-newsgroup-selection
+                 (sort
+                  (funcall function args)
+                  (lambda (x y)
+                    (let ((xgroup (nnselect-artitem-group x))
+                          (ygroup (nnselect-artitem-group y))
+                          (xrsv (nnselect-artitem-rsv x))
+                          (yrsv (nnselect-artitem-rsv y)))
+                      (or (< xrsv yrsv)
+                          (and (eql xrsv yrsv)
+                               (or (string<  xgroup ygroup)
+                                   (and (string= xgroup ygroup)
+                                        (< (nnselect-artitem-number x)
+                                           (nnselect-artitem-number y)))))))))))
+            (when info
+              (if gnus-newsgroup-selection
+                  (nnselect-request-update-info group info)
+                (gnus-set-active group '(1 . 0))))
+            (nnselect-store-artlist group gnus-newsgroup-selection)
+            gnus-newsgroup-selection))
+      ;; Don't swallow gnus-search errors; the user should be made
+      ;; aware of them.
+      (gnus-search-error
+       (signal (car err) (cdr err)))
+      (error
+       (gnus-error
+        3
+        "nnselect-generate-artlist: %s on %s gave error %s" function args err)
+       []))))
+
 ;; Gnus backend interface functions.
 
 (deffoo nnselect-open-server (server &optional definitions)
@@ -346,85 +374,82 @@ artlist; otherwise store the ARTLIST in the group parameters."
 
 (deffoo nnselect-request-group (group &optional _server _dont-check info)
   (let* ((group (nnselect-add-prefix group))
-        (nnselect-artlist (nnselect-get-artlist group))
-        length)
-    ;; Check for cached select result or run the selection and cache
-    ;; the result.
-    (unless nnselect-artlist
-      (nnselect-store-artlist group
-       (setq nnselect-artlist (nnselect-generate-artlist group)))
-      (nnselect-request-update-info
-       group (or info (gnus-get-info group))))
-    (if (zerop (setq length (nnselect-artlist-length nnselect-artlist)))
-       (progn
-         (nnheader-report 'nnselect "Selection produced empty results.")
-         (when (gnus-ephemeral-group-p group)
-           (gnus-kill-ephemeral-group group)
-           (setq gnus-ephemeral-servers
-                 (assq-delete-all 'nnselect gnus-ephemeral-servers)))
-         (nnheader-insert ""))
+         (length (cdr (gnus-group-get-parameter group 'active t))))
+    (when (or (null length)
+              (gnus-group-get-parameter group 'nnselect-always-regenerate))
+      (setq length (nnselect-artlist-length
+                    (nnselect-generate-artlist group nil info))))
+    (if (and (zerop length) (gnus-ephemeral-group-p group))
+        (progn
+          (nnheader-report 'nnselect "Selection produced empty results.")
+          (gnus-kill-ephemeral-group group)
+          (setq gnus-ephemeral-servers
+                (assq-delete-all 'nnselect gnus-ephemeral-servers))
+          (nnheader-insert ""))
       (with-current-buffer nntp-server-buffer
-       (nnheader-insert "211 %d %d %d %s\n"
-                         length    ; total #
-                         1         ; first #
-                         length    ; last #
-                         group))) ; group name
-  nnselect-artlist))
-
+        (nnheader-insert "211 %d %d %d %s\n"
+                         length                  ; total #
+                         (if (zerop length) 0 1) ; first #
+                         length                  ; last #
+                         group)))))              ; group name
 
 (deffoo nnselect-retrieve-headers (articles group &optional _server fetch-old)
-  (let ((group (nnselect-add-prefix group)))
+  (let ((group (nnselect-add-prefix group))
+        (gnus-inhibit-demon t))
     (with-current-buffer (gnus-summary-buffer-name group)
-      (setq gnus-newsgroup-selection (or gnus-newsgroup-selection
-                                        (nnselect-get-artlist group)))
-      (let ((gnus-inhibit-demon t)
-           (gartids (ids-by-group articles))
-           headers)
-       (with-current-buffer nntp-server-buffer
-         (pcase-dolist (`(,artgroup . ,artids) gartids)
-           (let ((artlist (sort (mapcar #'cdr artids) #'<))
-                 (gnus-override-method (gnus-find-method-for-group artgroup))
-                 (fetch-old
-                  (or
-                   (car-safe
-                    (gnus-group-find-parameter artgroup
-                                               'gnus-fetch-old-headers t))
-                   fetch-old)))
+      (setq gnus-newsgroup-selection
+            (or gnus-newsgroup-selection
+                (nnselect-get-artlist group)
+                ;; maybe don't need to update the info?
+                ;; (nnselect-generate-artlist group nil (gnus-get-info group))))
+                (nnselect-generate-artlist group)))
+      (let ((gartids (ids-by-group articles))
+            headers)
+        (with-current-buffer nntp-server-buffer
+          (pcase-dolist (`(,artgroup . ,artids) gartids)
+            (let ((artlist (sort (mapcar #'cdr artids) #'<))
+                  (gnus-override-method (gnus-find-method-for-group artgroup))
+                  (fetch-old
+                   (or
+                    (car-safe
+                     (gnus-group-find-parameter artgroup
+                                                'gnus-fetch-old-headers t))
+                    fetch-old)))
               (gnus-request-group artgroup)
-             (erase-buffer)
-             (pcase (setq gnus-headers-retrieved-by
-                          (or
-                           (and
-                            nnselect-retrieve-headers-override-function
-                            (funcall
-                             nnselect-retrieve-headers-override-function
-                             artlist artgroup))
-                           (gnus-retrieve-headers
-                            artlist artgroup fetch-old)))
-               ('nov
-                (goto-char (point-min))
-                (while (not (eobp))
-                  (nnselect-add-novitem
-                   (nnheader-parse-nov))
-                  (forward-line 1)))
-               ('headers
-                (gnus-run-hooks 'gnus-parse-headers-hook)
-                (let ((nnmail-extra-headers gnus-extra-headers))
-                  (goto-char (point-min))
-                  (while (not (eobp))
-                    (nnselect-add-novitem
-                     (nnheader-parse-head))
-                    (forward-line 1))))
-               ((pred listp)
-                (dolist (novitem gnus-headers-retrieved-by)
-                  (nnselect-add-novitem novitem)))
-               (_ (error "Unknown header type %s while requesting articles \
-                    of group %s" gnus-headers-retrieved-by artgroup)))))
-         (setq headers
-               (sort
-                headers
-                (lambda (x y)
-                  (< (mail-header-number x) (mail-header-number y))))))))))
+              (erase-buffer)
+              (pcase (setq gnus-headers-retrieved-by
+                           (or
+                            (and
+                             nnselect-retrieve-headers-override-function
+                             (funcall
+                              nnselect-retrieve-headers-override-function
+                              artlist artgroup))
+                            (gnus-retrieve-headers
+                             artlist artgroup fetch-old)))
+                ('nov
+                 (goto-char (point-min))
+                 (while (not (eobp))
+                   (nnselect-add-novitem
+                    (nnheader-parse-nov))
+                   (forward-line 1)))
+                ('headers
+                 (gnus-run-hooks 'gnus-parse-headers-hook)
+                 (let ((nnmail-extra-headers gnus-extra-headers))
+                   (goto-char (point-min))
+                   (while (not (eobp))
+                     (nnselect-add-novitem
+                      (nnheader-parse-head))
+                     (forward-line 1))))
+                ((pred listp)
+                 (dolist (novitem gnus-headers-retrieved-by)
+                   (nnselect-add-novitem novitem)))
+                (_ (error "Unknown header type %s while requesting articles \
+                  of group %s" gnus-headers-retrieved-by artgroup)))))
+          (setq headers
+                (sort
+                 headers
+                 (lambda (x y)
+                   (< (mail-header-number x) (mail-header-number y))))))))))
 
 
 (deffoo nnselect-request-article (article &optional _group server to-buffer)
@@ -779,23 +804,23 @@ artlist; otherwise store the ARTLIST in the group parameters."
   (message "Creating nnselect group %s" group)
   (let* ((group (gnus-group-prefixed-name  group '(nnselect "nnselect")))
          (specs (assq 'nnselect-specs args))
+         (artlist (alist-get 'nnselect-artlist args))
          (otherargs (assq-delete-all 'nnselect-specs args))
          (function-spec
           (or  (alist-get 'nnselect-function specs)
-              (intern (completing-read "Function: " obarray #'functionp))))
+               (intern (completing-read "Function: " obarray #'functionp))))
          (args-spec
           (or  (alist-get 'nnselect-args specs)
                (read-from-minibuffer "Args: " nil nil t nil "nil")))
          (nnselect-specs (list (cons 'nnselect-function function-spec)
-                              (cons 'nnselect-args args-spec))))
+                               (cons 'nnselect-args args-spec))))
     (gnus-group-set-parameter group 'nnselect-specs nnselect-specs)
     (dolist (arg otherargs)
       (gnus-group-set-parameter group (car arg) (cdr arg)))
-    (nnselect-store-artlist
-     group
-     (or (alist-get 'nnselect-artlist args)
-        (nnselect-generate-artlist group nnselect-specs)))
-    (nnselect-request-update-info group (gnus-get-info group)))
+    (if artlist
+        (nnselect-store-artlist group artlist)
+      (nnselect-generate-artlist group nnselect-specs
+                                 (gnus-get-info group))))
   t)
 
 
@@ -825,11 +850,12 @@ artlist; otherwise store the ARTLIST in the group parameters."
 
 
 (deffoo nnselect-request-group-scan (group &optional _server _info)
-  (let* ((group (nnselect-add-prefix group))
-        (artlist (nnselect-generate-artlist group)))
-    (gnus-set-active group (cons 1 (nnselect-artlist-length
-                                   artlist)))
-    (nnselect-store-artlist group artlist)))
+  (let ((group (nnselect-add-prefix group)))
+    (unless (gnus-group-find-parameter group 'nnselect-always-regenerate)
+      (let ((artlist (nnselect-generate-artlist group)))
+        (gnus-set-active group (cons 1 (nnselect-artlist-length
+                                        artlist))))))
+  t)
 
 ;; Add any undefined required backend functions