master 3ef54c64fa8: Fix and cleanup nnselect-push-info

[Andrew G Cohen]

branch: master
commit 3ef54c64fa8e7236458228db09fe7192350cbeb6
Author: Andrew G Cohen <cohen@andy.bu.edu>
Commit: Andrew G Cohen <cohen@andy.bu.edu>

    Fix and cleanup nnselect-push-info
    
    * lisp/gnus/nnselect.el (nnselect-push-info): Don't update backend
    marks when quit-config is not nil since gnus-update-marks has already
    been called.  Move checking for unread articles outside the
    gnus-atomic block so it may be interrupted.  Replace let* with let.
    Cleanup code.
---
 lisp/gnus/nnselect.el | 217 +++++++++++++++++++++++++-------------------------
 1 file changed, 107 insertions(+), 110 deletions(-)

diff --git a/lisp/gnus/nnselect.el b/lisp/gnus/nnselect.el
index 57a833de9bf..4eaaffe34a5 100644
--- a/lisp/gnus/nnselect.el
+++ b/lisp/gnus/nnselect.el
@@ -885,13 +885,14 @@ article came from is also searched."
 
 
 
-(defun nnselect-push-info (_group)
+(defun nnselect-push-info (group)
   "Copy mark-lists from GROUP to the originating groups."
   (let ((select-unreads (numbers-by-group gnus-newsgroup-unreads))
         (select-reads (numbers-by-group
                        (gnus-sorted-difference gnus-newsgroup-articles
                                                gnus-newsgroup-unreads)))
         (select-unseen (numbers-by-group gnus-newsgroup-unseen))
+        (quit-config (gnus-group-quit-config group))
         (gnus-newsgroup-active nil) mark-list)
     ;; collect the set of marked article lists categorized by
     ;; originating groups
@@ -903,124 +904,120 @@ article came from is also searched."
           (unless (eq 'tuple mark-type)
             (setq type-list (range-list-intersection
                              gnus-newsgroup-articles type-list)))
-          (push (cons
-                 type
-                 (numbers-by-group type-list mark-type))
+          (push (cons type (numbers-by-group type-list mark-type))
                 mark-list))))
     ;; now work on each originating group one at a time
     (pcase-dolist (`(,artgroup . ,artlist)
-                  (numbers-by-group gnus-newsgroup-articles))
+                   (numbers-by-group gnus-newsgroup-articles))
       (setq artlist (sort artlist #'<))
-      (let* ((group-info (gnus-get-info artgroup))
-            (old-unread (gnus-list-of-unread-articles artgroup))
-            newmarked delta-marks)
-       (when group-info
-         ;; iterate over mark lists for this group
-         (pcase-dolist (`(,_mark . ,type) gnus-article-mark-lists)
-           (let ((list (cdr (assoc artgroup  (alist-get type mark-list))))
-                 (mark-type (gnus-article-mark-to-type type)))
-
-             ;; When the backend can store marks we collect any
-             ;; changes.  Unlike a normal group the mark lists only
-             ;; include marks for articles we retrieved.
-              (when (and (gnus-check-backend-function
-                         'request-set-mark gnus-newsgroup-name)
-                        (not (gnus-article-unpropagatable-p type)))
-               (let* ((old (range-list-intersection
-                            artlist
-                            (alist-get type (gnus-info-marks group-info))))
-                      (del (range-remove (copy-tree old) list))
-                      (add (range-remove (copy-tree list) old)))
-                 (when add (push (list add 'add (list type)) delta-marks))
-                 (when del
-                   ;; Don't delete marks from outside the active range.
-                   ;; This shouldn't happen, but is a sanity check.
-                   (setq del (range-intersection
-                              (gnus-active artgroup) del))
-                   (push (list del 'del (list type)) delta-marks))))
-
-             ;; Marked sets are of mark-type 'tuple, 'list, or
-             ;; 'range. We merge the lists with what is already in
-             ;; the original info to get full list of new marks. We
-             ;; do this by removing all the articles we retrieved
-             ;; from the full list, and then add back in the newly
-             ;; marked ones.
-             (cond
-              ((eq mark-type 'tuple)
-               ;; Get rid of the entries that have the default
-               ;; score.
-               (when (and list (eq type 'score) gnus-save-score)
-                 (let* ((arts list)
-                        (prev (cons nil list))
-                        (all prev))
-                   (while arts
-                     (if (or (not (consp (car arts)))
-                             (= (cdar arts) gnus-summary-default-score))
-                         (setcdr prev (cdr arts))
-                       (setq prev arts))
-                     (setq arts (cdr arts)))
-                   (setq list (cdr all))))
-               ;; now merge with the original list and sort just to
-               ;; make sure
-               (setq
-                 list (sort
+      (let ((group-info (gnus-get-info artgroup))
+            (old-unread (gnus-list-of-unread-articles artgroup))
+            (rsm (gnus-check-backend-function 'request-set-mark artgroup))
+            newmarked delta-marks)
+        (when group-info
+          ;; iterate over mark lists for this group
+          (pcase-dolist (`(,_mark . ,type) gnus-article-mark-lists)
+            (let ((list (cdr (assoc artgroup  (alist-get type mark-list))))
+                  (mark-type (gnus-article-mark-to-type type))
+                  (group-marks (alist-get type (gnus-info-marks group-info))))
+
+              ;; When the backend can store marks we collect any
+              ;; changes.  Unlike a normal group the mark lists only
+              ;; include marks for articles we retrieved.  If there is
+              ;; no quit-config then gnus-update-marks has already
+              ;; been called to handle this.
+              (when (and quit-config rsm
+                         (not (gnus-article-unpropagatable-p type)))
+                (let* ((old (range-list-intersection
+                             artlist group-marks))
+                       (del (range-remove (copy-tree old) list))
+                       (add (range-remove (copy-tree list) old)))
+                  (when add (push (list add 'add (list type)) delta-marks))
+                  (when del
+                    ;; Don't delete marks from outside the active range.
+                    ;; This shouldn't happen, but is a sanity check.
+                    (setq del (range-intersection (gnus-active artgroup) del))
+                    (push (list del 'del (list type)) delta-marks))))
+
+              ;; Marked sets are of mark-type 'tuple, 'list, or
+              ;; 'range. We merge the lists with what is already in
+              ;; the original info to get full list of new marks. We
+              ;; do this by removing all the articles we retrieved
+              ;; from the full list, and then add back in the newly
+              ;; marked ones.
+              (cond
+               ((eq mark-type 'tuple)
+                ;; Get rid of the entries that have the default
+                ;; score.
+                (when (and list (eq type 'score) gnus-save-score)
+                  (let* ((arts list)
+                         (prev (cons nil list))
+                         (all prev))
+                    (while arts
+                      (if (or (not (consp (car arts)))
+                              (= (cdar arts) gnus-summary-default-score))
+                          (setcdr prev (cdr arts))
+                        (setq prev arts))
+                      (setq arts (cdr arts)))
+                    (setq list (cdr all))))
+                ;; now merge with the original list and sort just to
+                ;; make sure
+                (setq list
+                      (sort
                        (map-merge
-                       'alist list
+                        'alist list
                         (delq nil
                               (mapcar
                                (lambda (x) (unless (memq (car x) artlist) x))
-                               (alist-get type (gnus-info-marks group-info)))))
+                               group-marks)))
                        'car-less-than-car)))
-              (t
-               (setq list
-                     (range-compress-list
-                      (gnus-sorted-union
-                       (gnus-sorted-difference
-                        (gnus-uncompress-sequence
-                         (alist-get type (gnus-info-marks group-info)))
-                        artlist)
-                       (sort list #'<)))))
-
-              ;; When exiting the group, everything that's previously been
-              ;; unseen is now seen.
-              (when (eq  type 'seen)
-                (setq list (range-concat
-                            list (cdr (assoc artgroup select-unseen))))))
-
-             (when (or list (eq  type 'unexist))
-               (push (cons  type list) newmarked)))) ;; end of mark-type loop
-
-         (when delta-marks
-           (unless (gnus-check-group artgroup)
-             (error "Can't open server for %s" artgroup))
-           (gnus-request-set-mark artgroup delta-marks))
-
-         (gnus-atomic-progn
-           (gnus-info-set-marks group-info newmarked)
-           ;; Cut off the end of the info if there's nothing else there.
-           (let ((i 5))
-             (while (and (> i 2)
-                         (not (nth i group-info)))
-               (when (nthcdr (cl-decf i) group-info)
-                 (setcdr (nthcdr i group-info) nil))))
-
-           ;; update read and unread
-           (gnus-update-read-articles
-            artgroup
-            (range-uncompress
-             (range-add-list
-              (range-remove
-               old-unread
-               (cdr (assoc artgroup select-reads)))
-              (sort (cdr (assoc artgroup select-unreads)) #'<))))
-           (gnus-get-unread-articles-in-group
-            group-info (gnus-active artgroup) t))
-            (gnus-group-update-group
-             artgroup t
-             (equal group-info
-                   (setq group-info (copy-sequence (gnus-get-info artgroup))
-                         group-info
-                          (delq (gnus-info-params group-info) 
group-info)))))))))
+               (t
+                (setq list
+                      (range-compress-list
+                       (gnus-sorted-union
+                        (gnus-sorted-difference
+                         (gnus-uncompress-sequence group-marks)
+                         artlist)
+                        (sort list #'<))))
+
+                ;; When exiting the group, everything that's previously been
+                ;; unseen is now seen.
+                (when (eq  type 'seen)
+                  (setq list (range-concat
+                              list (cdr (assoc artgroup select-unseen)))))))
+
+              (when (or list (eq  type 'unexist))
+                (push (cons  type list) newmarked)))) ;; end of mark-type loop
+          (when delta-marks
+            (unless (gnus-check-group artgroup)
+              (error "Can't open server for %s" artgroup))
+            (gnus-request-set-mark artgroup delta-marks))
+          (gnus-atomic-progn
+            (gnus-info-set-marks group-info newmarked)
+            ;; Cut off the end of the info if there's nothing else there.
+            (let ((i 5))
+              (while (and (> i 2)
+                          (not (nth i group-info)))
+                (when (nthcdr (cl-decf i) group-info)
+                  (setcdr (nthcdr i group-info) nil))))
+
+            ;; update read and unread
+            (gnus-update-read-articles
+             artgroup
+             (range-uncompress
+              (range-add-list
+               (range-remove
+                old-unread
+                (cdr (assoc artgroup select-reads)))
+               (sort (cdr (assoc artgroup select-unreads)) #'<)))))
+          (gnus-get-unread-articles-in-group
+           group-info (gnus-active artgroup) t)
+          (gnus-group-update-group
+           artgroup t
+           (equal group-info
+                  (setq group-info (copy-sequence (gnus-get-info artgroup))
+                        group-info
+                        (delq (gnus-info-params group-info) group-info)))))))))
 
 (declare-function gnus-registry-get-id-key "gnus-registry" (id key))