mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2026-01-06 20:00:46 -08:00
Code Issues Projects Releases Wiki Activity

Improve propagation of gnus/nnselect group info

Browse source 
* lisp/gnus/nnselect.el (nnselect-push-info): Speed up pushing the
nnselect info back to the originating groups.
This commit is contained in:
Andrew G Cohen 2022-03-04 16:44:40 +08:00
parent 90040f0e9f
commit 7fef2e04b2
1 changed files with 20 additions and 10 deletions
Download patch file Download diff file Expand all files Collapse all files

30
lisp/gnus/nnselect.el
View file

@ -878,6 +878,9 @@ article came from is also searched."
;; When the backend can store marks we collect any ;; When the backend can store marks we collect any
;; changes. Unlike a normal group the mark lists only ;; changes. Unlike a normal group the mark lists only
;; include marks for articles we retrieved. ;; 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 (let* ((old (range-list-intersection
artlist artlist
(alist-get type (gnus-info-marks group-info)))) (alist-get type (gnus-info-marks group-info))))
@ -889,7 +892,7 @@ article came from is also searched."
;; This shouldn't happen, but is a sanity check. ;; This shouldn't happen, but is a sanity check.
(setq del (range-intersection (setq del (range-intersection
(gnus-active artgroup) del)) (gnus-active artgroup) del))
(push (list del 'del (list type)) delta-marks))) (push (list del 'del (list type)) delta-marks))))
;; Marked sets are of mark-type 'tuple, 'list, or ;; Marked sets are of mark-type 'tuple, 'list, or
;; 'range. We merge the lists with what is already in ;; 'range. We merge the lists with what is already in
@ -914,12 +917,15 @@ article came from is also searched."
(setq list (cdr all)))) (setq list (cdr all))))
;; now merge with the original list and sort just to ;; now merge with the original list and sort just to
;; make sure ;; make sure
(setq list (setq
(sort (map-merge list (sort
'alist list (map-merge
(alist-get type (gnus-info-marks group-info))) 'alist list
(lambda (elt1 elt2) (delq nil
(< (car elt1) (car elt2)))))) (mapcar
(lambda (x) (unless (memq (car x) artlist) x))
(alist-get type (gnus-info-marks group-info)))))
'car-less-than-car)))
(t (t
(setq list (setq list
(range-compress-list (range-compress-list
@ -963,9 +969,13 @@ article came from is also searched."
(cdr (assoc artgroup select-reads))) (cdr (assoc artgroup select-reads)))
(sort (cdr (assoc artgroup select-unreads)) #'<)))) (sort (cdr (assoc artgroup select-unreads)) #'<))))
(gnus-get-unread-articles-in-group (gnus-get-unread-articles-in-group
group-info (gnus-active artgroup) t) group-info (gnus-active artgroup) t))
(gnus-group-update-group artgroup t 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)) (declare-function gnus-registry-get-id-key "gnus-registry" (id key))