1
0
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:
Stefan Monnier 2019-11-29 12:26:31 -05:00
parent 7fff418edf
commit b1a6950584
15 changed files with 143 additions and 171 deletions

View File

@ -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)

View File

@ -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.

View File

@ -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)

View File

@ -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)))))

View File

@ -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

View File

@ -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))))

View File

@ -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.

View File

@ -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))

View File

@ -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.

View File

@ -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))

View File

@ -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

View File

@ -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)))

View File

@ -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)

View File

@ -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)

View File

@ -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