:group 'gnus-start
:type 'file)
+(defvar installation-directory)
(defcustom gnus-site-init-file
(condition-case nil
(concat (file-name-directory
(defvar gnus-init-inhibit nil)
(defun gnus-read-init-file (&optional inhibit-next)
;; Don't load .gnus if the -q option was used.
- (when init-file-user
+ ;;;
+ ;; GNU uses 'init-file-user' here which is obsolete in S(X)Emacs.
+ ;; Lars just went to the effort of ripping out all the XE-compat
+ ;; code so I doubt he'd want any back so I'm not going to bother
+ ;; with conditioning this. --SY.
+ (when load-user-init-file-p
(if gnus-init-inhibit
(setq gnus-init-inhibit nil)
(setq gnus-init-inhibit inhibit-next)
(defun gnus-get-unread-articles (&optional level dont-connect one-level)
(setq gnus-server-method-cache nil)
(require 'gnus-agent)
- (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"))
- infos 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
+ (with-boundp '(dummy method-type infos 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"))
+ infos 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 (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 (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))
+ (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 (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)
+ (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)
(destructuring-bind (method method-type infos dummy) elem
- (let ((gnus-opened-servers methods))
- (when (and (gnus-similar-server-opened method)
+ (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)
+ (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)))
- (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)
- (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)
+ (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)
- (destructuring-bind (method method-type infos dummy) elem
- (setq sanity-spec (list (car method) (cadr method)))
+ (destructuring-bind (method method-type infos early-data) elem
(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)
- (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")))
+ (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"))))
(defun gnus-method-rank (type method)
(cond
projects / packages / commitdiff