Function: gnus-get-unread-articles
gnus-get-unread-articles is a byte-compiled function defined in
gnus-start.el.gz.
Signature
(gnus-get-unread-articles &optional LEVEL DONT-CONNECT ONE-LEVEL)
Source Code
;; Defined in /usr/src/emacs/lisp/gnus/gnus-start.el.gz
;; Go though `gnus-newsrc-alist' and compare with `gnus-active-hashtb'
;; and compute how many unread articles there are in each group.
(defun gnus-get-unread-articles (&optional level dont-connect one-level)
(setq gnus-server-method-cache nil)
(require 'gnus-agent)
(defvar gnus-agent-article-local-times)
(let* ((newsrc (cdr gnus-newsrc-alist))
(alevel (or level gnus-activate-level (1+ gnus-level-subscribed)))
(foreign-level
(or
level
(min
(cond ((and gnus-activate-foreign-newsgroups
(not (numberp gnus-activate-foreign-newsgroups)))
(1+ gnus-level-subscribed))
((numberp gnus-activate-foreign-newsgroups)
gnus-activate-foreign-newsgroups)
(t 0))
alevel)))
(methods-cache nil)
(type-cache nil)
(gnus-agent-article-local-times 0)
(archive-method (gnus-server-to-method "archive"))
info group active method cmethod
method-type method-group-list entry)
(gnus-message 6 "Checking new news...")
(while newsrc
(setq active (gnus-active (setq group (gnus-info-group
(setq info (pop newsrc))))))
;; First go through all the groups, see what select methods they
;; belong to, and then collect them into lists per unique select
;; method.
(if (not (setq method (gnus-info-method info)))
(setq method gnus-select-method)
;; There may be several similar methods. Possibly extend the
;; method.
(if (setq cmethod (assoc method methods-cache))
(setq method (cdr cmethod))
(setq cmethod (if (stringp method)
(gnus-server-to-method method)
(inline (gnus-find-method-for-group
(gnus-info-group info) info))))
(push (cons method cmethod) methods-cache)
(setq method cmethod)))
(setq method-group-list (assoc method type-cache))
(unless method-group-list
(setq method-type
(cond
((or (gnus-secondary-method-p method)
(and (gnus-archive-server-wanted-p)
(gnus-methods-equal-p archive-method method)))
'secondary)
((inline (gnus-server-equal gnus-select-method method))
'primary)
(t
'foreign)))
(push (setq method-group-list (list method method-type nil nil))
type-cache))
;; Only add groups that need updating.
(if (or (and foreign-level (null (numberp foreign-level)))
(funcall (if one-level #'= #'<=) (gnus-info-level info)
(if (eq (cadr method-group-list) 'foreign)
foreign-level
alevel)))
(setcar (nthcdr 2 method-group-list)
(cons info (nth 2 method-group-list)))
;; The group is inactive, so we nix out the number of unread articles.
;; It leads `(gnus-group-unread group)' to return t. See also
;; `gnus-group-prepare-flat'.
(unless active
(when (setq entry (gnus-group-entry group))
(setcar entry t)))))
;; Sort the methods based so that the primary and secondary
;; methods come first. This is done for legacy reasons to try to
;; ensure that side-effect behavior doesn't change from previous
;; Gnus versions.
(setq type-cache
(sort (nreverse type-cache)
(lambda (c1 c2)
(< (gnus-method-rank (cadr c1) (car c1))
(gnus-method-rank (cadr c2) (car c2))))))
;; Go through the list of servers and possibly extend methods that
;; aren't equal (and that need extension; i.e., they are async).
(let ((methods nil))
(dolist (elem type-cache)
(cl-destructuring-bind (method _method-type infos _dummy) elem
(let ((gnus-opened-servers methods))
(when (and (gnus-similar-server-opened method)
(gnus-check-backend-function
'retrieve-group-data-early (car method)))
(setq method (gnus-server-extend-method
(gnus-info-group (car infos))
method))
(setcar elem method))
(push (list method 'ok) methods)))))
;; If we have primary/secondary select methods, but no groups from
;; them, we still want to issue a retrieval request from them.
(unless dont-connect
(dolist (method (cons gnus-select-method
gnus-secondary-select-methods))
(when (and (not (assoc method type-cache))
(gnus-check-backend-function 'request-list (car method)))
(with-current-buffer nntp-server-buffer
(gnus-read-active-file-1 method nil)))))
;; Clear out all the early methods.
(dolist (elem type-cache)
(cl-destructuring-bind (method _method-type infos _dummy) elem
(when (and method
infos
(gnus-check-backend-function
'retrieve-group-data-early (car method))
(not (gnus-method-denied-p method)))
(when (ignore-errors (gnus-get-function method 'open-server))
(unless (gnus-server-opened method)
(gnus-open-server method))
(when (gnus-server-opened method)
;; Just mark this server as "cleared".
(gnus-retrieve-group-data-early method nil))))))
;; Start early async retrieval of data.
(let ((done-methods nil)
sanity-spec)
(dolist (elem type-cache)
(cl-destructuring-bind (method _method-type infos _dummy) elem
(setq sanity-spec (list (car method) (cadr method)))
(when (and method infos
(not (gnus-method-denied-p method)))
;; If the open-server method doesn't exist, then the method
;; itself doesn't exist, so we ignore it.
(if (not (ignore-errors (gnus-get-function method 'open-server)))
(setq type-cache (delq elem type-cache))
(unless (gnus-server-opened method)
(gnus-open-server method))
(when (and
;; This is a sanity check, so that we never
;; attempt to start two async requests to the
;; same server, because that will fail. This
;; should never happen, since the methods should
;; be unique at this point, but apparently it
;; does happen in the wild with some setups.
(not (member sanity-spec done-methods))
(gnus-server-opened method)
(gnus-check-backend-function
'retrieve-group-data-early (car method)))
(push sanity-spec done-methods)
(when (gnus-check-backend-function 'request-scan (car method))
(gnus-request-scan nil method))
;; Store the token we get back from -early so that we
;; can pass it to -finish later.
(setcar (nthcdr 3 elem)
(gnus-retrieve-group-data-early method infos))))))))
;; Do the rest of the retrieval.
(dolist (elem type-cache)
(cl-destructuring-bind (method _method-type infos early-data) elem
(when (and method infos
(not (gnus-method-denied-p method)))
(let ((updatep (gnus-check-backend-function
'request-update-info (car method))))
;; See if any of the groups from this method require updating.
(gnus-read-active-for-groups method infos early-data)
(dolist (info infos)
(inline (gnus-get-unread-articles-in-group
info (gnus-active (gnus-info-group info))
updatep)))))))
(gnus-message 6 "Checking new news...done")))