comparison lisp/gnus/gnus-start.el @ 110189:821c596efa5f

Rewrite the Gnus group activation method to be more efficient; nnmh.el (nnmh-request-list-1): Fix up the recursion behavior; Add more changes related to the new methodology for requesting backend data.

110188:92e4fa270c92

		  gnus-activate-foreign-newsgroups)
		 (t 0))
	   alevel))
	 (methods-cache nil)
	 (type-cache nil)
	 scanned-methods info group active method retrieve-groups cmethod
	 method-type)
    (gnus-message 6 "Checking new news...")

    (while newsrc
      (setq active (gnus-active (setq group (gnus-info-group
					     (setq info (pop newsrc))))))

      ;; >0 for an active group with messages
      ;; 0 for an active group with no unread messages
      ;; nil for non-foreign groups that the user has requested not be checked
      ;; t for unchecked foreign groups or bogus groups, or groups that can't
      ;;   be checked, for one reason or other.
      (when (setq method (gnus-info-method info))
	(if (setq cmethod (assoc method methods-cache))
	    (setq method (cdr cmethod))
	  (setq cmethod (inline (gnus-server-get-method nil method)))
	  (push (cons method cmethod) methods-cache)
	  (setq method cmethod)))
      (when (and method
		 (not (setq method-type (cdr (assoc method type-cache)))))
	(setq method-type
	      (cond
	       ((gnus-secondary-method-p method)
		'secondary)
	       ((inline (gnus-server-equal gnus-select-method method))
		'primary)
	       (t
		'foreign)))
	(push (cons method method-type) type-cache))

      (cond ((and method (eq method-type 'foreign))
	     ;; These groups are foreign.  Check the level.
	     (if (<= (gnus-info-level info) foreign-level)
		 (when (setq active (gnus-activate-group group 'scan))
		   ;; Let the Gnus agent save the active file.
		   (when (and gnus-agent active (gnus-online method))
		     (gnus-agent-save-group-info
		      method (gnus-group-real-name group) active))
		   (unless (inline (gnus-virtual-group-p group))
		     (inline (gnus-close-group group)))
		   (when (fboundp (intern (concat (symbol-name (car method))
						  "-request-update-info")))
		     (inline (gnus-request-update-info info method))))
	       (if (and level
			;; If `active' is nil that means the group has
			;; never been read, the group should be marked
			;; as having never been checked (see below).
			active
			(> (gnus-info-level info) level))
		   ;; Don't check groups of which levels are higher
		   ;; than the one that a user specified.
		   (setq active 'ignore))))
	    ;; These groups are native or secondary.
	    ((> (gnus-info-level info) alevel)
	     ;; We don't want these groups.
	     (setq active 'ignore))
	    ;; Activate groups.
	    ((not gnus-read-active-file)
	     (if (gnus-check-backend-function 'retrieve-groups group)
		 ;; if server support gnus-retrieve-groups we push
		 ;; the group onto retrievegroups for later checking
		 (if (assoc method retrieve-groups)
		     (setcdr (assoc method retrieve-groups)
			     (cons group (cdr (assoc method retrieve-groups))))
		   (push (list method group) retrieve-groups))
	       ;; hack: `nnmail-get-new-mail' changes the mail-source depending
	       ;; on the group, so we must perform a scan for every group
	       ;; if the users has any directory mail sources.
	       ;; hack: if `nnmail-scan-directory-mail-source-once' is non-nil,
	       ;; for it scan all spool files even when the groups are
	       ;; not required.
	       (if (and
		    (or nnmail-scan-directory-mail-source-once
			(null (assq 'directory mail-sources)))
		    (member method scanned-methods))
		   (setq active (gnus-activate-group group))
		 (setq active (gnus-activate-group group 'scan))
		 (push method scanned-methods))
	       (when active
		 (gnus-close-group group)))))

      ;; Get the number of unread articles in the group.
      (cond
       ((eq active 'ignore)
	;; Don't do anything.
	)
       (active
	(inline (gnus-get-unread-articles-in-group info active t)))
       (t
	;; The group couldn't be reached, so we nix out the number of
	;; unread articles and stuff.
	(gnus-set-active group nil)
	(let ((tmp (gnus-group-entry group)))
	  (when tmp
	    (setcar tmp t))))))

    ;; iterate through groups on methods which support gnus-retrieve-groups
    ;; and fetch a partial active file and use it to find new news.
    (dolist (rg retrieve-groups)
      (let ((method (or (car rg) gnus-select-method))
	    (groups (cdr rg)))
	(when (gnus-check-server method)
	  ;; Request that the backend scan its incoming messages.
	  (when (gnus-check-backend-function 'request-scan (car method))
	    (gnus-request-scan nil method))
	  (gnus-read-active-file-2
	   (mapcar (lambda (group) (gnus-group-real-name group)) groups)
	   method)
	  (dolist (group groups)
	    (cond
	     ((setq active (gnus-active (gnus-info-group
					 (setq info (gnus-get-info group)))))
	      (inline (gnus-get-unread-articles-in-group info active t)))
	     (t
	      ;; The group couldn't be reached, so we nix out the number of
	      ;; unread articles and stuff.
	      (gnus-set-active group nil)
	      (setcar (gnus-group-entry group) t)))))))

    (gnus-message 6 "Checking new news...done")))

;; Create a hash table out of the newsrc alist.  The `car's of the
;; alist elements are used as keys.
(defun gnus-make-hashtable-from-newsrc-alist ()
  (let ((alist gnus-newsrc-alist)

			   (concat " from " where) "")
		       (car method)))
    (gnus-message 5 mesg)
    (when (gnus-check-server method)
      ;; Request that the backend scan its incoming messages.
      (when (gnus-check-backend-function 'request-scan (car method))
	(gnus-request-scan nil method))
      (cond
       ((and (eq gnus-read-active-file 'some)
	     (gnus-check-backend-function 'retrieve-groups (car method))
	     (not force))

110189:821c596efa5f

		  gnus-activate-foreign-newsgroups)
		 (t 0))
	   alevel))
	 (methods-cache nil)
	 (type-cache nil)
	 infos info group active method cmethod
	 method-type method-group-list)
    (gnus-message 6 "Checking new news...")

    (while newsrc
      (setq active (gnus-active (setq group (gnus-info-group
					     (setq info (pop newsrc))))))

      ;; >0 for an active group with messages
      ;; 0 for an active group with no unread messages
      ;; nil for non-foreign groups that the user has requested not be checked
      ;; t for unchecked foreign groups or bogus groups, or groups that can't
      ;;   be checked, for one reason or other.

      ;; 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)
	(if (setq cmethod (assoc method methods-cache))
	    (setq method (cdr cmethod))
	  (setq cmethod (inline (gnus-server-get-method nil method)))
	  (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
	       ((gnus-secondary-method-p method)
		'secondary)
	       ((inline (gnus-server-equal gnus-select-method method))
		'primary)
	       (t
		'foreign)))
	(push (setq method-group-list (list method method-type nil))
	      type-cache))
      (setcar (nthcdr 2 method-group-list)
	      (cons info (nth 2 method-group-list))))

    ;; 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 behaviour 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))))))

    (while type-cache
      (setq method (nth 0 (car type-cache))
	    method-type (nth 1 (car type-cache))
	    infos (nth 2 (car type-cache)))
      (pop type-cache)

      ;; See if any of the groups from this method require updating.
      (when (block nil
	      (dolist (info infos)
		(when (<= (gnus-info-level info)
			  (if (eq method-type 'foreign)
			      foreign-level
			    alevel))
		  (return t))))
	(gnus-read-active-for-groups method infos)
	(dolist (info infos)
	  (inline (gnus-get-unread-articles-in-group
		   info (gnus-active (gnus-info-group info)))))))
    (gnus-message 6 "Checking new news...done")))

(defun gnus-method-rank (type method)
  (cond
   ((eq type 'primary)
    1)
   ;; Compute the rank of the secondary methods based on where they
   ;; are in the secondary select list.
   ((eq type 'secondary)
    (let ((i 2))
      (block nil
	(dolist (smethod gnus-secondary-select-methods)
	  (when (equalp method smethod)
	    (return i))
	  (incf i))
	i)))
   ;; Just say that all foreign groups have the same rank.
   (t
    100)))

(defun gnus-read-active-for-groups (method infos)
  (with-current-buffer nntp-server-buffer
    (cond
     ((gnus-check-backend-function 'retrieve-groups (car method))
      (gnus-read-active-file-2
       (mapcar (lambda (info)
		 (gnus-group-real-name (gnus-info-group info)))
	       infos)
       method))
     ((gnus-check-backend-function 'request-list (car method))
      (gnus-read-active-file-1 method nil))
     (t
      (dolist (info infos)
	(gnus-activate-group (gnus-info-group info) nil nil method))))))

;; Create a hash table out of the newsrc alist.  The `car's of the
;; alist elements are used as keys.
(defun gnus-make-hashtable-from-newsrc-alist ()
  (let ((alist gnus-newsrc-alist)

			   (concat " from " where) "")
		       (car method)))
    (gnus-message 5 mesg)
    (when (gnus-check-server method)
      ;; Request that the backend scan its incoming messages.
      (when (and gnus-agent
		 (gnus-online method)
		 (gnus-check-backend-function 'request-scan (car method)))
	(gnus-request-scan nil method))
      (cond
       ((and (eq gnus-read-active-file 'some)
	     (gnus-check-backend-function 'retrieve-groups (car method))
	     (not force))