Function: nnselect-push-info

nnselect-push-info is a byte-compiled function defined in nnselect.el.gz.

Signature

(nnselect-push-info GROUP)

Documentation

Copy mark-lists from GROUP to the originating groups.

Source Code

;; Defined in /usr/src/emacs/lisp/gnus/nnselect.el.gz
(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-info-read (gnus-get-info group)) 'range))
	(select-unseen (numbers-by-group gnus-newsgroup-unseen))
	(gnus-newsgroup-active nil) mark-list)
    ;; collect the set of marked article lists categorized by
    ;; originating groups
    (pcase-dolist (`(,mark . ,type) gnus-article-mark-lists)
      (let (type-list)
	(when (setq type-list
		    (symbol-value (intern (format "gnus-newsgroup-%s" mark))))
	  (push (cons
		 type
		 (numbers-by-group type-list (gnus-article-mark-to-type type)))
		mark-list))))
    ;; now work on each originating group one at a time
    (pcase-dolist (`(,artgroup . ,artlist)
		   (numbers-by-group gnus-newsgroup-articles))
      (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
                       (map-merge
			'alist list
                        (delq nil
                              (mapcar
                               (lambda (x) (unless (memq (car x) artlist) x))
                               (alist-get type (gnus-info-marks group-info)))))
                       '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)))))))))