mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2025-01-14 16:50:58 +00:00
* lisp/gnus/gnus.el (gnus-info): Define with cl-defstruct
This makes the accessors into (inlined) functions (instead of macros), which simplifies some uses, and it makes the gnus-info-set-<foo> macros redundant since we can use `setf` instead. Remove them and update all users. (gnus-info-group, gnus-info-rank, gnus-info-read, gnus-info-marks) (gnus-info-method, gnus-info-params): Auto-defined by defstruct. (gnus-info-level, gnus-info-score): Define as a function. Add gv-setter. (gnus-info-set-group, gnus-info-set-rank, gnus-info-set-read): Remove, use `setf` instead. (gnus-info-set-marks, gnus-info-set-method, gnus-info-set-params): Define as a function. (gnus-info-set-entry): Delete function. (gnus-info--grow-entry): New function, extracted from it. (gnus-info--set-level, gnus-info--set-score): New functions, extracted from the `gnus-info-set-level` and `gnus-info-set-score` which they replace. (gnus-get-info): Define as a function. * lisp/gnus/gnus-group.el (gnus-group-edit-group-done): Use the `extend` arg of `gnus-info-set-method`. (gnus-group-sort-selected-flat): eta-reduce.
This commit is contained in:
parent
7fff418edf
commit
b1a6950584
@ -1212,26 +1212,24 @@ This can be added to `gnus-select-article-hook' or
|
||||
(marks (nth 2 action)))
|
||||
(dolist (mark marks)
|
||||
(cond ((eq mark 'read)
|
||||
(gnus-info-set-read
|
||||
info
|
||||
(funcall (if (eq what 'add)
|
||||
'gnus-range-add
|
||||
'gnus-remove-from-range)
|
||||
(gnus-info-read info)
|
||||
range))
|
||||
(setf (gnus-info-read info)
|
||||
(funcall (if (eq what 'add)
|
||||
#'gnus-range-add
|
||||
#'gnus-remove-from-range)
|
||||
(gnus-info-read info)
|
||||
range))
|
||||
(gnus-get-unread-articles-in-group
|
||||
info
|
||||
(gnus-active (gnus-info-group info))))
|
||||
((memq mark '(tick))
|
||||
(let ((info-marks (assoc mark (gnus-info-marks info))))
|
||||
(unless info-marks
|
||||
(gnus-info-set-marks
|
||||
info (cons (setq info-marks (list mark))
|
||||
(gnus-info-marks info))))
|
||||
(push (setq info-marks (list mark))
|
||||
(gnus-info-marks info)))
|
||||
(setcdr info-marks
|
||||
(funcall (if (eq what 'add)
|
||||
'gnus-range-add
|
||||
'gnus-remove-from-range)
|
||||
#'gnus-range-add
|
||||
#'gnus-remove-from-range)
|
||||
(cdr info-marks)
|
||||
range))))))))
|
||||
|
||||
@ -1303,12 +1301,11 @@ downloaded into the agent."
|
||||
;; file.
|
||||
|
||||
(let ((read (gnus-info-read info)))
|
||||
(gnus-info-set-read
|
||||
info
|
||||
(gnus-range-add
|
||||
read
|
||||
(list (cons (1+ agent-max)
|
||||
(1- active-min))))))
|
||||
(setf (gnus-info-read info)
|
||||
(gnus-range-add
|
||||
read
|
||||
(list (cons (1+ agent-max)
|
||||
(1- active-min))))))
|
||||
|
||||
;; Lie about the agent's local range for this group to
|
||||
;; disable the set read each time this server is opened.
|
||||
@ -2533,13 +2530,14 @@ modified) original contents, they are first saved to their own file."
|
||||
(assq mark (gnus-info-marks
|
||||
(setq info (gnus-get-info group))))))
|
||||
(when (cdr marked-arts)
|
||||
;; FIXME: Use `cl-callf'?
|
||||
(setq marks
|
||||
(delq marked-arts (gnus-info-marks info)))
|
||||
(gnus-info-set-marks info marks)))))
|
||||
(setf (gnus-info-marks info) marks)))))
|
||||
(let ((read (gnus-info-read
|
||||
(or info (setq info (gnus-get-info group))))))
|
||||
(gnus-info-set-read
|
||||
info (gnus-add-to-range read unfetched-articles)))
|
||||
(setf (gnus-info-read info)
|
||||
(gnus-add-to-range read unfetched-articles)))
|
||||
|
||||
(gnus-group-update-group group t)
|
||||
(sit-for 0)
|
||||
|
@ -2973,11 +2973,7 @@ and NEW-NAME will be prompted for."
|
||||
(setq info (copy-tree info))
|
||||
(setcar info new-group)
|
||||
(unless (gnus-server-equal method "native")
|
||||
(unless (nthcdr 3 info)
|
||||
(nconc info (list nil nil)))
|
||||
(unless (nthcdr 4 info)
|
||||
(nconc info (list nil)))
|
||||
(gnus-info-set-method info method))
|
||||
(gnus-info-set-method info method t))
|
||||
(gnus-group-set-info info))
|
||||
(gnus-group-update-group (or new-group group))
|
||||
(gnus-group-position-point)))
|
||||
@ -3374,14 +3370,12 @@ If REVERSE, sort in reverse order."
|
||||
"Sort only the selected GROUPS, using FUNC.
|
||||
If REVERSE is non-nil, reverse the sorting."
|
||||
(let ((infos (sort
|
||||
(mapcar (lambda (g)
|
||||
(gnus-get-info g))
|
||||
groups)
|
||||
(mapcar #'gnus-get-info groups)
|
||||
func))
|
||||
sorted-groups)
|
||||
(when reverse
|
||||
(setq infos (nreverse infos)))
|
||||
(setq sorted-groups (mapcar (lambda (i) (gnus-info-group i)) infos))
|
||||
(setq sorted-groups (mapcar #'gnus-info-group infos))
|
||||
|
||||
;; Find the original locations of GROUPS in `gnus-group-list', and
|
||||
;; replace each one, in order, with a group from SORTED-GROUPS.
|
||||
@ -3532,16 +3526,16 @@ Obeys the process/prefix convention."
|
||||
`(progn
|
||||
(gnus-request-set-mark ,group ',action)
|
||||
(gnus-info-set-marks ',info ',(gnus-info-marks info) t)
|
||||
(gnus-info-set-read ',info ',(gnus-info-read info))
|
||||
(setf (gnus-info-read ',info) ',(gnus-info-read info))
|
||||
(when (gnus-group-jump-to-group ,group)
|
||||
(gnus-get-unread-articles-in-group ',info ',(gnus-active group) t)
|
||||
(gnus-group-update-group-line))))
|
||||
(setq action (mapcar (lambda (el) (list (nth 0 el) 'del (nth 2 el)))
|
||||
action))
|
||||
(gnus-request-set-mark group action)
|
||||
(gnus-info-set-read info nil)
|
||||
(setf (gnus-info-read info) nil)
|
||||
(when (gnus-info-marks info)
|
||||
(gnus-info-set-marks info nil))))
|
||||
(setf (gnus-info-marks info) nil))))
|
||||
|
||||
;; Group catching up.
|
||||
|
||||
|
@ -727,7 +727,7 @@ If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned."
|
||||
(let* ((range (if (= min 2) 1 (cons 1 (1- min))))
|
||||
(read (gnus-info-read info))
|
||||
(new-read (gnus-range-add read (list range))))
|
||||
(gnus-info-set-read info new-read)))
|
||||
(setf (gnus-info-read info) new-read)))
|
||||
info)))))
|
||||
|
||||
(defun gnus-request-expire-articles (articles group &optional force)
|
||||
|
@ -128,7 +128,7 @@ Return nil if no rule could be guessed."
|
||||
(info (gnus-get-info gnus-newsgroup-name)))
|
||||
(if (null rule)
|
||||
(error "Could not guess rule for article")
|
||||
(gnus-info-set-params info (cons rule (gnus-info-params info)))
|
||||
(push rule (gnus-info-params info))
|
||||
(message "Added rule in group %s for article: %s" gnus-newsgroup-name
|
||||
rule)))))
|
||||
|
||||
|
@ -1828,7 +1828,7 @@ The info element is shared with the same element of
|
||||
;; Make the same select-methods identical Lisp objects.
|
||||
(when (setq method (gnus-info-method info))
|
||||
(if (setq rest (member method methods))
|
||||
(gnus-info-set-method info (car rest))
|
||||
(setf (gnus-info-method info) (car rest))
|
||||
(push method methods)))
|
||||
;; Check for encoded group names and decode them.
|
||||
(when (string-match-p "[^[:ascii:]]" (setq gname (car info)))
|
||||
@ -1890,8 +1890,8 @@ The info element is shared with the same element of
|
||||
(push article news)))
|
||||
(when news
|
||||
;; Enter this list into the group info.
|
||||
(gnus-info-set-read
|
||||
info (gnus-remove-from-range (gnus-info-read info) (nreverse news)))
|
||||
(setf (gnus-info-read info)
|
||||
(gnus-remove-from-range (gnus-info-read info) (nreverse news)))
|
||||
|
||||
;; Set the number of unread articles in gnus-newsrc-hashtb.
|
||||
(gnus-get-unread-articles-in-group info (gnus-active group))
|
||||
@ -1958,7 +1958,7 @@ The info element is shared with the same element of
|
||||
(when (eq modified 'remove-null)
|
||||
(setq r (delq nil r)))
|
||||
;; Enter this list into the group info.
|
||||
(gnus-info-set-read info r)
|
||||
(setf (gnus-info-read info) r)
|
||||
|
||||
;; Set the number of unread articles in gnus-newsrc-hashtb.
|
||||
(gnus-get-unread-articles-in-group info (gnus-active group))
|
||||
@ -2362,12 +2362,11 @@ If FORCE is non-nil, the .newsrc file is read."
|
||||
(setq dormant (cdr (assq 'dormant marks))
|
||||
ticked (cdr (assq 'tick marks)))
|
||||
(when (or dormant ticked)
|
||||
(gnus-info-set-read
|
||||
info
|
||||
(gnus-add-to-range
|
||||
(gnus-info-read info)
|
||||
(nconc (gnus-uncompress-range dormant)
|
||||
(gnus-uncompress-range ticked)))))))))
|
||||
(setf (gnus-info-read info)
|
||||
(gnus-add-to-range
|
||||
(gnus-info-read info)
|
||||
(nconc (gnus-uncompress-range dormant)
|
||||
(gnus-uncompress-range ticked)))))))))
|
||||
|
||||
(defun gnus-load (file)
|
||||
"Load FILE, but in such a way that read errors can be reported."
|
||||
@ -2438,9 +2437,9 @@ If FORCE is non-nil, the .newsrc file is read."
|
||||
(while (setq group (pop newsrc))
|
||||
(if (setq info (gnus-get-info (car group)))
|
||||
(progn
|
||||
(gnus-info-set-read info (cddr group))
|
||||
(gnus-info-set-level
|
||||
info (if (nth 1 group) gnus-level-default-subscribed
|
||||
(setf (gnus-info-read info) (cddr group))
|
||||
(setf (gnus-info-level info)
|
||||
(if (nth 1 group) gnus-level-default-subscribed
|
||||
gnus-level-default-unsubscribed))
|
||||
(push info gnus-newsrc-alist))
|
||||
(push (setq info
|
||||
@ -2453,9 +2452,9 @@ If FORCE is non-nil, the .newsrc file is read."
|
||||
(when (setq m (assoc (car group) marked))
|
||||
(unless (nthcdr 3 info)
|
||||
(nconc info (list nil)))
|
||||
(gnus-info-set-marks
|
||||
info (list (cons 'tick (gnus-compress-sequence
|
||||
(sort (cdr m) '<) t))))))
|
||||
(setf (gnus-info-marks info)
|
||||
(list (cons 'tick (gnus-compress-sequence
|
||||
(sort (cdr m) #'<) t))))))
|
||||
(setq newsrc killed)
|
||||
(while newsrc
|
||||
(setcar newsrc (caar newsrc))
|
||||
@ -2609,7 +2608,7 @@ If FORCE is non-nil, the .newsrc file is read."
|
||||
;; There is an entry for this file in
|
||||
;; `gnus-newsrc-hashtb'.
|
||||
(progn
|
||||
(gnus-info-set-read info (nreverse reads))
|
||||
(setf (gnus-info-read info) (nreverse reads))
|
||||
;; We update the level very gently. In fact, we
|
||||
;; only change it if there's been a status change
|
||||
;; from subscribed to unsubscribed, or vice versa.
|
||||
@ -2621,7 +2620,7 @@ If FORCE is non-nil, the .newsrc file is read."
|
||||
(1+ gnus-level-default-unsubscribed))))
|
||||
((and (> level gnus-level-subscribed) subscribed)
|
||||
(setq level gnus-level-default-subscribed)))
|
||||
(gnus-info-set-level info level))
|
||||
(setf (gnus-info-level info) level))
|
||||
;; This is a new group.
|
||||
(setq info (list group
|
||||
(if subscribed
|
||||
|
@ -6367,7 +6367,7 @@ The resulting hash table is returned, or nil if no Xrefs were found."
|
||||
(gnus-undo-register
|
||||
`(progn
|
||||
(gnus-info-set-marks ',info ',(gnus-info-marks info) t)
|
||||
(gnus-info-set-read ',info ',(gnus-info-read info))
|
||||
(setf (gnus-info-read ',info) ',(gnus-info-read info))
|
||||
(gnus-get-unread-articles-in-group ',info (gnus-active ,group))
|
||||
(when ,set-marks
|
||||
(gnus-request-set-mark
|
||||
@ -6375,7 +6375,7 @@ The resulting hash table is returned, or nil if no Xrefs were found."
|
||||
(gnus-group-jump-to-group ,group)
|
||||
(gnus-group-update-group ,group t))))
|
||||
;; Add the read articles to the range.
|
||||
(gnus-info-set-read info range)
|
||||
(setf (gnus-info-read info) range)
|
||||
(when set-marks
|
||||
(gnus-request-set-mark group (list (list range 'add '(read)))))
|
||||
;; Then we have to re-compute how many unread
|
||||
@ -10283,8 +10283,8 @@ ACTION can be either `move' (the default), `crosspost' or `copy'."
|
||||
(when (and (not (memq article gnus-newsgroup-unreads))
|
||||
(cdr art-group))
|
||||
(push 'read to-marks)
|
||||
(gnus-info-set-read
|
||||
info (gnus-add-to-range (gnus-info-read info)
|
||||
(setf (gnus-info-read info)
|
||||
(gnus-add-to-range (gnus-info-read info)
|
||||
(list (cdr art-group)))))
|
||||
|
||||
;; See whether the article is to be put in the cache.
|
||||
@ -12891,14 +12891,14 @@ UNREAD is a sorted list."
|
||||
(gnus-undo-register
|
||||
`(progn
|
||||
(gnus-info-set-marks ',info ',(gnus-info-marks info) t)
|
||||
(gnus-info-set-read ',info ',(gnus-info-read info))
|
||||
(setf (gnus-info-read ',info) ',(gnus-info-read info))
|
||||
(gnus-group-jump-to-group ,group)
|
||||
(gnus-get-unread-articles-in-group ',info
|
||||
(gnus-active ,group))
|
||||
(gnus-group-update-group ,group t)
|
||||
,setmarkundo))))
|
||||
;; Enter this list into the group info.
|
||||
(gnus-info-set-read info read)
|
||||
(setf (gnus-info-read info) read)
|
||||
;; Set the number of unread articles in gnus-newsrc-hashtb.
|
||||
(gnus-get-unread-articles-in-group info (gnus-active group))
|
||||
t))))
|
||||
|
@ -2817,67 +2817,50 @@ See Info node `(gnus)Formatting Variables'."
|
||||
|
||||
;; Info access macros.
|
||||
|
||||
(defmacro gnus-info-group (info)
|
||||
`(nth 0 ,info))
|
||||
(defmacro gnus-info-rank (info)
|
||||
`(nth 1 ,info))
|
||||
(defmacro gnus-info-read (info)
|
||||
`(nth 2 ,info))
|
||||
(defmacro gnus-info-marks (info)
|
||||
`(nth 3 ,info))
|
||||
(defmacro gnus-info-method (info)
|
||||
`(nth 4 ,info))
|
||||
(defmacro gnus-info-params (info)
|
||||
`(nth 5 ,info))
|
||||
(cl-defstruct (gnus-info
|
||||
(:constructor nil)
|
||||
(:type list))
|
||||
group rank read marks method params)
|
||||
|
||||
(defmacro gnus-info-level (info)
|
||||
`(let ((rank (gnus-info-rank ,info)))
|
||||
(if (consp rank)
|
||||
(car rank)
|
||||
rank)))
|
||||
(defmacro gnus-info-score (info)
|
||||
`(let ((rank (gnus-info-rank ,info)))
|
||||
(or (and (consp rank) (cdr rank)) 0)))
|
||||
(defsubst gnus-info-level (info)
|
||||
(declare (gv-setter gnus-info--set-level))
|
||||
(let ((rank (gnus-info-rank info)))
|
||||
(if (consp rank)
|
||||
(car rank)
|
||||
rank)))
|
||||
(defsubst gnus-info-score (info)
|
||||
(declare (gv-setter gnus-info--set-score))
|
||||
(let ((rank (gnus-info-rank info)))
|
||||
(or (and (consp rank) (cdr rank)) 0)))
|
||||
|
||||
(defmacro gnus-info-set-group (info group)
|
||||
`(setcar ,info ,group))
|
||||
(defmacro gnus-info-set-rank (info rank)
|
||||
`(setcar (nthcdr 1 ,info) ,rank))
|
||||
(defmacro gnus-info-set-read (info read)
|
||||
`(setcar (nthcdr 2 ,info) ,read))
|
||||
(defmacro gnus-info-set-marks (info marks &optional extend)
|
||||
(if extend
|
||||
`(gnus-info-set-entry ,info ,marks 3)
|
||||
`(setcar (nthcdr 3 ,info) ,marks)))
|
||||
(defmacro gnus-info-set-method (info method &optional extend)
|
||||
(if extend
|
||||
`(gnus-info-set-entry ,info ,method 4)
|
||||
`(setcar (nthcdr 4 ,info) ,method)))
|
||||
(defmacro gnus-info-set-params (info params &optional extend)
|
||||
(if extend
|
||||
`(gnus-info-set-entry ,info ,params 5)
|
||||
`(setcar (nthcdr 5 ,info) ,params)))
|
||||
(defsubst gnus-info-set-marks (info marks &optional extend)
|
||||
(if extend (gnus-info--grow-entry info 3))
|
||||
(setf (gnus-info-marks info) marks))
|
||||
(defsubst gnus-info-set-method (info method &optional extend)
|
||||
(if extend (gnus-info--grow-entry info 4))
|
||||
(setf (gnus-info-method info) method))
|
||||
(defsubst gnus-info-set-params (info params &optional extend)
|
||||
(if extend (gnus-info--grow-entry info 5))
|
||||
(setf (gnus-info-params info) params))
|
||||
|
||||
(defun gnus-info-set-entry (info entry number)
|
||||
(defun gnus-info--grow-entry (info number)
|
||||
;; Extend the info until we have enough elements.
|
||||
(while (<= (length info) number)
|
||||
(nconc info (list nil)))
|
||||
;; Set the entry.
|
||||
(setcar (nthcdr number info) entry))
|
||||
(nconc info (list nil))))
|
||||
|
||||
(defmacro gnus-info-set-level (info level)
|
||||
`(let ((rank (cdr ,info)))
|
||||
(if (consp (car rank))
|
||||
(setcar (car rank) ,level)
|
||||
(setcar rank ,level))))
|
||||
(defmacro gnus-info-set-score (info score)
|
||||
`(let ((rank (cdr ,info)))
|
||||
(if (consp (car rank))
|
||||
(setcdr (car rank) ,score)
|
||||
(setcar rank (cons (car rank) ,score)))))
|
||||
(defsubst gnus-info--set-level (info level)
|
||||
(let ((rank (gnus-info-rank info)))
|
||||
(if (consp rank)
|
||||
(setcar rank level)
|
||||
(setf (gnus-info-rank info) level))))
|
||||
(defsubst gnus-info--set-score (info score)
|
||||
(let ((rank (gnus-info-rank info)))
|
||||
(if (consp rank)
|
||||
(setcdr rank score)
|
||||
(setf (gnus-info-rank info) (cons rank score)))))
|
||||
|
||||
(defmacro gnus-get-info (group)
|
||||
`(nth 1 (gethash ,group gnus-newsrc-hashtb)))
|
||||
(defsubst gnus-get-info (group)
|
||||
(nth 1 (gethash group gnus-newsrc-hashtb)))
|
||||
|
||||
(defun gnus-set-info (group info)
|
||||
(setcdr (gethash group gnus-newsrc-hashtb)
|
||||
@ -3704,14 +3687,14 @@ GROUP can also be an INFO structure."
|
||||
(setq params (delq name params))
|
||||
(while (assq name params)
|
||||
(gnus-alist-pull name params))
|
||||
(gnus-info-set-params info params))))))
|
||||
(setf (gnus-info-params info) params))))))
|
||||
|
||||
(defun gnus-group-add-score (group &optional score)
|
||||
"Add SCORE to the GROUP score.
|
||||
If SCORE is nil, add 1 to the score of GROUP."
|
||||
(let ((info (gnus-get-info group)))
|
||||
(when info
|
||||
(gnus-info-set-score info (+ (gnus-info-score info) (or score 1))))))
|
||||
(setf (gnus-info-score info) (+ (gnus-info-score info) (or score 1))))))
|
||||
|
||||
(defun gnus-short-group-name (group &optional levels)
|
||||
"Collapse GROUP name LEVELS.
|
||||
|
@ -793,10 +793,10 @@ all. This may very well take some time.")
|
||||
;;(message "unread: %s" unread)
|
||||
(sit-for 1)
|
||||
(kill-buffer buf))
|
||||
(setq unread (sort unread '<))
|
||||
(setq unread (sort unread #'<))
|
||||
(and unread
|
||||
(gnus-info-set-read info (gnus-update-read-articles
|
||||
(gnus-info-group info) unread t)))
|
||||
(setf (gnus-info-read info)
|
||||
(gnus-update-read-articles (gnus-info-group info) unread t)))
|
||||
))
|
||||
(run-hook-with-args 'nndiary-request-update-info-functions
|
||||
(gnus-info-group info))
|
||||
|
@ -147,10 +147,10 @@ are generated if and only if they are also in `message-draft-headers'."
|
||||
|
||||
(deffoo nndraft-request-update-info (group info &optional server)
|
||||
(nndraft-possibly-change-group group)
|
||||
(gnus-info-set-read
|
||||
info
|
||||
(gnus-update-read-articles (gnus-group-prefixed-name group '(nndraft ""))
|
||||
(nndraft-articles) t))
|
||||
(setf (gnus-info-read info)
|
||||
(gnus-update-read-articles
|
||||
(gnus-group-prefixed-name group '(nndraft ""))
|
||||
(nndraft-articles) t))
|
||||
(let ((marks (nth 3 info)))
|
||||
(when marks
|
||||
;; Nix out all marks except the `unsend'-able article marks.
|
||||
|
@ -1620,7 +1620,7 @@ If LIMIT, first try to limit the search to the N last articles."
|
||||
read)))
|
||||
(when (or (not (listp permanent-flags))
|
||||
(memq '%Seen permanent-flags))
|
||||
(gnus-info-set-read info read))
|
||||
(setf (gnus-info-read info) read))
|
||||
;; Update the marks.
|
||||
(setq marks (gnus-info-marks info))
|
||||
(dolist (type (cdr nnimap-mark-alist))
|
||||
@ -1680,14 +1680,13 @@ If LIMIT, first try to limit the search to the N last articles."
|
||||
|
||||
(defun nnimap-update-qresync-info (info existing vanished flags)
|
||||
;; Add all the vanished articles to the list of read articles.
|
||||
(gnus-info-set-read
|
||||
info
|
||||
(gnus-add-to-range
|
||||
(gnus-add-to-range
|
||||
(gnus-range-add (gnus-info-read info)
|
||||
vanished)
|
||||
(cdr (assq '%Flagged flags)))
|
||||
(cdr (assq '%Seen flags))))
|
||||
(setf (gnus-info-read info)
|
||||
(gnus-add-to-range
|
||||
(gnus-add-to-range
|
||||
(gnus-range-add (gnus-info-read info)
|
||||
vanished)
|
||||
(cdr (assq '%Flagged flags)))
|
||||
(cdr (assq '%Seen flags))))
|
||||
(let ((marks (gnus-info-marks info)))
|
||||
(dolist (type (cdr nnimap-mark-alist))
|
||||
(let ((ticks (assoc (car type) marks))
|
||||
|
@ -874,8 +874,8 @@ A non-nil `specs' arg must be an alist with `nnir-query-spec' and
|
||||
(deffoo nnir-request-update-info (group info &optional server)
|
||||
(nnir-possibly-change-group group server)
|
||||
;; clear out all existing marks.
|
||||
(gnus-info-set-marks info nil)
|
||||
(gnus-info-set-read info nil)
|
||||
(setf (gnus-info-marks info) nil)
|
||||
(setf (gnus-info-read info) nil)
|
||||
(let ((group (gnus-group-guess-full-name-from-command-method group))
|
||||
(articles-by-group
|
||||
(nnir-categorize
|
||||
@ -889,15 +889,15 @@ A non-nil `specs' arg must be an alist with `nnir-query-spec' and
|
||||
(group-info (gnus-get-info (car group-articles)))
|
||||
(marks (gnus-info-marks group-info))
|
||||
(read (gnus-info-read group-info)))
|
||||
(gnus-info-set-read
|
||||
info
|
||||
(gnus-add-to-range
|
||||
(gnus-info-read info)
|
||||
(delq nil
|
||||
(mapcar
|
||||
#'(lambda (art)
|
||||
(when (gnus-member-of-range (cdr art) read) (car art)))
|
||||
articleids))))
|
||||
(setf (gnus-info-read info)
|
||||
(gnus-add-to-range
|
||||
(gnus-info-read info)
|
||||
(delq nil
|
||||
(mapcar
|
||||
#'(lambda (art)
|
||||
(when (gnus-member-of-range (cdr art) read)
|
||||
(car art)))
|
||||
articleids))))
|
||||
(dolist (mark marks)
|
||||
(cl-destructuring-bind (type . range) mark
|
||||
(gnus-add-marked-articles
|
||||
|
@ -1000,7 +1000,7 @@ This variable is set by `nnmaildir-request-article'.")
|
||||
pgname (nnmaildir--pgname nnmaildir--cur-server gname)
|
||||
flist (nnmaildir--grp-flist group))
|
||||
(when (zerop (nnmaildir--grp-count group))
|
||||
(gnus-info-set-read info nil)
|
||||
(setf (gnus-info-read info) nil)
|
||||
(gnus-info-set-marks info nil 'extend)
|
||||
(throw 'return info))
|
||||
(setq old-marks (cons 'read (gnus-info-read info))
|
||||
@ -1083,7 +1083,7 @@ This variable is set by `nnmaildir-request-article'.")
|
||||
(setq ranges (gnus-add-to-range ranges (sort article-list '<)))))
|
||||
(if (eq mark 'read) (setq read ranges)
|
||||
(if ranges (setq marks (cons (cons mark ranges) marks)))))
|
||||
(gnus-info-set-read info (gnus-range-add read missing))
|
||||
(setf (gnus-info-read info) (gnus-range-add read missing))
|
||||
(gnus-info-set-marks info marks 'extend)
|
||||
(setf (nnmaildir--grp-mmth group) new-mmth)
|
||||
info)))
|
||||
|
@ -711,29 +711,29 @@ Other back ends might or might not work.")
|
||||
(nnimap-request-update-info-internal folder folderinfo nnmairix-backend-server)
|
||||
(nnmairix-call-backend "request-update-info" folder folderinfo nnmairix-backend-server))
|
||||
;; set range of read articles
|
||||
(gnus-info-set-read
|
||||
info
|
||||
(if docorr
|
||||
(nnmairix-map-range
|
||||
`(lambda (x) (+ x ,(cadr corr)))
|
||||
(gnus-info-read folderinfo))
|
||||
(gnus-info-read folderinfo)))
|
||||
(setf (gnus-info-read info)
|
||||
(if docorr
|
||||
(nnmairix-map-range
|
||||
;; FIXME: Use lexical-binding.
|
||||
`(lambda (x) (+ x ,(cadr corr)))
|
||||
(gnus-info-read folderinfo))
|
||||
(gnus-info-read folderinfo)))
|
||||
;; set other marks
|
||||
(gnus-info-set-marks
|
||||
info
|
||||
(if docorr
|
||||
(mapcar (lambda (cur)
|
||||
(cons
|
||||
(car cur)
|
||||
(nnmairix-map-range
|
||||
`(lambda (x) (+ x ,(cadr corr)))
|
||||
(list (cadr cur)))))
|
||||
(gnus-info-marks folderinfo))
|
||||
(gnus-info-marks folderinfo))))
|
||||
(setf (gnus-info-marks info)
|
||||
(if docorr
|
||||
(mapcar (lambda (cur)
|
||||
(cons
|
||||
(car cur)
|
||||
(nnmairix-map-range
|
||||
;; FIXME: Use lexical-binding.
|
||||
`(lambda (x) (+ x ,(cadr corr)))
|
||||
(list (cadr cur)))))
|
||||
(gnus-info-marks folderinfo))
|
||||
(gnus-info-marks folderinfo))))
|
||||
(when (eq readmarks 'unread)
|
||||
(gnus-info-set-read info nil))
|
||||
(setf (gnus-info-read info) nil))
|
||||
(when (eq readmarks 'read)
|
||||
(gnus-info-set-read info (gnus-active qualgroup))))
|
||||
(setf (gnus-info-read info) (gnus-active qualgroup))))
|
||||
t)
|
||||
|
||||
(nnoo-define-skeleton nnmairix)
|
||||
|
@ -1067,7 +1067,7 @@ Use the nov database for the current group if available."
|
||||
(when (gnus-member-of-range old-number read)
|
||||
(setq read (gnus-remove-from-range read (list old-number)))
|
||||
(setq read (gnus-add-to-range read (list new-number))))
|
||||
(gnus-info-set-read info read))
|
||||
(setf (gnus-info-read info) read))
|
||||
;; 2 b/ marked articles:
|
||||
(let ((oldmarks (gnus-info-marks info))
|
||||
mark newmarks)
|
||||
@ -1080,7 +1080,7 @@ Use the nov database for the current group if available."
|
||||
(setcdr mark (gnus-add-to-range (cdr mark)
|
||||
(list new-number))))
|
||||
(push mark newmarks))
|
||||
(gnus-info-set-marks info newmarks))
|
||||
(setf (gnus-info-marks info) newmarks))
|
||||
;; 3/ Update the NOV entry for this article:
|
||||
(unless nnml-nov-is-evil
|
||||
(with-current-buffer (nnml-open-nov group)
|
||||
|
@ -463,11 +463,10 @@ If UPDATE-P is not nil, call gnus-group-update-group on the components."
|
||||
(dolist (group nnvirtual-component-groups)
|
||||
(when (and (setq info (gnus-get-info group))
|
||||
(gnus-info-marks info))
|
||||
(gnus-info-set-marks
|
||||
info
|
||||
(if (assq 'score (gnus-info-marks info))
|
||||
(list (assq 'score (gnus-info-marks info)))
|
||||
nil))))
|
||||
(setf (gnus-info-marks info)
|
||||
(if (assq 'score (gnus-info-marks info))
|
||||
(list (assq 'score (gnus-info-marks info)))
|
||||
nil))))
|
||||
|
||||
;; Ok, currently type-marks is an assq list with keys of a mark type,
|
||||
;; with data of an assq list with keys of component group names
|
||||
|
Loading…
Reference in New Issue
Block a user