emacs: lisp/gnus/gnus-agent.el comparison

comparison lisp/gnus/gnus-agent.el @ 88155:d7ddb3e565de

sync with trunk

author	Henrik Enberg <henrik.enberg@telia.com>
date	Mon, 16 Jan 2006 00:03:54 +0000
parents	0d8b17d428b5
children

comparison

equal deleted inserted replaced

-:8ce476d3ba36
+:d7ddb3e565de
 ;;; gnus-agent.el --- unplugged support for Gnus
-;; Copyright (C) 1997, 1998, 1999, 2000 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
+;;   2005 Free Software Foundation, Inc.
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; This file is part of GNU Emacs.
 ;; GNU Emacs is free software; you can redistribute it and/or modify
 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.	 See the
 ;; GNU General Public License for more details.
 ;; You should have received a copy of the GNU General Public License
 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02111-1307, USA.
+;; Boston, MA 02110-1301, USA.
 ;;; Commentary:
 ;;; Code:
 (require 'gnus)
 (require 'gnus-cache)
+(require 'nnmail)
 (require 'nnvirtual)
 (require 'gnus-sum)
 (require 'gnus-score)
+(require 'gnus-srvr)
+(require 'gnus-util)
 (eval-when-compile
 (if (featurep 'xemacs)
 (require 'itimer)
 (require 'timer))
 (require 'cl))
+(eval-and-compile
+(autoload 'gnus-server-update-server "gnus-srvr")
+(autoload 'gnus-agent-customize-category "gnus-cus")
+)
 (defcustom gnus-agent-directory (nnheader-concat gnus-directory "agent/")
 "Where the Gnus agent will store its files."
 :group 'gnus-agent
 :type 'directory)
 (defcustom gnus-agent-unplugged-hook nil
 "Hook run when unplugging from the network."
 :group 'gnus-agent
 :type 'hook)
+(defcustom gnus-agent-fetched-hook nil
+"Hook run when finished fetching articles."
+:version "22.1"
+:group 'gnus-agent
+:type 'hook)
 (defcustom gnus-agent-handle-level gnus-level-subscribed
 "Groups on levels higher than this variable will be ignored by the Agent."
 :group 'gnus-agent
 :type 'integer)
 (defcustom gnus-agent-expire-days 7
-"Read articles older than this will be expired."
+"Read articles older than this will be expired.
+If you wish to disable Agent expiring, see `gnus-agent-enable-expiration'."
 :group 'gnus-agent
-:type 'integer)
+:type '(number :tag "days"))
 (defcustom gnus-agent-expire-all nil
 "If non-nil, also expire unread, ticked and dormant articles.
 If nil, only read articles will be expired."
 :group 'gnus-agent
 (defcustom gnus-agent-group-mode-hook nil
 "Hook run in Agent group minor modes."
 :group 'gnus-agent
 :type 'hook)
+;; Extracted from gnus-xmas-redefine in order to preserve user settings
+(when (featurep 'xemacs)
+(add-hook 'gnus-agent-group-mode-hook 'gnus-xmas-agent-group-menu-add))
 (defcustom gnus-agent-summary-mode-hook nil
 "Hook run in Agent summary minor modes."
 :group 'gnus-agent
 :type 'hook)
+;; Extracted from gnus-xmas-redefine in order to preserve user settings
+(when (featurep 'xemacs)
+(add-hook 'gnus-agent-summary-mode-hook 'gnus-xmas-agent-summary-menu-add))
 (defcustom gnus-agent-server-mode-hook nil
 "Hook run in Agent summary minor modes."
 :group 'gnus-agent
 :type 'hook)
+;; Extracted from gnus-xmas-redefine in order to preserve user settings
+(when (featurep 'xemacs)
+(add-hook 'gnus-agent-server-mode-hook 'gnus-xmas-agent-server-menu-add))
 (defcustom gnus-agent-confirmation-function 'y-or-n-p
 "Function to confirm when error happens."
 :version "21.1"
 :group 'gnus-agent
 :type 'function)
-(defcustom gnus-agent-synchronize-flags 'ask
+(defcustom gnus-agent-synchronize-flags t
 "Indicate if flags are synchronized when you plug in.
 If this is `ask' the hook will query the user."
+;; If the default switches to something else than nil, then the function
+;; should be fixed not be exceedingly slow.  See 2005-09-20 ChangeLog entry.
 :version "21.1"
 :type '(choice (const :tag "Always" t)
 		 (const :tag "Never" nil)
 		 (const :tag "Ask" ask))
 :group 'gnus-agent)
+(defcustom gnus-agent-go-online 'ask
+"Indicate if offline servers go online when you plug in.
+If this is `ask' the hook will query the user."
+:version "21.3"
+:type '(choice (const :tag "Always" t)
+		 (const :tag "Never" nil)
+		 (const :tag "Ask" ask))
+:group 'gnus-agent)
+(defcustom gnus-agent-mark-unread-after-downloaded t
+"Indicate whether to mark articles unread after downloaded."
+:version "21.1"
+:type 'boolean
+:group 'gnus-agent)
+(defcustom gnus-agent-download-marks '(download)
+"Marks for downloading."
+:version "21.1"
+:type '(repeat (symbol :tag "Mark"))
+:group 'gnus-agent)
+(defcustom gnus-agent-consider-all-articles nil
+"When non-nil, the agent will let the agent predicate decide
+whether articles need to be downloaded or not, for all articles.  When
+nil, the default, the agent will only let the predicate decide
+whether unread articles are downloaded or not.  If you enable this,
+groups with large active ranges may open slower and you may also want
+to look into the agent expiry settings to block the expiration of
+read articles as they would just be downloaded again."
+:version "22.1"
+:type 'boolean
+:group 'gnus-agent)
+(defcustom gnus-agent-max-fetch-size 10000000 ;; 10 Mb
+"Chunk size for `gnus-agent-fetch-session'.
+The function will split its article fetches into chunks smaller than
+this limit."
+:version "22.1"
+:group 'gnus-agent
+:type 'integer)
+(defcustom gnus-agent-enable-expiration 'ENABLE
+"The default expiration state for each group.
+When set to ENABLE, the default, `gnus-agent-expire' will expire old
+contents from a group's local storage.  This value may be overridden
+to disable expiration in specific categories, topics, and groups.  Of
+course, you could change gnus-agent-enable-expiration to DISABLE then
+enable expiration per categories, topics, and groups."
+:version "22.1"
+:group 'gnus-agent
+:type '(radio (const :format "Enable " ENABLE)
+(const :format "Disable " DISABLE)))
+(defcustom gnus-agent-expire-unagentized-dirs t
+"*Whether expiration should expire in unagentized directories.
+Have gnus-agent-expire scan the directories under
+\(gnus-agent-directory) for groups that are no longer agentized.
+When found, offer to remove them."
+:version "22.1"
+:type 'boolean
+:group 'gnus-agent)
+(defcustom gnus-agent-auto-agentize-methods '(nntp nnimap)
+"Initially, all servers from these methods are agentized.
+The user may remove or add servers using the Server buffer.
+See Info node `(gnus)Server Buffer'."
+:version "22.1"
+:type '(repeat symbol)
+:group 'gnus-agent)
+(defcustom gnus-agent-queue-mail t
+"Whether and when outgoing mail should be queued by the agent.
+When `always', always queue outgoing mail.  When nil, never
+queue.  Otherwise, queue if and only if unplugged."
+:version "22.1"
+:group 'gnus-agent
+:type '(radio (const :format "Always" always)
+		(const :format "Never" nil)
+		(const :format "When plugged" t)))
+(defcustom gnus-agent-prompt-send-queue nil
+"If non-nil, `gnus-group-send-queue' will prompt if called when
+unplugged."
+:version "22.1"
+:group 'gnus-agent
+:type 'boolean)
+(defcustom gnus-agent-article-alist-save-format 1
+"Indicates whether to use compression(2), versus no
+compression(1), when writing agentview files.  The compressed
+files do save space but load times are 6-7 times higher.  A group
+must be opened then closed for the agentview to be updated using
+the new format."
+;; Wouldn't symbols instead numbers be nicer?  --rsteib
+:version "22.1"
+:group 'gnus-agent
+:type '(radio (const :format "Compressed" 2)
+		(const :format "Uncompressed" 1)))
 ;;; Internal variables
 (defvar gnus-agent-history-buffers nil)
 (defvar gnus-agent-buffer-alist nil)
-(defvar gnus-agent-article-alist nil)
+(defvar gnus-agent-article-alist nil
+"An assoc list identifying the articles whose headers have been fetched.
+If successfully fetched, these headers will be stored in the group's overview
+file.  The key of each assoc pair is the article ID, the value of each assoc
+pair is a flag indicating whether the identified article has been downloaded
+\(gnus-agent-fetch-articles sets the value to the day of the download).
+NOTES:
+1) The last element of this list can not be expired as some
+routines (for example, get-agent-fetch-headers) use the last
+value to track which articles have had their headers retrieved.
+2) The function `gnus-agent-regenerate' may destructively modify the value.")
 (defvar gnus-agent-group-alist nil)
-(defvar gnus-agent-covered-methods nil)
 (defvar gnus-category-alist nil)
 (defvar gnus-agent-current-history nil)
 (defvar gnus-agent-overview-buffer nil)
 (defvar gnus-category-predicate-cache nil)
 (defvar gnus-category-group-cache nil)
 (defvar gnus-agent-spam-hashtb nil)
 (defvar gnus-agent-file-name nil)
 (defvar gnus-agent-send-mail-function nil)
 (defvar gnus-agent-file-coding-system 'raw-text)
+(defvar gnus-agent-file-loading-cache nil)
 ;; Dynamic variables
 (defvar gnus-headers)
 (defvar gnus-score)
 nil))
 (gnus-add-shutdown 'gnus-close-agent 'gnus)
 (defun gnus-close-agent ()
-(setq gnus-agent-covered-methods nil
+(setq gnus-category-predicate-cache nil
-	gnus-category-predicate-cache nil
 	gnus-category-group-cache nil
 	gnus-agent-spam-hashtb nil)
 (gnus-kill-buffer gnus-agent-overview-buffer))
 ;;;
 "The full name of the Gnus agent library FILE."
 (expand-file-name file
 		    (file-name-as-directory
 		     (expand-file-name "agent.lib" (gnus-agent-directory)))))
+(defun gnus-agent-cat-set-property (category property value)
+(if value
+(setcdr (or (assq property category)
+(let ((cell (cons property nil)))
+(setcdr category (cons cell (cdr category)))
+cell)) value)
+(let ((category category))
+(while (cond ((eq property (caadr category))
+(setcdr category (cddr category))
+nil)
+(t
+(setq category (cdr category)))))))
+category)
+(eval-when-compile
+(defmacro gnus-agent-cat-defaccessor (name prop-name)
+"Define accessor and setter methods for manipulating a list of the form
+\(NAME (PROPERTY1 VALUE1) ... (PROPERTY_N VALUE_N)).
+Given the call (gnus-agent-cat-defaccessor func PROPERTY1), the list may be
+manipulated as follows:
+(func LIST): Returns VALUE1
+(setf (func LIST) NEW_VALUE1): Replaces VALUE1 with NEW_VALUE1."
+`(progn (defmacro ,name (category)
+(list (quote cdr) (list (quote assq)
+(quote (quote ,prop-name)) category)))
+(define-setf-method ,name (category)
+(let* ((--category--temp-- (make-symbol "--category--"))
+(--value--temp-- (make-symbol "--value--")))
+(list (list --category--temp--) ; temporary-variables
+(list category)   ; value-forms
+(list --value--temp--) ; store-variables
+(let* ((category --category--temp--) ; store-form
+(value --value--temp--))
+(list (quote gnus-agent-cat-set-property)
+category
+(quote (quote ,prop-name))
+value))
+(list (quote ,name) --category--temp--) ; access-form
+)))))
+)
+(defmacro gnus-agent-cat-name (category)
+`(car ,category))
+(gnus-agent-cat-defaccessor
+gnus-agent-cat-days-until-old             agent-days-until-old)
+(gnus-agent-cat-defaccessor
+gnus-agent-cat-enable-expiration          agent-enable-expiration)
+(gnus-agent-cat-defaccessor
+gnus-agent-cat-groups                     agent-groups)
+(gnus-agent-cat-defaccessor
+gnus-agent-cat-high-score                 agent-high-score)
+(gnus-agent-cat-defaccessor
+gnus-agent-cat-length-when-long           agent-long-article)
+(gnus-agent-cat-defaccessor
+gnus-agent-cat-length-when-short          agent-short-article)
+(gnus-agent-cat-defaccessor
+gnus-agent-cat-low-score                  agent-low-score)
+(gnus-agent-cat-defaccessor
+gnus-agent-cat-predicate                  agent-predicate)
+(gnus-agent-cat-defaccessor
+gnus-agent-cat-score-file                 agent-score)
+(gnus-agent-cat-defaccessor
+gnus-agent-cat-enable-undownloaded-faces  agent-enable-undownloaded-faces)
+;; This form is equivalent to defsetf except that it calls make-symbol
+;; whereas defsetf calls gensym (Using gensym creates a run-time
+;; dependency on the CL library).
+(eval-and-compile
+(define-setf-method gnus-agent-cat-groups (category)
+(let* ((--category--temp-- (make-symbol "--category--"))
+	   (--groups--temp-- (make-symbol "--groups--")))
+(list (list --category--temp--)
+	    (list category)
+	    (list --groups--temp--)
+	    (let* ((category --category--temp--)
+		   (groups --groups--temp--))
+	      (list (quote gnus-agent-set-cat-groups) category groups))
+	    (list (quote gnus-agent-cat-groups) --category--temp--))))
+)
+(defun gnus-agent-set-cat-groups (category groups)
+(unless (eq groups 'ignore)
+(let ((new-g groups)
+(old-g (gnus-agent-cat-groups category)))
+(cond ((eq new-g old-g)
+;; gnus-agent-add-group is fiddling with the group
+;; list. Still, Im done.
+nil
+)
+((eq new-g (cdr old-g))
+;; gnus-agent-add-group is fiddling with the group list
+(setcdr (or (assq 'agent-groups category)
+(let ((cell (cons 'agent-groups nil)))
+(setcdr category (cons cell (cdr category)))
+cell)) new-g))
+(t
+(let ((groups groups))
+(while groups
+(let* ((group        (pop groups))
+(old-category (gnus-group-category group)))
+(if (eq category old-category)
+nil
+(setf (gnus-agent-cat-groups old-category)
+(delete group (gnus-agent-cat-groups
+old-category))))))
+;; Purge cache as preceeding loop invalidated it.
+(setq gnus-category-group-cache nil))
+(setcdr (or (assq 'agent-groups category)
+(let ((cell (cons 'agent-groups nil)))
+(setcdr category (cons cell (cdr category)))
+cell)) groups))))))
+(defsubst gnus-agent-cat-make (name &optional default-agent-predicate)
+(list name `(agent-predicate . ,(or default-agent-predicate 'false))))
 ;;; Fetching setup functions.
 (defun gnus-agent-start-fetch ()
 "Initialize data structures for efficient fetching."
-(gnus-agent-open-history)
-(setq gnus-agent-current-history (gnus-agent-history-buffer))
 (gnus-agent-create-buffer))
 (defun gnus-agent-stop-fetch ()
 "Save all data structures and clean up."
-(gnus-agent-save-history)
-(gnus-agent-close-history)
 (setq gnus-agent-spam-hashtb nil)
 (save-excursion
 (set-buffer nntp-server-buffer)
 (widen)))
 	 ,@forms)
 (gnus-agent-stop-fetch)))
 (put 'gnus-agent-with-fetch 'lisp-indent-function 0)
 (put 'gnus-agent-with-fetch 'edebug-form-spec '(body))
+(defmacro gnus-agent-append-to-list (tail value)
+`(setq ,tail (setcdr ,tail (cons ,value nil))))
+(defmacro gnus-agent-message (level &rest args)
+`(if (<= ,level gnus-verbose)
+(message ,@args)))
 ;;;
 ;;; Mode infestation
 ;;;
 (unless (assq mode minor-mode-map-alist)
 (push (cons mode (symbol-value (intern (format "gnus-agent-%s-mode-map"
 						     buffer))))
 	    minor-mode-map-alist))
 (when (eq major-mode 'gnus-group-mode)
-(gnus-agent-toggle-plugged gnus-plugged))
+(let ((init-plugged gnus-plugged)
+(gnus-agent-go-online nil))
+;; g-a-t-p does nothing when gnus-plugged isn't changed.
+;; Therefore, make certain that the current value does not
+;; match the desired initial value.
+(setq gnus-plugged :unknown)
+(gnus-agent-toggle-plugged init-plugged)))
 (gnus-run-hooks 'gnus-agent-mode-hook
 		    (intern (format "gnus-agent-%s-mode-hook" buffer)))))
 (defvar gnus-agent-group-mode-map (make-sparse-keymap))
 (gnus-define-keys gnus-agent-group-mode-map
 "Ju" gnus-agent-fetch-groups
 "Jc" gnus-enter-category-buffer
 "Jj" gnus-agent-toggle-plugged
 "Js" gnus-agent-fetch-session
 "JY" gnus-agent-synchronize-flags
-"JS" gnus-group-send-drafts
+"JS" gnus-group-send-queue
 "Ja" gnus-agent-add-group
-"Jr" gnus-agent-remove-group)
+"Jr" gnus-agent-remove-group
+"Jo" gnus-agent-toggle-group-plugged)
 (defun gnus-agent-group-make-menu-bar ()
 (unless (boundp 'gnus-agent-group-menu)
 (easy-menu-define
 gnus-agent-group-menu gnus-agent-group-mode-map ""
 '("Agent"
 ["Toggle plugged" gnus-agent-toggle-plugged t]
+["Toggle group plugged" gnus-agent-toggle-group-plugged t]
 ["List categories" gnus-enter-category-buffer t]
-["Send drafts" gnus-group-send-drafts gnus-plugged]
+["Add (current) group to category" gnus-agent-add-group t]
+["Remove (current) group from category" gnus-agent-remove-group t]
+["Send queue" gnus-group-send-queue gnus-plugged]
 ("Fetch"
 	["All" gnus-agent-fetch-session gnus-plugged]
-	["Group" gnus-agent-fetch-group gnus-plugged])))))
+	["Group" gnus-agent-fetch-group gnus-plugged])
+["Synchronize flags" gnus-agent-synchronize-flags t]
+))))
 (defvar gnus-agent-summary-mode-map (make-sparse-keymap))
 (gnus-define-keys gnus-agent-summary-mode-map
 "Jj" gnus-agent-toggle-plugged
+"Ju" gnus-agent-summary-fetch-group
+"JS" gnus-agent-fetch-group
+"Js" gnus-agent-summary-fetch-series
 "J#" gnus-agent-mark-article
 "J\M-#" gnus-agent-unmark-article
 "@" gnus-agent-toggle-mark
 "Jc" gnus-agent-catchup)
 '("Agent"
 ["Toggle plugged" gnus-agent-toggle-plugged t]
 ["Mark as downloadable" gnus-agent-mark-article t]
 ["Unmark as downloadable" gnus-agent-unmark-article t]
 ["Toggle mark" gnus-agent-toggle-mark t]
+["Fetch downloadable" gnus-agent-summary-fetch-group t]
 ["Catchup undownloaded" gnus-agent-catchup t]))))
 (defvar gnus-agent-server-mode-map (make-sparse-keymap))
 (gnus-define-keys gnus-agent-server-mode-map
 "Jj" gnus-agent-toggle-plugged
 '("Agent"
 ["Toggle plugged" gnus-agent-toggle-plugged t]
 ["Add" gnus-agent-add-server t]
 ["Remove" gnus-agent-remove-server t]))))
-(defun gnus-agent-toggle-plugged (plugged)
+(defun gnus-agent-make-mode-line-string (string mouse-button mouse-func)
+(if (and (fboundp 'propertize)
+	   (fboundp 'make-mode-line-mouse-map))
+(propertize string 'local-map
+		  (make-mode-line-mouse-map mouse-button mouse-func)
+		  'mouse-face 'mode-line-highlight)
+string))
+(defun gnus-agent-toggle-plugged (set-to)
 "Toggle whether Gnus is unplugged or not."
 (interactive (list (not gnus-plugged)))
-(if plugged
+(cond ((eq set-to gnus-plugged)
-(progn
+nil)
-	(setq gnus-plugged plugged)
+(set-to
-	(gnus-agent-possibly-synchronize-flags)
+(setq gnus-plugged set-to)
-	(gnus-run-hooks 'gnus-agent-plugged-hook)
+(gnus-run-hooks 'gnus-agent-plugged-hook)
-	(setcar (cdr gnus-agent-mode-status) " Plugged"))
+(setcar (cdr gnus-agent-mode-status)
-(gnus-agent-close-connections)
+(gnus-agent-make-mode-line-string " Plugged"
-(setq gnus-plugged plugged)
+'mouse-2
-(gnus-run-hooks 'gnus-agent-unplugged-hook)
+'gnus-agent-toggle-plugged))
-(setcar (cdr gnus-agent-mode-status) " Unplugged"))
+(gnus-agent-go-online gnus-agent-go-online)
+(gnus-agent-possibly-synchronize-flags))
+(t
+(gnus-agent-close-connections)
+(setq gnus-plugged set-to)
+(gnus-run-hooks 'gnus-agent-unplugged-hook)
+(setcar (cdr gnus-agent-mode-status)
+(gnus-agent-make-mode-line-string " Unplugged"
+'mouse-2
+'gnus-agent-toggle-plugged))))
 (set-buffer-modified-p t))
+(defmacro gnus-agent-while-plugged (&rest body)
+`(let ((original-gnus-plugged gnus-plugged))
+(unwind-protect
+(progn (gnus-agent-toggle-plugged t)
+,@body)
+(gnus-agent-toggle-plugged original-gnus-plugged))))
+(put 'gnus-agent-while-plugged 'lisp-indent-function 0)
+(put 'gnus-agent-while-plugged 'edebug-form-spec '(body))
 (defun gnus-agent-close-connections ()
 "Close all methods covered by the Gnus agent."
-(let ((methods gnus-agent-covered-methods))
+(let ((methods (gnus-agent-covered-methods)))
 (while methods
 (gnus-close-server (pop methods)))))
 ;;;###autoload
 (defun gnus-unplugged ()
 (interactive)
 (setq gnus-plugged t)
 (gnus))
 ;;;###autoload
+(defun gnus-slave-unplugged (&optional arg)
+"Read news as a slave unplugged."
+(interactive "P")
+(setq gnus-plugged nil)
+(gnus arg nil 'slave))
+;;;###autoload
 (defun gnus-agentize ()
 "Allow Gnus to be an offline newsreader.
-The normal usage of this command is to put the following as the
-last form in your `.gnus.el' file:
+The gnus-agentize function is now called internally by gnus when
+gnus-agent is set.  If you wish to avoid calling gnus-agentize,
-\(gnus-agentize)
+customize gnus-agent to nil.
-This will modify the `gnus-before-startup-hook', `gnus-post-method',
+This will modify the `gnus-setup-news-hook', and
-and `message-send-mail-function' variables, and install the Gnus
+`message-send-mail-real-function' variables, and install the Gnus agent
-agent minor mode in all Gnus buffers."
+minor mode in all Gnus buffers."
 (interactive)
 (gnus-open-agent)
 (add-hook 'gnus-setup-news-hook 'gnus-agent-queue-setup)
 (unless gnus-agent-send-mail-function
-(setq gnus-agent-send-mail-function message-send-mail-function
+(setq gnus-agent-send-mail-function
-	  message-send-mail-function 'gnus-agent-send-mail))
+	  (or message-send-mail-real-function
-(unless gnus-agent-covered-methods
+	      (function (lambda () (funcall message-send-mail-function))))
-(setq gnus-agent-covered-methods (list gnus-select-method))))
+	  message-send-mail-real-function 'gnus-agent-send-mail))
-(defun gnus-agent-queue-setup ()
+;; If the servers file doesn't exist, auto-agentize some servers and
-"Make sure the queue group exists."
+;; save the servers file so this auto-agentizing isn't invoked
-(unless (gnus-gethash "nndraft:queue" gnus-newsrc-hashtb)
+;; again.
-(gnus-request-create-group "queue" '(nndraft ""))
+(unless (file-exists-p (nnheader-concat gnus-agent-directory "lib/servers"))
+(gnus-message 3 "First time agent user, agentizing remote groups...")
+(mapc
+(lambda (server-or-method)
+(let ((method (gnus-server-to-method server-or-method)))
+	 (when (memq (car method)
+		     gnus-agent-auto-agentize-methods)
+	   (push (gnus-method-to-server method)
+		 gnus-agent-covered-methods)
+	   (setq gnus-agent-method-p-cache nil))))
+(cons gnus-select-method gnus-secondary-select-methods))
+(gnus-agent-write-servers)))
+(defun gnus-agent-queue-setup (&optional group-name)
+"Make sure the queue group exists.
+Optional arg GROUP-NAME allows to specify another group."
+(unless (gnus-gethash (format "nndraft:%s" (or group-name "queue"))
+			gnus-newsrc-hashtb)
+(gnus-request-create-group (or group-name "queue") '(nndraft ""))
 (let ((gnus-level-default-subscribed 1))
-(gnus-subscribe-group "nndraft:queue" nil '(nndraft "")))
+(gnus-subscribe-group (format "nndraft:%s" (or group-name "queue"))
+			    nil '(nndraft "")))
 (gnus-group-set-parameter
-"nndraft:queue" 'gnus-dummy '((gnus-draft-mode)))))
+(format "nndraft:%s" (or group-name "queue"))
+'gnus-dummy '((gnus-draft-mode)))))
 (defun gnus-agent-send-mail ()
-(if gnus-plugged
+(if (or (not gnus-agent-queue-mail)
+	  (and gnus-plugged (not (eq gnus-agent-queue-mail 'always))))
 (funcall gnus-agent-send-mail-function)
 (goto-char (point-min))
 (re-search-forward
 (concat "^" (regexp-quote mail-header-separator) "\n"))
 (replace-match "\n")
 (gnus-agent-insert-meta-information 'mail)
 (gnus-request-accept-article "nndraft:queue" nil t t)))
 (defun gnus-agent-insert-meta-information (type &optional method)
 "Insert meta-information into the message that says how it's to be posted.
-TYPE can be either `mail' or `news'.  If the latter METHOD can
+TYPE can be either `mail' or `news'.  If the latter, then METHOD can
 be a select method."
 (save-excursion
 (message-remove-header gnus-agent-meta-information-header)
 (goto-char (point-min))
 (insert gnus-agent-meta-information-header ": "
 (defun gnus-agent-restore-gcc ()
 "Restore GCC field from saved header."
 (save-excursion
 (goto-char (point-min))
-(while (re-search-forward (concat gnus-agent-gcc-header ":") nil t)
+(while (re-search-forward
+	    (concat "^" (regexp-quote gnus-agent-gcc-header) ":") nil t)
 (replace-match "Gcc:" 'fixedcase))))
 (defun gnus-agent-any-covered-gcc ()
 (save-restriction
 (message-narrow-to-headers)
 				 (message-unquote-tokens
 				  (message-tokenize-header
 				   gcc " ,")))))
 	   covered)
 (while (and (not covered) methods)
-	(setq covered
+	(setq covered (gnus-agent-method-p (car methods))
-	      (member (car methods) gnus-agent-covered-methods)
 	      methods (cdr methods)))
 covered)))
+;;;###autoload
 (defun gnus-agent-possibly-save-gcc ()
 "Save GCC if Gnus is unplugged."
 (when (and (not gnus-plugged) (gnus-agent-any-covered-gcc))
 (save-excursion
 (goto-char (point-min))
 (interactive "P")
 (unless gnus-plugged
 (error "Groups can't be fetched when Gnus is unplugged"))
 (gnus-group-iterate n 'gnus-agent-fetch-group))
-(defun gnus-agent-fetch-group (group)
+(defun gnus-agent-fetch-group (&optional group)
 "Put all new articles in GROUP into the Agent."
 (interactive (list (gnus-group-group-name)))
-(unless gnus-plugged
+(setq group (or group gnus-newsgroup-name))
-(error "Groups can't be fetched when Gnus is unplugged"))
 (unless group
 (error "No group on the current line"))
-(let ((gnus-command-method (gnus-find-method-for-group group)))
-(gnus-agent-with-fetch
+(gnus-agent-while-plugged
-(gnus-agent-fetch-group-1 group gnus-command-method)
+(let ((gnus-command-method (gnus-find-method-for-group group)))
-(gnus-message 5 "Fetching %s...done" group))))
+(gnus-agent-with-fetch
+(gnus-agent-fetch-group-1 group gnus-command-method)
+(gnus-message 5 "Fetching %s...done" group)))))
 (defun gnus-agent-add-group (category arg)
 "Add the current group to an agent category."
 (interactive
 (list
 current-prefix-arg))
 (let ((cat (assq category gnus-category-alist))
 	c groups)
 (gnus-group-iterate arg
 (lambda (group)
-	(when (cadddr (setq c (gnus-group-category group)))
+	(when (gnus-agent-cat-groups (setq c (gnus-group-category group)))
-	  (setf (cadddr c) (delete group (cadddr c))))
+	  (setf (gnus-agent-cat-groups c)
+(delete group (gnus-agent-cat-groups c))))
 	(push group groups)))
-(setf (cadddr cat) (nconc (cadddr cat) groups))
+(setf (gnus-agent-cat-groups cat)
+(nconc (gnus-agent-cat-groups cat) groups))
 (gnus-category-write)))
 (defun gnus-agent-remove-group (arg)
 "Remove the current group from its agent category, if any."
 (interactive "P")
 (let (c)
 (gnus-group-iterate arg
 (lambda (group)
-	(when (cadddr (setq c (gnus-group-category group)))
+	(when (gnus-agent-cat-groups (setq c (gnus-group-category group)))
-	  (setf (cadddr c) (delete group (cadddr c))))))
+	  (setf (gnus-agent-cat-groups c)
+(delete group (gnus-agent-cat-groups c))))))
 (gnus-category-write)))
 (defun gnus-agent-synchronize-flags ()
 "Synchronize unplugged flags with servers."
 (interactive)
 (save-excursion
-(dolist (gnus-command-method gnus-agent-covered-methods)
+(dolist (gnus-command-method (gnus-agent-covered-methods))
 (when (file-exists-p (gnus-agent-lib-file "flags"))
 	(gnus-agent-synchronize-flags-server gnus-command-method)))))
 (defun gnus-agent-possibly-synchronize-flags ()
 "Synchronize flags according to `gnus-agent-synchronize-flags'."
 (interactive)
 (save-excursion
-(dolist (gnus-command-method gnus-agent-covered-methods)
+(dolist (gnus-command-method (gnus-agent-covered-methods))
-(when (file-exists-p (gnus-agent-lib-file "flags"))
+(when (and (file-exists-p (gnus-agent-lib-file "flags"))
+		 (not (eq (gnus-server-status gnus-command-method) 'offline)))
 	(gnus-agent-possibly-synchronize-flags-server gnus-command-method)))))
 (defun gnus-agent-synchronize-flags-server (method)
 "Synchronize flags set when unplugged for server."
-(let ((gnus-command-method method))
+(let ((gnus-command-method method)
+	(gnus-agent nil))
 (when (file-exists-p (gnus-agent-lib-file "flags"))
 (set-buffer (get-buffer-create " *Gnus Agent flag synchronize*"))
 (erase-buffer)
 (nnheader-insert-file-contents (gnus-agent-lib-file "flags"))
-(if (null (gnus-check-server gnus-command-method))
+(cond ((null gnus-plugged)
-	  (message "Couldn't open server %s" (nth 1 gnus-command-method))
+	     (gnus-message
-	(while (not (eobp))
+	      1 "You must be plugged to synchronize flags with server %s"
-	  (if (null (eval (read (current-buffer))))
+	      (nth 1 gnus-command-method)))
-	      (progn (forward-line)
+	    ((null (gnus-check-server gnus-command-method))
-		     (kill-line -1))
+	     (gnus-message
-	    (write-file (gnus-agent-lib-file "flags"))
+	      1 "Couldn't open server %s" (nth 1 gnus-command-method)))
-	    (error "Couldn't set flags from file %s"
+	    (t
-		   (gnus-agent-lib-file "flags"))))
+	     (condition-case err
-	(delete-file (gnus-agent-lib-file "flags")))
+		 (while t
+		   (let ((bgn (point)))
+		     (eval (read (current-buffer)))
+		     (delete-region bgn (point))))
+	       (end-of-file
+		(delete-file (gnus-agent-lib-file "flags")))
+	       (error
+		(let ((file (gnus-agent-lib-file "flags")))
+		  (write-region (point-min) (point-max)
+				(gnus-agent-lib-file "flags") nil 'silent)
+		  (error "Couldn't set flags from file %s due to %s"
+			 file (error-message-string err)))))))
 (kill-buffer nil))))
 (defun gnus-agent-possibly-synchronize-flags-server (method)
 "Synchronize flags for server according to `gnus-agent-synchronize-flags'."
 (when (or (and gnus-agent-synchronize-flags
 	    (and (eq gnus-agent-synchronize-flags 'ask)
 		 (gnus-y-or-n-p (format "Synchronize flags on server `%s'? "
 					(cadr method)))))
 (gnus-agent-synchronize-flags-server method)))
+;;;###autoload
+(defun gnus-agent-rename-group (old-group new-group)
+"Rename fully-qualified OLD-GROUP as NEW-GROUP.
+Always updates the agent, even when disabled, as the old agent
+files would corrupt gnus when the agent was next enabled.
+Depends upon the caller to determine whether group renaming is
+supported."
+(let* ((old-command-method (gnus-find-method-for-group old-group))
+	 (old-path           (directory-file-name
+			      (let (gnus-command-method old-command-method)
+				(gnus-agent-group-pathname old-group))))
+	 (new-command-method (gnus-find-method-for-group new-group))
+	 (new-path           (directory-file-name
+			      (let (gnus-command-method new-command-method)
+				(gnus-agent-group-pathname new-group)))))
+(gnus-rename-file old-path new-path t)
+(let* ((old-real-group (gnus-group-real-name old-group))
+	   (new-real-group (gnus-group-real-name new-group))
+	   (old-active (gnus-agent-get-group-info old-command-method old-real-group)))
+(gnus-agent-save-group-info old-command-method old-real-group nil)
+(gnus-agent-save-group-info new-command-method new-real-group old-active)
+(let ((old-local (gnus-agent-get-local old-group
+					     old-real-group old-command-method)))
+	(gnus-agent-set-local old-group
+			      nil nil
+			      old-real-group old-command-method)
+	(gnus-agent-set-local new-group
+			      (car old-local) (cdr old-local)
+			      new-real-group new-command-method)))))
+;;;###autoload
+(defun gnus-agent-delete-group (group)
+"Delete fully-qualified GROUP.
+Always updates the agent, even when disabled, as the old agent
+files would corrupt gnus when the agent was next enabled.
+Depends upon the caller to determine whether group deletion is
+supported."
+(let* ((command-method (gnus-find-method-for-group group))
+	 (path           (directory-file-name
+			  (let (gnus-command-method command-method)
+			    (gnus-agent-group-pathname group)))))
+(gnus-delete-directory path)
+(let* ((real-group (gnus-group-real-name group)))
+(gnus-agent-save-group-info command-method real-group nil)
+(let ((local (gnus-agent-get-local group
+					 real-group command-method)))
+	(gnus-agent-set-local group
+			      nil nil
+			      real-group command-method)))))
 ;;;
 ;;; Server mode commands
 ;;;
-(defun gnus-agent-add-server (server)
+(defun gnus-agent-add-server ()
 "Enroll SERVER in the agent program."
-(interactive (list (gnus-server-server-name)))
+(interactive)
-(unless server
+(let* ((server       (gnus-server-server-name))
-(error "No server on the current line"))
+(named-server (gnus-server-named-server))
-(let ((method (gnus-server-get-method nil (gnus-server-server-name))))
+(method       (and server
-(when (member method gnus-agent-covered-methods)
+(gnus-server-get-method nil server))))
+(unless server
+(error "No server on the current line"))
+(when (gnus-agent-method-p method)
 (error "Server already in the agent program"))
-(push method gnus-agent-covered-methods)
+(push named-server gnus-agent-covered-methods)
+(setq gnus-agent-method-p-cache nil)
+(gnus-server-update-server server)
 (gnus-agent-write-servers)
-(message "Entered %s into the Agent" server)))
+(gnus-message 1 "Entered %s into the Agent" server)))
-(defun gnus-agent-remove-server (server)
+(defun gnus-agent-remove-server ()
 "Remove SERVER from the agent program."
-(interactive (list (gnus-server-server-name)))
+(interactive)
-(unless server
+(let* ((server       (gnus-server-server-name))
-(error "No server on the current line"))
+(named-server (gnus-server-named-server)))
-(let ((method (gnus-server-get-method nil (gnus-server-server-name))))
+(unless server
-(unless (member method gnus-agent-covered-methods)
+(error "No server on the current line"))
+(unless (member named-server gnus-agent-covered-methods)
 (error "Server not in the agent program"))
 (setq gnus-agent-covered-methods
-	  (delete method gnus-agent-covered-methods))
+(delete named-server gnus-agent-covered-methods)
+gnus-agent-method-p-cache nil)
+(gnus-server-update-server server)
 (gnus-agent-write-servers)
-(message "Removed %s from the agent" server)))
+(gnus-message 1 "Removed %s from the agent" server)))
 (defun gnus-agent-read-servers ()
 "Read the alist of covered servers."
 (setq gnus-agent-covered-methods
-	(gnus-agent-read-file
+(gnus-agent-read-file
-	 (nnheader-concat gnus-agent-directory "lib/servers"))))
+(nnheader-concat gnus-agent-directory "lib/servers"))
+gnus-agent-method-p-cache nil)
+;; I am called so early in start-up that I can not validate server
+;; names.  When that is the case, I skip the validation.  That is
+;; alright as the gnus startup code calls the validate methods
+;; directly.
+(if gnus-server-alist
+(gnus-agent-read-servers-validate)))
+(defun gnus-agent-read-servers-validate ()
+(mapcar (lambda (server-or-method)
+(let* ((server (if (stringp server-or-method)
+server-or-method
+(gnus-method-to-server server-or-method)))
+(method (gnus-server-to-method server)))
+(if method
+(unless (member server gnus-agent-covered-methods)
+(push server gnus-agent-covered-methods)
+(setq gnus-agent-method-p-cache nil))
+(gnus-message 1 "Ignoring disappeared server `%s'" server))))
+(prog1 gnus-agent-covered-methods
+(setq gnus-agent-covered-methods nil))))
+(defun gnus-agent-read-servers-validate-native (native-method)
+(setq gnus-agent-covered-methods
+(mapcar (lambda (method)
+(if (or (not method)
+(equal method native-method))
+"native"
+method)) gnus-agent-covered-methods)))
 (defun gnus-agent-write-servers ()
 "Write the alist of covered servers."
 (gnus-make-directory (nnheader-concat gnus-agent-directory "lib"))
 (let ((coding-system-for-write nnheader-file-coding-system)
 	(file-name-coding-system nnmail-pathname-coding-system))
 (with-temp-file (nnheader-concat gnus-agent-directory "lib/servers")
-(prin1 gnus-agent-covered-methods (current-buffer)))))
+(prin1 gnus-agent-covered-methods
+	     (current-buffer)))))
 ;;;
 ;;; Summary commands
 ;;;
 the actual number of articles toggled is returned."
 (interactive "p")
 (gnus-agent-mark-article n 'toggle))
 (defun gnus-summary-set-agent-mark (article &optional unmark)
-"Mark ARTICLE as downloadable."
+"Mark ARTICLE as downloadable.  If UNMARK is nil, article is marked.
-(let ((unmark (if (and (not (null unmark)) (not (eq t unmark)))
+When UNMARK is t, the article is unmarked.  For any other value, the
-		    (memq article gnus-newsgroup-downloadable)
+article's mark is toggled."
-		  unmark)))
+(let ((unmark (cond ((eq nil unmark)
-(if unmark
+		       nil)
-	(progn
+		      ((eq t unmark)
-	  (setq gnus-newsgroup-downloadable
+		       t)
-		(delq article gnus-newsgroup-downloadable))
+		      (t
-	  (push article gnus-newsgroup-undownloaded))
+		       (memq article gnus-newsgroup-downloadable)))))
-(setq gnus-newsgroup-undownloaded
+(when (gnus-summary-goto-subject article nil t)
-	    (delq article gnus-newsgroup-undownloaded))
+(gnus-summary-update-mark
-(push article gnus-newsgroup-downloadable))
+(if unmark
-(gnus-summary-update-mark
+(progn
-(if unmark gnus-undownloaded-mark gnus-downloadable-mark)
+(setq gnus-newsgroup-downloadable
-'unread)))
+(delq article gnus-newsgroup-downloadable))
+(gnus-article-mark article))
+	 (setq gnus-newsgroup-downloadable
+	       (gnus-add-to-sorted-list gnus-newsgroup-downloadable article))
+	 gnus-downloadable-mark)
+'unread))))
+;;;###autoload
 (defun gnus-agent-get-undownloaded-list ()
-"Mark all unfetched articles as read."
+"Construct list of articles that have not been downloaded."
 (let ((gnus-command-method (gnus-find-method-for-group gnus-newsgroup-name)))
-(when (and (not gnus-plugged)
+(when (set (make-local-variable 'gnus-newsgroup-agentized)
-	       (gnus-agent-method-p gnus-command-method))
+(gnus-agent-method-p gnus-command-method))
-(gnus-agent-load-alist gnus-newsgroup-name)
+(let* ((alist (gnus-agent-load-alist gnus-newsgroup-name))
-;; First mark all undownloaded articles as undownloaded.
+(headers (sort (mapcar (lambda (h)
-(let ((articles (append gnus-newsgroup-unreads
+(mail-header-number h))
-			      gnus-newsgroup-marked
+gnus-newsgroup-headers) '<))
-			      gnus-newsgroup-dormant))
+(cached (and gnus-use-cache gnus-newsgroup-cached))
-	    article)
+(undownloaded (list nil))
-	(while (setq article (pop articles))
+(tail-undownloaded undownloaded)
-	  (unless (or (cdr (assq article gnus-agent-article-alist))
+(unfetched (list nil))
-		      (memq article gnus-newsgroup-downloadable)
+(tail-unfetched unfetched))
-		      (memq article gnus-newsgroup-cached))
+	(while (and alist headers)
-	    (push article gnus-newsgroup-undownloaded))))
+	  (let ((a (caar alist))
-;; Then mark downloaded downloadable as not-downloadable,
+		(h (car headers)))
-;; if you get my drift.
+	    (cond ((< a h)
-(let ((articles gnus-newsgroup-downloadable)
+		   ;; Ignore IDs in the alist that are not being
-	    article)
+		   ;; displayed in the summary.
-	(while (setq article (pop articles))
+		   (setq alist (cdr alist)))
-	  (when (cdr (assq article gnus-agent-article-alist))
+		  ((> a h)
-	    (setq gnus-newsgroup-downloadable
+;; Headers that are not in the alist should be
-		  (delq article gnus-newsgroup-downloadable))))))))
+;; fictious (see nnagent-retrieve-headers); they
+;; imply that this article isn't in the agent.
+		   (gnus-agent-append-to-list tail-undownloaded h)
+		   (gnus-agent-append-to-list tail-unfetched    h)
+(setq headers (cdr headers)))
+		  ((cdar alist)
+		   (setq alist (cdr alist))
+		   (setq headers (cdr headers))
+		   nil                  ; ignore already downloaded
+		   )
+		  (t
+		   (setq alist (cdr alist))
+		   (setq headers (cdr headers))
+;; This article isn't in the agent.  Check to see
+;; if it is in the cache.  If it is, it's been
+;; downloaded.
+(while (and cached (< (car cached) a))
+(setq cached (cdr cached)))
+(unless (equal a (car cached))
+(gnus-agent-append-to-list tail-undownloaded a))))))
+	(while headers
+(let ((num (pop headers)))
+(gnus-agent-append-to-list tail-undownloaded num)
+(gnus-agent-append-to-list tail-unfetched    num)))
+	(setq gnus-newsgroup-undownloaded (cdr undownloaded)
+gnus-newsgroup-unfetched    (cdr unfetched))))))
 (defun gnus-agent-catchup ()
-"Mark all undownloaded articles as read."
+"Mark as read all unhandled articles.
+An article is unhandled if it is neither cached, nor downloaded, nor
+downloadable."
 (interactive)
 (save-excursion
-(while gnus-newsgroup-undownloaded
+(let ((articles gnus-newsgroup-undownloaded))
-(gnus-summary-mark-article
+(when (or gnus-newsgroup-downloadable
-(pop gnus-newsgroup-undownloaded) gnus-catchup-mark)))
+gnus-newsgroup-cached)
-(gnus-summary-position-point))
+(setq articles (gnus-sorted-ndifference
+			(gnus-sorted-ndifference
+			 (gnus-copy-sequence articles)
+			 gnus-newsgroup-downloadable)
+			gnus-newsgroup-cached)))
+(while articles
+(gnus-summary-mark-article
+(pop articles) gnus-catchup-mark)))
+(gnus-summary-position-point)))
+(defun gnus-agent-summary-fetch-series ()
+(interactive)
+(when gnus-newsgroup-processable
+(setq gnus-newsgroup-downloadable
+(let* ((dl gnus-newsgroup-downloadable)
+		 (processable (sort (gnus-copy-sequence gnus-newsgroup-processable) '<))
+(gnus-newsgroup-downloadable processable))
+	    (gnus-agent-summary-fetch-group)
+;; For each article that I processed that is no longer
+;; undownloaded, remove its processable mark.
+	    (mapc #'gnus-summary-remove-process-mark
+		  (gnus-sorted-ndifference gnus-newsgroup-processable gnus-newsgroup-undownloaded))
+;; The preceeding call to (gnus-agent-summary-fetch-group)
+;; updated the temporary gnus-newsgroup-downloadable to
+;; remove each article successfully fetched.  Now, I
+;; update the real gnus-newsgroup-downloadable to only
+;; include undownloaded articles.
+	    (gnus-sorted-ndifference dl (gnus-sorted-ndifference processable gnus-newsgroup-undownloaded))))))
+(defun gnus-agent-summary-fetch-group (&optional all)
+"Fetch the downloadable articles in the group.
+Optional arg ALL, if non-nil, means to fetch all articles."
+(interactive "P")
+(let ((articles
+	 (if all gnus-newsgroup-articles
+	   gnus-newsgroup-downloadable))
+	(gnus-command-method (gnus-find-method-for-group gnus-newsgroup-name))
+fetched-articles)
+(gnus-agent-while-plugged
+(unless articles
+(error "No articles to download"))
+(gnus-agent-with-fetch
+(setq gnus-newsgroup-undownloaded
+(gnus-sorted-ndifference
+gnus-newsgroup-undownloaded
+(setq fetched-articles
+(gnus-agent-fetch-articles
+gnus-newsgroup-name articles)))))
+(save-excursion
+(dolist (article articles)
+(let ((was-marked-downloadable
+(memq article gnus-newsgroup-downloadable)))
+(cond (gnus-agent-mark-unread-after-downloaded
+(setq gnus-newsgroup-downloadable
+(delq article gnus-newsgroup-downloadable))
+(gnus-summary-mark-article article gnus-unread-mark))
+(was-marked-downloadable
+(gnus-summary-set-agent-mark article t)))
+(when (gnus-summary-goto-subject article nil t)
+(gnus-summary-update-download-mark article))))))
+fetched-articles))
+(defun gnus-agent-fetch-selected-article ()
+"Fetch the current article as it is selected.
+This can be added to `gnus-select-article-hook' or
+`gnus-mark-article-hook'."
+(let ((gnus-command-method gnus-current-select-method))
+(when (and gnus-plugged (gnus-agent-method-p gnus-command-method))
+(when (gnus-agent-fetch-articles
+gnus-newsgroup-name
+	     (list gnus-current-article))
+	(setq gnus-newsgroup-undownloaded
+	      (delq gnus-current-article gnus-newsgroup-undownloaded))
+(gnus-summary-update-download-mark gnus-current-article)))))
 ;;;
 ;;; Internal functions
 ;;;
+(defun gnus-agent-synchronize-group-flags (group actions server)
+"Update a plugged group by performing the indicated actions."
+(let* ((gnus-command-method (gnus-server-to-method server))
+	 (info
+	  ;; This initializer is required as gnus-request-set-mark
+	  ;; calls gnus-group-real-name to strip off the host name
+	  ;; before calling the backend.  Now that the backend is
+	  ;; trying to call gnus-request-set-mark, I have to
+	  ;; reconstruct the original group name.
+	  (or (gnus-get-info group)
+	      (gnus-get-info
+	       (setq group (gnus-group-full-name
+			    group gnus-command-method))))))
+(gnus-request-set-mark group actions)
+(when info
+(dolist (action actions)
+	(let ((range (nth 0 action))
+	      (what  (nth 1 action))
+	      (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))
+		   (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))))
+		     (setcdr info-marks (funcall (if (eq what 'add)
+				  'gnus-range-add
+				'gnus-remove-from-range)
+			      (cdr info-marks)
+			      range))))))))
+;;Marks can be synchronized at any time by simply toggling from
+;;unplugged to plugged.  If that is what is happening right now, make
+;;sure that the group buffer is up to date.
+(when (gnus-buffer-live-p gnus-group-buffer)
+(gnus-group-update-group group t)))
+nil))
 (defun gnus-agent-save-active (method)
-(gnus-agent-save-active-1 method 'gnus-active-to-gnus-format))
-(defun gnus-agent-save-active-1 (method function)
 (when (gnus-agent-method-p method)
 (let* ((gnus-command-method method)
 	   (new (gnus-make-hashtable (count-lines (point-min) (point-max))))
 	   (file (gnus-agent-lib-file "active")))
-(funcall function nil new)
+(gnus-active-to-gnus-format nil new)
 (gnus-agent-write-active file new)
 (erase-buffer)
 (nnheader-insert-file-contents file))))
 (defun gnus-agent-write-active (file new)
-(let ((orig (gnus-make-hashtable (count-lines (point-min) (point-max))))
-	(file (gnus-agent-lib-file "active"))
-	elem osym)
-(when (file-exists-p file)
-(with-temp-buffer
-	(nnheader-insert-file-contents file)
-	(gnus-active-to-gnus-format nil orig))
-(mapatoms
-(lambda (sym)
-	 (when (and sym (boundp sym))
-	   (if (and (boundp (setq osym (intern (symbol-name sym) orig)))
-		    (setq elem (symbol-value osym)))
-	       (setcdr elem (cdr (symbol-value sym)))
-	     (set (intern (symbol-name sym) orig) (symbol-value sym)))))
-new))
 (gnus-make-directory (file-name-directory file))
-(let ((coding-system-for-write gnus-agent-file-coding-system))
+(let ((nnmail-active-file-coding-system gnus-agent-file-coding-system))
-;; The hashtable contains real names of groups,  no more prefix
+;; The hashtable contains real names of groups.  However, do NOT
-;; removing, so set `full' to `t'.
+;; add the foreign server prefix as gnus-active-to-gnus-format
-(gnus-write-active-file file orig t))))
+;; will add it while reading the file.
+(gnus-write-active-file file new nil)))
-(defun gnus-agent-save-groups (method)
-(gnus-agent-save-active-1 method 'gnus-groups-to-gnus-format))
+;;;###autoload
+(defun gnus-agent-possibly-alter-active (group active &optional info)
+"Possibly expand a group's active range to include articles
+downloaded into the agent."
+(let* ((gnus-command-method (or gnus-command-method
+(gnus-find-method-for-group group))))
+(when (gnus-agent-method-p gnus-command-method)
+(let* ((local (gnus-agent-get-local group))
+(active-min (or (car active) 0))
+(active-max (or (cdr active) 0))
+(agent-min (or (car local) active-min))
+(agent-max (or (cdr local) active-max)))
+(when (< agent-min active-min)
+(setcar active agent-min))
+(when (> agent-max active-max)
+(setcdr active agent-max))
+(when (and info (< agent-max (- active-min 100)))
+;; I'm expanding the active range by such a large amount
+;; that there is a gap of more than 100 articles between the
+;; last article known to the agent and the first article
+;; currently available on the server.  This gap contains
+;; articles that have been lost, mark them as read so that
+;; gnus doesn't waste resources trying to fetch them.
+;; NOTE: I don't do this for smaller gaps (< 100) as I don't
+;; want to modify the local file everytime someone restarts
+;; gnus.  The small gap will cause a tiny performance hit
+;; when gnus tries, and fails, to retrieve the articles.
+;; Still that should be smaller than opening a buffer,
+;; printing this list to the buffer, and then writing it to a
+;; file.
+(let ((read (gnus-info-read info)))
+(gnus-info-set-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.
+;; NOTE: Opening this group will restore the valid local
+;; range but it will also expand the local range to
+;; incompass the new active range.
+(gnus-agent-set-local group agent-min (1- active-min)))))))
 (defun gnus-agent-save-group-info (method group active)
+"Update a single group's active range in the agent's copy of the server's active file."
 (when (gnus-agent-method-p method)
-(let* ((gnus-command-method method)
+(let* ((gnus-command-method (or method gnus-command-method))
 	   (coding-system-for-write nnheader-file-coding-system)
 	   (file-name-coding-system nnmail-pathname-coding-system)
 	   (file (gnus-agent-lib-file "active"))
-	   oactive)
+	   oactive-min oactive-max)
 (gnus-make-directory (file-name-directory file))
 (with-temp-file file
 	;; Emacs got problem to match non-ASCII group in multibyte buffer.
 	(mm-disable-multibyte)
 	(when (file-exists-p file)
-	  (nnheader-insert-file-contents file))
+	  (nnheader-insert-file-contents file)
-	(goto-char (point-min))
-	(when (re-search-forward
+(goto-char (point-min))
-	       (concat "^" (regexp-quote group) " ") nil t)
+(when (re-search-forward
-	  (save-excursion
+(concat "^" (regexp-quote group) " ") nil t)
-	    (save-restriction
+(save-excursion
-	      (narrow-to-region (match-beginning 0)
+(setq oactive-max (read (current-buffer))	;; max
-				(progn
+oactive-min (read (current-buffer)))) ;; min
-				  (forward-line 1)
+(gnus-delete-line)))
-				  (point)))
+	(when active
-	      (setq oactive (car (nnmail-parse-active)))))
+	  (insert (format "%S %d %d y\n" (intern group)
-	  (gnus-delete-line))
+			  (max (or oactive-max (cdr active)) (cdr active))
-	(insert (format "%S %d %d y\n" (intern group)
+			  (min (or oactive-min (car active)) (car active))))
-			(cdr active)
+	  (goto-char (point-max))
-			(or (car oactive) (car active))))
+	  (while (search-backward "\\." nil t)
-	(goto-char (point-max))
+	    (delete-char 1)))))))
-	(while (search-backward "\\." nil t)
-	  (delete-char 1))))))
+(defun gnus-agent-get-group-info (method group)
+"Get a single group's active range in the agent's copy of the server's active file."
+(when (gnus-agent-method-p method)
+(let* ((gnus-command-method (or method gnus-command-method))
+	   (coding-system-for-write nnheader-file-coding-system)
+	   (file-name-coding-system nnmail-pathname-coding-system)
+	   (file (gnus-agent-lib-file "active"))
+	   oactive-min oactive-max)
+(gnus-make-directory (file-name-directory file))
+(with-temp-buffer
+	;; Emacs got problem to match non-ASCII group in multibyte buffer.
+	(mm-disable-multibyte)
+	(when (file-exists-p file)
+	  (nnheader-insert-file-contents file)
+(goto-char (point-min))
+(when (re-search-forward
+(concat "^" (regexp-quote group) " ") nil t)
+(save-excursion
+(setq oactive-max (read (current-buffer))	;; max
+oactive-min (read (current-buffer))) ;; min
+	      (cons oactive-min oactive-max))))))))
 (defun gnus-agent-group-path (group)
 "Translate GROUP into a file name."
-(if nnmail-use-long-file-names
-(gnus-group-real-name group)
+;; NOTE: This is what nnmail-group-pathname does as of Apr 2003.
-(nnheader-translate-file-chars
+;; The two methods must be kept synchronized, which is why
-(nnheader-replace-chars-in-string
+;; gnus-agent-group-pathname was added.
-(nnheader-replace-duplicate-chars-in-string
-(nnheader-replace-chars-in-string
+(setq group
-	(gnus-group-real-name group)
+(nnheader-translate-file-chars
-	?/ ?_)
+(nnheader-replace-duplicate-chars-in-string
-?. ?_)
+(nnheader-replace-chars-in-string
-?. ?/))))
+(gnus-group-real-name (gnus-group-decoded-name group))
+?/ ?_)
+?. ?_)))
+(if (or nnmail-use-long-file-names
-(defun gnus-agent-method-p (method)
+(file-directory-p (expand-file-name group (gnus-agent-directory))))
-"Say whether METHOD is covered by the agent."
+group
-(member method gnus-agent-covered-methods))
+(mm-encode-coding-string
+(nnheader-replace-chars-in-string group ?. ?/)
+nnmail-pathname-coding-system)))
+(defun gnus-agent-group-pathname (group)
+"Translate GROUP into a file name."
+;; nnagent uses nnmail-group-pathname to read articles while
+;; unplugged.  The agent must, therefore, use the same directory
+;; while plugged.
+(let ((gnus-command-method (or gnus-command-method
+				 (gnus-find-method-for-group group))))
+(nnmail-group-pathname (gnus-group-real-name
+			    (gnus-group-decoded-name group))
+			   (gnus-agent-directory))))
 (defun gnus-agent-get-function (method)
-(if (and (not gnus-plugged)
+(if (gnus-online method)
-	   (gnus-agent-method-p method))
+(car method)
-(progn
+(require 'nnagent)
-	(require 'nnagent)
+'nnagent))
-	'nnagent)
-(car method)))
+(defun gnus-agent-covered-methods ()
+"Return the subset of methods that are covered by the agent."
+(delq nil (mapcar #'gnus-server-to-method gnus-agent-covered-methods)))
 ;;; History functions
 (defun gnus-agent-history-buffer ()
 (cdr (assoc (gnus-agent-method) gnus-agent-history-buffers)))
 (let ((file (gnus-agent-lib-file "history")))
 (when (file-exists-p file)
 	(nnheader-insert-file-contents file))
 (set (make-local-variable 'gnus-agent-file-name) file))))
-(defun gnus-agent-save-history ()
-(save-excursion
-(set-buffer gnus-agent-current-history)
-(gnus-make-directory (file-name-directory gnus-agent-file-name))
-(let ((coding-system-for-write gnus-agent-file-coding-system))
-(write-region (1+ (point-min)) (point-max)
-		    gnus-agent-file-name nil 'silent))))
 (defun gnus-agent-close-history ()
 (when (gnus-buffer-live-p gnus-agent-current-history)
 (kill-buffer gnus-agent-current-history)
 (setq gnus-agent-history-buffers
 	  (delq (assoc (gnus-agent-method) gnus-agent-history-buffers)
 		gnus-agent-history-buffers))))
-(defun gnus-agent-enter-history (id group-arts date)
-(save-excursion
-(set-buffer gnus-agent-current-history)
-(goto-char (point-max))
-(let ((p (point)))
-(insert id "\t" (number-to-string date) "\t")
-(while group-arts
-	(insert (format "%S" (intern (caar group-arts)))
-		" " (number-to-string (cdr (pop group-arts)))
-		" "))
-(insert "\n")
-(while (search-backward "\\." p t)
-	(delete-char 1)))))
-(defun gnus-agent-article-in-history-p (id)
-(save-excursion
-(set-buffer (gnus-agent-history-buffer))
-(goto-char (point-min))
-(search-forward (concat "\n" id "\t") nil t)))
-(defun gnus-agent-history-path (id)
-(save-excursion
-(set-buffer (gnus-agent-history-buffer))
-(goto-char (point-min))
-(when (search-forward (concat "\n" id "\t") nil t)
-(let ((method (gnus-agent-method)))
-	(let (paths group)
-	  (while (not (numberp (setq group (read (current-buffer)))))
-	    (push (concat method "/" group) paths))
-	  (nreverse paths))))))
 ;;;
 ;;; Fetching
 ;;;
 (defun gnus-agent-fetch-articles (group articles)
 "Fetch ARTICLES from GROUP and put them into the Agent."
 (when articles
-;; Prune off articles that we have already fetched.
+(gnus-agent-load-alist group)
-(while (and articles
+(let* ((alist   gnus-agent-article-alist)
-		(cdr (assq (car articles) gnus-agent-article-alist)))
+(headers (if (< (length articles) 2) nil gnus-newsgroup-headers))
-(pop articles))
+(selected-sets (list nil))
-(let ((arts articles))
+(current-set-size 0)
-(while (cdr arts)
+article
-	(if (cdr (assq (cadr arts) gnus-agent-article-alist))
+header-number)
-	    (setcdr arts (cddr arts))
+;; Check each article
-	  (setq arts (cdr arts)))))
+(while (setq article (pop articles))
-(when articles
+;; Skip alist entries preceeding this article
-(let ((dir (concat
+(while (> article (or (caar alist) (1+ article)))
-		  (gnus-agent-directory)
+(setq alist (cdr alist)))
-		  (gnus-agent-group-path group) "/"))
-	    (date (time-to-days (current-time)))
+;; Prune off articles that we have already fetched.
-	    (case-fold-search t)
+(unless (and (eq article (caar alist))
-	    pos crosses id elem)
+(cdar alist))
-	(gnus-make-directory dir)
+;; Skip headers preceeding this article
-	(gnus-message 7 "Fetching articles for %s..." group)
+(while (> article
-	;; Fetch the articles from the backend.
+(setq header-number
-	(if (gnus-check-backend-function 'retrieve-articles group)
+(let* ((header (car headers)))
-	    (setq pos (gnus-retrieve-articles articles group))
+(if header
-	  (with-temp-buffer
+(mail-header-number header)
-	    (let (article)
+(1+ article)))))
-	      (while (setq article (pop articles))
+(setq headers (cdr headers)))
-		(when (or
-		       (gnus-backlog-request-article group article
+;; Add this article to the current set
-						     nntp-server-buffer)
+(setcar selected-sets (cons article (car selected-sets)))
-		       (gnus-request-article article group))
-		  (goto-char (point-max))
+;; Update the set size, when the set is too large start a
-		  (push (cons article (point)) pos)
+;; new one.  I do this after adding the article as I want at
-		  (insert-buffer-substring nntp-server-buffer)))
+;; least one article in each set.
-	      (copy-to-buffer nntp-server-buffer (point-min) (point-max))
+(when (< gnus-agent-max-fetch-size
-	      (setq pos (nreverse pos)))))
+(setq current-set-size
-	;; Then save these articles into the Agent.
+			 (+ current-set-size
-	(save-excursion
+			    (if (= header-number article)
-	  (set-buffer nntp-server-buffer)
+(let ((char-size (mail-header-chars
-	  (while pos
+(car headers))))
-	    (narrow-to-region (cdar pos) (or (cdadr pos) (point-max)))
+(if (<= char-size 0)
-	    (goto-char (point-min))
+;; The char size was missing/invalid,
-	    (when (search-forward "\n\n" nil t)
+;; assume a worst-case situation of
-	      (when (search-backward "\nXrefs: " nil t)
+;; 65 char/line.  If the line count
-		;; Handle crossposting.
+;; is missing, arbitrarily assume a
-		(skip-chars-forward "^ ")
+;; size of 1000 characters.
-		(skip-chars-forward " ")
+(max (* 65 (mail-header-lines
-		(setq crosses nil)
+(car headers)))
-		(while (looking-at "\\([^: \n]+\\):\\([0-9]+\\) +")
+1000)
-		  (push (cons (buffer-substring (match-beginning 1)
+char-size))
-						(match-end 1))
+			      0))))
-			      (buffer-substring (match-beginning 2)
+(setcar selected-sets (nreverse (car selected-sets)))
-						(match-end 2)))
+(setq selected-sets (cons nil selected-sets)
-			crosses)
+current-set-size 0))))
-		  (goto-char (match-end 0)))
-		(gnus-agent-crosspost crosses (caar pos))))
+(when (or (cdr selected-sets) (car selected-sets))
-	    (goto-char (point-min))
+(let* ((fetched-articles (list nil))
-	    (if (not (re-search-forward "^Message-ID: *<\\([^>\n]+\\)>" nil t))
+(tail-fetched-articles fetched-articles)
-		(setq id "No-Message-ID-in-article")
+(dir (gnus-agent-group-pathname group))
-	      (setq id (buffer-substring (match-beginning 1) (match-end 1))))
+(date (time-to-days (current-time)))
-	    (let ((coding-system-for-write
+(case-fold-search t)
-		   gnus-agent-file-coding-system))
+pos crosses id)
-	      (write-region (point-min) (point-max)
-			    (concat dir (number-to-string (caar pos)))
+(setcar selected-sets (nreverse (car selected-sets)))
-			    nil 'silent))
+(setq selected-sets (nreverse selected-sets))
-	    (when (setq elem (assq (caar pos) gnus-agent-article-alist))
-	      (setcdr elem t))
+(gnus-make-directory dir)
-	    (gnus-agent-enter-history
+(gnus-message 7 "Fetching articles for %s..." group)
-	     id (or crosses (list (cons group (caar pos)))) date)
-	    (widen)
+(unwind-protect
-	    (pop pos)))
+(while (setq articles (pop selected-sets))
-	(gnus-agent-save-alist group)))))
+;; Fetch the articles from the backend.
+(if (gnus-check-backend-function 'retrieve-articles group)
-(defun gnus-agent-crosspost (crosses article)
+(setq pos (gnus-retrieve-articles articles group))
+(with-temp-buffer
+(let (article)
+(while (setq article (pop articles))
+(gnus-message 10 "Fetching article %s for %s..."
+article group)
+(when (or
+(gnus-backlog-request-article group article
+nntp-server-buffer)
+(gnus-request-article article group))
+(goto-char (point-max))
+(push (cons article (point)) pos)
+(insert-buffer-substring nntp-server-buffer)))
+(copy-to-buffer
+		       nntp-server-buffer (point-min) (point-max))
+(setq pos (nreverse pos)))))
+;; Then save these articles into the Agent.
+(save-excursion
+(set-buffer nntp-server-buffer)
+(while pos
+(narrow-to-region (cdar pos) (or (cdadr pos) (point-max)))
+(goto-char (point-min))
+(unless (eobp) ;; Don't save empty articles.
+(when (search-forward "\n\n" nil t)
+(when (search-backward "\nXrefs: " nil t)
+;; Handle cross posting.
+(goto-char (match-end 0)) ; move to end of header name
+(skip-chars-forward "^ ") ; skip server name
+(skip-chars-forward " ")
+(setq crosses nil)
+(while (looking-at "\\([^: \n]+\\):\\([0-9]+\\) *")
+(push (cons (buffer-substring (match-beginning 1)
+(match-end 1))
+(string-to-number
+					 (buffer-substring (match-beginning 2)
+							   (match-end 2))))
+crosses)
+(goto-char (match-end 0)))
+(gnus-agent-crosspost crosses (caar pos) date)))
+(goto-char (point-min))
+(if (not (re-search-forward
+"^Message-ID: *<\\([^>\n]+\\)>" nil t))
+(setq id "No-Message-ID-in-article")
+(setq id (buffer-substring
+				  (match-beginning 1) (match-end 1))))
+(let ((coding-system-for-write
+gnus-agent-file-coding-system))
+(write-region (point-min) (point-max)
+(concat dir (number-to-string (caar pos)))
+nil 'silent))
+(gnus-agent-append-to-list
+		       tail-fetched-articles (caar pos)))
+(widen)
+(setq pos (cdr pos)))))
+(gnus-agent-save-alist group (cdr fetched-articles) date)
+(gnus-message 7 ""))
+(cdr fetched-articles))))))
+(defun gnus-agent-unfetch-articles (group articles)
+"Delete ARTICLES that were fetched from GROUP into the agent."
+(when articles
+(gnus-agent-load-alist group)
+(let* ((alist (cons nil gnus-agent-article-alist))
+	   (articles (sort articles #'<))
+	   (next-possibility alist)
+	   (delete-this (pop articles)))
+(while (and (cdr next-possibility) delete-this)
+	(let ((have-this (caar (cdr next-possibility))))
+	  (cond ((< delete-this have-this)
+		 (setq delete-this (pop articles)))
+		((= delete-this have-this)
+		 (let ((timestamp (cdar (cdr next-possibility))))
+		   (when timestamp
+		     (let* ((file-name (concat (gnus-agent-group-pathname group)
+					       (number-to-string have-this))))
+		       (delete-file file-name))))
+		 (setcdr next-possibility (cddr next-possibility)))
+		(t
+		 (setq next-possibility (cdr next-possibility))))))
+(setq gnus-agent-article-alist (cdr alist))
+(gnus-agent-save-alist group))))
+(defun gnus-agent-crosspost (crosses article &optional date)
+(setq date (or date t))
 (let (gnus-agent-article-alist group alist beg end)
 (save-excursion
 (set-buffer gnus-agent-overview-buffer)
 (when (nnheader-find-nov-line article)
 	(forward-word 1)
 (while crosses
 (setq group (caar crosses))
 (unless (setq alist (assoc group gnus-agent-group-alist))
 	(push (setq alist (list group (gnus-agent-load-alist (caar crosses))))
 	      gnus-agent-group-alist))
-(setcdr alist (cons (cons (cdar crosses) t) (cdr alist)))
+(setcdr alist (cons (cons (cdar crosses) date) (cdr alist)))
 (save-excursion
 	(set-buffer (gnus-get-buffer-create (format " *Gnus agent overview %s*"
 						    group)))
 	(when (= (point-max) (point-min))
 	  (push (cons group (current-buffer)) gnus-agent-buffer-alist)
 	  (ignore-errors
 	    (nnheader-insert-file-contents
 	     (gnus-agent-article-name ".overview" group))))
 	(nnheader-find-nov-line (string-to-number (cdar crosses)))
 	(insert (string-to-number (cdar crosses)))
-	(insert-buffer-substring gnus-agent-overview-buffer beg end))
+	(insert-buffer-substring gnus-agent-overview-buffer beg end)
-(pop crosses))))
+(gnus-agent-check-overview-buffer))
+(setq crosses (cdr crosses)))))
+(defun gnus-agent-backup-overview-buffer ()
+(when gnus-newsgroup-name
+(let ((root (gnus-agent-article-name ".overview" gnus-newsgroup-name))
+(cnt 0)
+name)
+(while (file-exists-p
+	      (setq name (concat root "~"
+				 (int-to-string (setq cnt (1+ cnt))) "~"))))
+(write-region (point-min) (point-max) name nil 'no-msg)
+(gnus-message 1 "Created backup copy of overview in %s." name)))
+t)
+(defun gnus-agent-check-overview-buffer (&optional buffer)
+"Check the overview file given for sanity.
+In particular, checks that the file is sorted by article number
+and that there are no duplicates."
+(let ((prev-num -1)
+(backed-up nil))
+(save-excursion
+(when buffer
+	(set-buffer buffer))
+(save-restriction
+	(widen)
+	(goto-char (point-min))
+	(while (< (point) (point-max))
+	  (let ((p (point))
+		(cur (condition-case nil
+			 (read (current-buffer))
+		       (error nil))))
+	    (cond
+	     ((or (not (integerp cur))
+		  (not (eq (char-after) ?\t)))
+(or backed-up
+(setq backed-up (gnus-agent-backup-overview-buffer)))
+	      (gnus-message 1
+			    "Overview buffer contains garbage '%s'."
+			    (buffer-substring
+			     p (gnus-point-at-eol))))
+	     ((= cur prev-num)
+	      (or backed-up
+(setq backed-up (gnus-agent-backup-overview-buffer)))
+(gnus-message 1
+			    "Duplicate overview line for %d" cur)
+	      (delete-region p (progn (forward-line 1) (point))))
+	     ((< cur prev-num)
+	      (or backed-up
+(setq backed-up (gnus-agent-backup-overview-buffer)))
+(gnus-message 1 "Overview buffer not sorted!")
+	      (sort-numeric-fields 1 (point-min) (point-max))
+	      (goto-char (point-min))
+	      (setq prev-num -1))
+	     (t
+	      (setq prev-num cur)))
+	    (forward-line 1)))))))
 (defun gnus-agent-flush-cache ()
 (save-excursion
 (while gnus-agent-buffer-alist
 (set-buffer (cdar gnus-agent-buffer-alist))
 	     gnus-agent-file-coding-system))
 	(write-region (point-min) (point-max)
 		      (gnus-agent-article-name ".overview"
 					       (caar gnus-agent-buffer-alist))
 		      nil 'silent))
-(pop gnus-agent-buffer-alist))
+(setq gnus-agent-buffer-alist (cdr gnus-agent-buffer-alist)))
 (while gnus-agent-group-alist
-(with-temp-file (caar gnus-agent-group-alist)
+(with-temp-file (gnus-agent-article-name
+		       ".agentview" (caar gnus-agent-group-alist))
 	(princ (cdar gnus-agent-group-alist))
+	(insert "\n")
+(princ 1 (current-buffer))
 	(insert "\n"))
-(pop gnus-agent-group-alist))))
+(setq gnus-agent-group-alist (cdr gnus-agent-group-alist)))))
-(if (fboundp 'union)
+;;;###autoload
-(defalias 'gnus-agent-union 'union)
+(defun gnus-agent-find-parameter (group symbol)
-(defun gnus-agent-union (l1 l2)
+"Search for GROUPs SYMBOL in the group's parameters, the group's
-"Set union of lists L1 and L2."
+topic parameters, the group's category, or the customizable
-(cond ((null l1) l2)
+variables.  Returns the first non-nil value found."
-	  ((null l2) l1)
+(or (gnus-group-find-parameter group symbol t)
-	  ((equal l1 l2) l1)
+(gnus-group-parameter-value (cdr (gnus-group-category group)) symbol t)
-	  (t
+(symbol-value
-	   (or (>= (length l1) (length l2))
+(cdr
-	       (setq l1 (prog1 l2 (setq l2 l1))))
+(assq symbol
-	   (while l2
+'((agent-short-article . gnus-agent-short-article)
-	     (or (memq (car l2) l1)
+(agent-long-article . gnus-agent-long-article)
-		 (push (car l2) l1))
+(agent-low-score . gnus-agent-low-score)
-	     (pop l2))
+(agent-high-score . gnus-agent-high-score)
-	   l1))))
+(agent-days-until-old . gnus-agent-expire-days)
+(agent-enable-expiration
+. gnus-agent-enable-expiration)
+(agent-predicate . gnus-agent-predicate)))))))
 (defun gnus-agent-fetch-headers (group &optional force)
-(let ((articles (gnus-list-of-unread-articles group))
+"Fetch interesting headers into the agent.  The group's overview
-	(gnus-decode-encoded-word-function 'identity)
+file will be updated to include the headers while a list of available
-	(file (gnus-agent-article-name ".overview" group)))
+article numbers will be returned."
-;; Add article with marks to list of article headers we want to fetch.
+(let* ((fetch-all (and gnus-agent-consider-all-articles
-(dolist (arts (gnus-info-marks (gnus-get-info group)))
+;; Do not fetch all headers if the predicate
-(setq articles (gnus-agent-union (gnus-uncompress-sequence (cdr arts))
+;; implies that we only consider unread articles.
-			    articles)))
+(not (gnus-predicate-implies-unread
-(setq articles (sort articles '<))
+(gnus-agent-find-parameter group
-;; Remove known articles.
+'agent-predicate)))))
-(when (gnus-agent-load-alist group)
+(articles (if fetch-all
-(setq articles (gnus-sorted-intersection
+(gnus-uncompress-range (gnus-active group))
-		      articles
+(gnus-list-of-unread-articles group)))
-		      (gnus-uncompress-range
+(gnus-decode-encoded-word-function 'identity)
-		       (cons (1+ (caar (last gnus-agent-article-alist)))
+(file (gnus-agent-article-name ".overview" group)))
-			     (cdr (gnus-active group)))))))
-;; Fetch them.
+(unless fetch-all
-(gnus-make-directory (nnheader-translate-file-chars
+;; Add articles with marks to the list of article headers we want to
-			  (file-name-directory file) t))
+;; fetch.  Don't fetch articles solely on the basis of a recent or seen
+;; mark, but do fetch recent or seen articles if they have other, more
+;; interesting marks.  (We have to fetch articles with boring marks
+;; because otherwise the agent will remove their marks.)
+(dolist (arts (gnus-info-marks (gnus-get-info group)))
+(unless (memq (car arts) '(seen recent killed cache))
+(setq articles (gnus-range-add articles (cdr arts)))))
+(setq articles (sort (gnus-uncompress-sequence articles) '<)))
+;; At this point, I have the list of articles to consider for
+;; fetching.  This is the list that I'll return to my caller. Some
+;; of these articles may have already been fetched.  That's OK as
+;; the fetch article code will filter those out.  Internally, I'll
+;; filter this list to just those articles whose headers need to
+;; be fetched.
+(let ((articles articles))
+;; Remove known articles.
+(when (and (or gnus-agent-cache
+(not gnus-plugged))
+(gnus-agent-load-alist group))
+;; Remove articles marked as downloaded.
+(if fetch-all
+;; I want to fetch all headers in the active range.
+;; Therefore, exclude only those headers that are in the
+;; article alist.
+;; NOTE: This is probably NOT what I want to do after
+;; agent expiration in this group.
+(setq articles (gnus-agent-uncached-articles articles group))
+;; I want to only fetch those headers that have never been
+;; fetched.  Therefore, exclude all headers that are, or
+;; WERE, in the article alist.
+(let ((low (1+ (caar (last gnus-agent-article-alist))))
+(high (cdr (gnus-active group))))
+;; Low can be greater than High when the same group is
+;; fetched twice in the same session {The first fetch will
+;; fill the article alist such that (last
+;; gnus-agent-article-alist) equals (cdr (gnus-active
+;; group))}.  The addition of one(the 1+ above) then
+;; forces Low to be greater than High.  When this happens,
+;; gnus-list-range-intersection returns nil which
+;; indicates that no headers need to be fetched. -- Kevin
+(setq articles (gnus-list-range-intersection
+articles (list (cons low high)))))))
+(gnus-message
+10 "gnus-agent-fetch-headers: undownloaded articles are '%s'"
+(gnus-compress-sequence articles t))
+(save-excursion
+(set-buffer nntp-server-buffer)
+(if articles
+(progn
+(gnus-message 7 "Fetching headers for %s..." group)
+;; Fetch them.
+(gnus-make-directory (nnheader-translate-file-chars
+(file-name-directory file) t))
+(unless (eq 'nov (gnus-retrieve-headers articles group))
+(nnvirtual-convert-headers))
+(gnus-agent-check-overview-buffer)
+;; Move these headers to the overview buffer so that
+;; gnus-agent-braid-nov can merge them with the contents
+;; of FILE.
+(copy-to-buffer
+	       gnus-agent-overview-buffer (point-min) (point-max))
+	      ;; NOTE: Call g-a-brand-nov even when the file does not
+	      ;; exist.  As a minimum, it will validate the article
+	      ;; numbers already in the buffer.
+	      (gnus-agent-braid-nov group articles file)
+(let ((coding-system-for-write
+gnus-agent-file-coding-system))
+(gnus-agent-check-overview-buffer)
+(write-region (point-min) (point-max) file nil 'silent))
+(gnus-agent-save-alist group articles nil)
+articles)
+(ignore-errors
+(erase-buffer)
+(nnheader-insert-file-contents file)))))
+articles))
+(defsubst gnus-agent-read-article-number ()
+"Reads the article number at point.  Returns nil when a valid article number can not be read."
+;; It is unfortunate but the read function quietly overflows
+;; integer.  As a result, I have to use string operations to test
+;; for overflow BEFORE calling read.
+(when (looking-at "[0-9]+\t")
+(let ((len (- (match-end 0) (match-beginning 0))))
+(cond ((< len 9)
+	     (read (current-buffer)))
+	    ((= len 9)
+	     ;; Many 9 digit base-10 numbers can be represented in a 27-bit int
+	     ;; Back convert from int to string to ensure that this is one of them.
+	     (let* ((str1 (buffer-substring (match-beginning 0) (1- (match-end 0))))
+		    (num (read (current-buffer)))
+		    (str2 (int-to-string num)))
+	       (when (equal str1 str2)
+		 num)))))))
+(defsubst gnus-agent-copy-nov-line (article)
+"Copy the indicated ARTICLE from the overview buffer to the nntp server buffer."
+(let (art b e)
+(set-buffer gnus-agent-overview-buffer)
+(while (and (not (eobp))
+		(or (not (setq art (gnus-agent-read-article-number)))
+		    (< art article)))
+(forward-line 1))
+(beginning-of-line)
+(if (or (eobp)
+	    (not (eq article art)))
+	(set-buffer nntp-server-buffer)
+(setq b (point))
+(setq e (progn (forward-line 1) (point)))
+(set-buffer nntp-server-buffer)
+(insert-buffer-substring gnus-agent-overview-buffer b e))))
+(defun gnus-agent-braid-nov (group articles file)
+"Merge agent overview data with given file.
+Takes unvalidated headers for ARTICLES from
+`gnus-agent-overview-buffer' and validated headers from the given
+FILE and places the combined valid headers into
+`nntp-server-buffer'.  This function can be used, when file
+doesn't exist, to valid the overview buffer."
+(let (start last)
+(set-buffer gnus-agent-overview-buffer)
+(goto-char (point-min))
+(set-buffer nntp-server-buffer)
+(erase-buffer)
+(when (file-exists-p file)
+(nnheader-insert-file-contents file))
+(goto-char (point-max))
+(forward-line -1)
+(unless (or (= (point-min) (point-max))
+		(< (setq last (read (current-buffer))) (car articles)))
+;; Old and new overlap -- We do it the hard way.
+(when (nnheader-find-nov-line (car articles))
+;; Replacing existing NOV entry
+(delete-region (point) (progn (forward-line 1) (point))))
+(gnus-agent-copy-nov-line (pop articles))
+(ignore-errors
+(while articles
+	 (while (let ((art (read (current-buffer))))
+		  (cond ((< art (car articles))
+			 (forward-line 1)
+			 t)
+			((= art (car articles))
+			 (beginning-of-line)
+			 (delete-region
+			  (point) (progn (forward-line 1) (point)))
+			 nil)
+			(t
+			 (beginning-of-line)
+			 nil))))
+	 (gnus-agent-copy-nov-line (pop articles)))))
+(goto-char (point-max))
+;; Append the remaining lines
 (when articles
-(gnus-message 7 "Fetching headers for %s..." group)
+(when last
-(save-excursion
+	(set-buffer gnus-agent-overview-buffer)
-	(set-buffer nntp-server-buffer)
+	(setq start (point))
-	(unless (eq 'nov (gnus-retrieve-headers articles group))
+	(set-buffer nntp-server-buffer))
-	  (nnvirtual-convert-headers))
-	;; Save these headers for later processing.
+(let ((p (point)))
-	(copy-to-buffer gnus-agent-overview-buffer (point-min) (point-max))
+	(insert-buffer-substring gnus-agent-overview-buffer start)
-	(when (file-exists-p file)
+	(goto-char p))
-	  (gnus-agent-braid-nov group articles file))
-	(let ((coding-system-for-write
+(setq last (or last -134217728))
-	       gnus-agent-file-coding-system))
+(while (catch 'problems
-	  (write-region (point-min) (point-max) file nil 'silent))
+(let (sort art)
-	(gnus-agent-save-alist group articles nil)
+	(while (not (eobp))
-	(gnus-agent-enter-history
+	  (setq art (gnus-agent-read-article-number))
-	 "last-header-fetched-for-session"
+	  (cond ((not art)
-	 (list (cons group (nth (- (length  articles) 1) articles)))
+		 ;; Bad art num - delete this line
-	 (time-to-days (current-time)))
+		 (beginning-of-line)
-	articles))))
+		 (delete-region (point) (progn (forward-line 1) (point))))
+		((< art last)
-(defsubst gnus-agent-copy-nov-line (article)
+		 ;; Art num out of order - enable sort
-(let (b e)
+		 (setq sort t)
-(set-buffer gnus-agent-overview-buffer)
+		 (forward-line 1))
-(setq b (point))
+			 ((= art last)
-(if (eq article (read (current-buffer)))
+			  ;; Bad repeat of art number - delete this line
-	(setq e (progn (forward-line 1) (point)))
+			  (beginning-of-line)
+			  (delete-region (point) (progn (forward-line 1) (point))))
+		(t
+		 ;; Good art num
+		 (setq last art)
+		 (forward-line 1))))
+	(when sort
+		   ;; something is seriously wrong as we simply shouldn't see out-of-order data.
+		   ;; First, we'll fix the sort.
+		   (sort-numeric-fields 1 (point-min) (point-max))
+		   ;; but now we have to consider that we may have duplicate rows...
+		   ;; so reset to beginning of file
+		   (goto-char (point-min))
+		   (setq last -134217728)
+		   ;; and throw a code that restarts this scan
+		   (throw 'problems t))
+		 nil))))))
+;; Keeps the compiler from warning about the free variable in
+;; gnus-agent-read-agentview.
+(eval-when-compile
+(defvar gnus-agent-read-agentview))
+(defun gnus-agent-load-alist (group)
+"Load the article-state alist for GROUP."
+;; Bind free variable that's used in `gnus-agent-read-agentview'.
+(let ((gnus-agent-read-agentview group))
+(setq gnus-agent-article-alist
+(gnus-cache-file-contents
+(gnus-agent-article-name ".agentview" group)
+'gnus-agent-file-loading-cache
+'gnus-agent-read-agentview))))
+(defun gnus-agent-read-agentview (file)
+"Load FILE and do a `read' there."
+(with-temp-buffer
+(condition-case nil
 (progn
-	(beginning-of-line)
+(nnheader-insert-file-contents file)
-	(setq e b)))
+(goto-char (point-min))
-(set-buffer nntp-server-buffer)
+(let ((alist (read (current-buffer)))
-(insert-buffer-substring gnus-agent-overview-buffer b e)))
+(version (condition-case nil (read (current-buffer))
+(end-of-file 0)))
-(defun gnus-agent-braid-nov (group articles file)
+changed-version)
-(set-buffer gnus-agent-overview-buffer)
-(goto-char (point-min))
+(cond
-(set-buffer nntp-server-buffer)
+((= version 0)
-(erase-buffer)
+(let ((inhibit-quit t)
-(nnheader-insert-file-contents file)
+entry)
-(goto-char (point-max))
+(gnus-agent-open-history)
-(if (or (= (point-min) (point-max))
+(set-buffer (gnus-agent-history-buffer))
-	  (progn
+(goto-char (point-min))
-	    (forward-line -1)
+(while (not (eobp))
-	    (< (read (current-buffer)) (car articles))))
+(if (and (looking-at
-;; We have only headers that are after the older headers,
+"[^\t\n]+\t\\([0-9]+\\)\t\\([^ \n]+\\) \\([0-9]+\\)")
-;; so we just append them.
+(string= (match-string 2)
-(progn
+gnus-agent-read-agentview)
-	(goto-char (point-max))
+(setq entry (assoc (string-to-number (match-string 3)) alist)))
-	(insert-buffer-substring gnus-agent-overview-buffer))
+(setcdr entry (string-to-number (match-string 1))))
-;; We do it the hard way.
+(forward-line 1))
-(nnheader-find-nov-line (car articles))
+(gnus-agent-close-history)
-(gnus-agent-copy-nov-line (car articles))
+(setq changed-version t)))
-(pop articles)
+((= version 1)
-(while (and articles
+(setq changed-version (not (= 1 gnus-agent-article-alist-save-format))))
-		(not (eobp)))
+((= version 2)
-(while (and (not (eobp))
+(let (uncomp)
-		  (< (read (current-buffer)) (car articles)))
+(mapcar
-	(forward-line 1))
+(lambda (comp-list)
-(beginning-of-line)
+(let ((state (car comp-list))
-(unless (eobp)
+(sequence (inline
-	(gnus-agent-copy-nov-line (car articles))
+				   (gnus-uncompress-range
-	(setq articles (cdr articles))))
+				    (cdr comp-list)))))
-(when articles
+(mapcar (lambda (article-id)
-(let (b e)
+(setq uncomp (cons (cons article-id state) uncomp)))
-	(set-buffer gnus-agent-overview-buffer)
+sequence)))
-	(setq b (point)
+alist)
-	      e (point-max))
+		(setq alist (sort uncomp 'car-less-than-car)))
-	(set-buffer nntp-server-buffer)
+	      (setq changed-version (not (= 2 gnus-agent-article-alist-save-format)))))
-	(insert-buffer-substring gnus-agent-overview-buffer b e)))))
+(when changed-version
+(let ((gnus-agent-article-alist alist))
-(defun gnus-agent-load-alist (group &optional dir)
+(gnus-agent-save-alist gnus-agent-read-agentview)))
-"Load the article-state alist for GROUP."
+alist))
-(setq gnus-agent-article-alist
+(file-error nil))))
-	(gnus-agent-read-file
-	 (if dir
+(defun gnus-agent-save-alist (group &optional articles state)
-	     (expand-file-name ".agentview" dir)
-	   (gnus-agent-article-name ".agentview" group)))))
-(defun gnus-agent-save-alist (group &optional articles state dir)
 "Save the article-state alist for GROUP."
-(let ((file-name-coding-system nnmail-pathname-coding-system))
+(let* ((file-name-coding-system nnmail-pathname-coding-system)
-(with-temp-file (if dir
+	 (prev (cons nil gnus-agent-article-alist))
-			  (expand-file-name ".agentview" dir)
+	 (all prev)
-			(gnus-agent-article-name ".agentview" group))
+	 print-level print-length item article)
-	(princ (setq gnus-agent-article-alist
+(while (setq article (pop articles))
-		     (nconc gnus-agent-article-alist
+(while (and (cdr prev)
-			    (mapcar (lambda (article) (cons article state))
+(< (caadr prev) article))
-				    articles)))
+	(setq prev (cdr prev)))
-	       (current-buffer))
+(cond
-	(insert "\n"))))
+((not (cdr prev))
+	(setcdr prev (list (cons article state))))
+((> (caadr prev) article)
+	(setcdr prev (cons (cons article state) (cdr prev))))
+((= (caadr prev) article)
+	(setcdr (cadr prev) state)))
+(setq prev (cdr prev)))
+(setq gnus-agent-article-alist (cdr all))
+(gnus-agent-set-local group
+(caar gnus-agent-article-alist)
+(caar (last gnus-agent-article-alist)))
+(gnus-make-directory (gnus-agent-article-name "" group))
+(with-temp-file (gnus-agent-article-name ".agentview" group)
+(cond ((eq gnus-agent-article-alist-save-format 1)
+(princ gnus-agent-article-alist (current-buffer)))
+((eq gnus-agent-article-alist-save-format 2)
+(let ((compressed nil))
+(mapcar (lambda (pair)
+(let* ((article-id (car pair))
+(day-of-download (cdr pair))
+(comp-list (assq day-of-download compressed)))
+(if comp-list
+(setcdr comp-list
+				       (cons article-id (cdr comp-list)))
+(setq compressed
+				   (cons (list day-of-download article-id)
+					 compressed)))
+nil)) gnus-agent-article-alist)
+(mapcar (lambda (comp-list)
+			 (setcdr comp-list
+				 (gnus-compress-sequence
+				  (nreverse (cdr comp-list)))))
+		       compressed)
+(princ compressed (current-buffer)))))
+(insert "\n")
+(princ gnus-agent-article-alist-save-format (current-buffer))
+(insert "\n"))))
+(defvar gnus-agent-article-local nil)
+(defvar gnus-agent-file-loading-local nil)
+(defun gnus-agent-load-local (&optional method)
+"Load the METHOD'S local file.  The local file contains min/max
+article counts for each of the method's subscribed groups."
+(let ((gnus-command-method (or method gnus-command-method)))
+(setq gnus-agent-article-local
+(gnus-cache-file-contents
+(gnus-agent-lib-file "local")
+'gnus-agent-file-loading-local
+'gnus-agent-read-and-cache-local))))
+(defun gnus-agent-read-and-cache-local (file)
+"Load and read FILE then bind its contents to
+gnus-agent-article-local.  If that variable had `dirty' (also known as
+modified) original contents, they are first saved to their own file."
+(if (and gnus-agent-article-local
+(symbol-value (intern "+dirty" gnus-agent-article-local)))
+(gnus-agent-save-local))
+(gnus-agent-read-local file))
+(defun gnus-agent-read-local (file)
+"Load FILE and do a `read' there."
+(let ((my-obarray (gnus-make-hashtable (count-lines (point-min)
+(point-max))))
+(line 1))
+(with-temp-buffer
+(condition-case nil
+	  (let ((nnheader-file-coding-system gnus-agent-file-coding-system))
+	    (nnheader-insert-file-contents file))
+(file-error))
+(goto-char (point-min))
+;; Skip any comments at the beginning of the file (the only place where they may appear)
+(while (= (following-char) ?\;)
+(forward-line 1)
+(setq line (1+ line)))
+(while (not (eobp))
+(condition-case err
+(let (group
+min
+max
+(cur (current-buffer)))
+(setq group (read cur)
+min (read cur)
+max (read cur))
+(when (stringp group)
+(setq group (intern group my-obarray)))
+;; NOTE: The '+ 0' ensure that min and max are both numerics.
+(set group (cons (+ 0 min) (+ 0 max))))
+(error
+(gnus-message 3 "Warning - invalid agent local: %s on line %d: %s"
+file line (error-message-string err))))
+(forward-line 1)
+(setq line (1+ line))))
+(set (intern "+dirty" my-obarray) nil)
+(set (intern "+method" my-obarray) gnus-command-method)
+my-obarray))
+(defun gnus-agent-save-local (&optional force)
+"Save gnus-agent-article-local under it method's agent.lib directory."
+(let ((my-obarray gnus-agent-article-local))
+(when (and my-obarray
+(or force (symbol-value (intern "+dirty" my-obarray))))
+(let* ((gnus-command-method (symbol-value (intern "+method" my-obarray)))
+;; NOTE: gnus-command-method is used within gnus-agent-lib-file.
+(dest (gnus-agent-lib-file "local")))
+(gnus-make-directory (gnus-agent-lib-file ""))
+	(let ((buffer-file-coding-system gnus-agent-file-coding-system))
+	  (with-temp-file dest
+	    (let ((gnus-command-method (symbol-value (intern "+method" my-obarray)))
+		  (file-name-coding-system nnmail-pathname-coding-system)
+		  print-level print-length item article
+		  (standard-output (current-buffer)))
+	      (mapatoms (lambda (symbol)
+			  (cond ((not (boundp symbol))
+				 nil)
+				((member (symbol-name symbol) '("+dirty" "+method"))
+				 nil)
+				(t
+				 (let ((range (symbol-value symbol)))
+				   (when range
+				 (prin1 symbol)
+				   (princ " ")
+				   (princ (car range))
+				   (princ " ")
+				   (princ (cdr range))
+				     (princ "\n"))))))
+			my-obarray))))))))
+(defun gnus-agent-get-local (group &optional gmane method)
+(let* ((gmane (or gmane (gnus-group-real-name group)))
+(gnus-command-method (or method (gnus-find-method-for-group group)))
+(local (gnus-agent-load-local))
+(symb (intern gmane local))
+(minmax (and (boundp symb) (symbol-value symb))))
+(unless minmax
+;; Bind these so that gnus-agent-load-alist doesn't change the
+;; current alist (i.e. gnus-agent-article-alist)
+(let* ((gnus-agent-article-alist gnus-agent-article-alist)
+(gnus-agent-file-loading-cache gnus-agent-file-loading-cache)
+(alist (gnus-agent-load-alist group)))
+(when alist
+(setq minmax
+(cons (caar alist)
+(caar (last alist))))
+(gnus-agent-set-local group (car minmax) (cdr minmax)
+gmane gnus-command-method local))))
+minmax))
+(defun gnus-agent-set-local (group min max &optional gmane method local)
+(let* ((gmane (or gmane (gnus-group-real-name group)))
+(gnus-command-method (or method (gnus-find-method-for-group group)))
+(local (or local (gnus-agent-load-local)))
+(symb (intern gmane local))
+(minmax (and (boundp symb) (symbol-value symb))))
+(if (cond ((and minmax
+(or (not (eq min (car minmax)))
+(not (eq max (cdr minmax)))))
+(setcar minmax min)
+(setcdr minmax max)
+t)
+(minmax
+nil)
+((and min max)
+(set symb (cons min max))
+t)
+	      (t
+	       (unintern symb local)))
+(set (intern "+dirty" local) t))))
 (defun gnus-agent-article-name (article group)
-(expand-file-name (if (stringp article) article (string-to-number article))
+(expand-file-name article
 		    (file-name-as-directory
-		     (expand-file-name (gnus-agent-group-path group)
+(gnus-agent-group-pathname group))))
-				       (gnus-agent-directory)))))
 (defun gnus-agent-batch-confirmation (msg)
 "Show error message and return t."
 (gnus-message 1 msg)
 t)
 (interactive)
 (unless gnus-agent-covered-methods
 (error "No servers are covered by the Gnus agent"))
 (unless gnus-plugged
 (error "Can't fetch articles while Gnus is unplugged"))
-(let ((methods gnus-agent-covered-methods)
+(let ((methods (gnus-agent-covered-methods))
 	groups group gnus-command-method)
 (save-excursion
 (while methods
-	(condition-case err
+	(setq gnus-command-method (car methods))
-	    (progn
+	(when (and (or (gnus-server-opened gnus-command-method)
-	      (setq gnus-command-method (car methods))
+		       (gnus-open-server gnus-command-method))
-	      (when (or (gnus-server-opened gnus-command-method)
+		   (gnus-online gnus-command-method))
-			(gnus-open-server gnus-command-method))
+	  (setq groups (gnus-groups-from-server (car methods)))
-		(setq groups (gnus-groups-from-server (car methods)))
+	  (gnus-agent-with-fetch
-		(gnus-agent-with-fetch
+	    (while (setq group (pop groups))
-		  (while (setq group (pop groups))
+	      (when (<= (gnus-group-level group)
-		    (when (<= (gnus-group-level group) gnus-agent-handle-level)
+			gnus-agent-handle-level)
-		      (gnus-agent-fetch-group-1 group gnus-command-method))))))
+		(if (or debug-on-error debug-on-quit)
-	  (error
+		    (gnus-agent-fetch-group-1
-	   (unless (funcall gnus-agent-confirmation-function
+		     group gnus-command-method)
-			    (format "Error (%s).  Continue? " err))
+		  (condition-case err
-	     (error "Cannot fetch articles into the Gnus agent")))
+		      (gnus-agent-fetch-group-1
-	  (quit
+		       group gnus-command-method)
-	   (unless (funcall gnus-agent-confirmation-function
+		    (error
-			    (format "Quit (%s).  Continue? " err))
+		     (unless (funcall gnus-agent-confirmation-function
-	     (signal 'quit "Cannot fetch articles into the Gnus agent."))))
+				      (format "Error %s while fetching session.  Should gnus continue? "
-	(pop methods))
+					      (error-message-string err)))
+		       (error "Cannot fetch articles into the Gnus agent")))
+		    (quit
+		     (gnus-agent-regenerate-group group)
+		     (unless (funcall gnus-agent-confirmation-function
+				      (format
+				       "%s while fetching session.  Should gnus continue? "
+				       (error-message-string err)))
+		       (signal 'quit
+			       "Cannot fetch articles into the Gnus agent")))))))))
+	(setq methods (cdr methods)))
+(gnus-run-hooks 'gnus-agent-fetched-hook)
 (gnus-message 6 "Finished fetching articles into the Gnus agent"))))
 (defun gnus-agent-fetch-group-1 (group method)
 "Fetch GROUP."
 (let ((gnus-command-method method)
 	(gnus-newsgroup-name group)
-	gnus-newsgroup-dependencies gnus-newsgroup-headers
+	(gnus-newsgroup-dependencies gnus-newsgroup-dependencies)
-	gnus-newsgroup-scored gnus-headers gnus-score
+(gnus-newsgroup-headers gnus-newsgroup-headers)
-	gnus-use-cache articles arts
+	(gnus-newsgroup-scored gnus-newsgroup-scored)
-	category predicate info marks score-param
+	(gnus-use-cache gnus-use-cache)
 	(gnus-summary-expunge-below gnus-summary-expunge-below)
 	(gnus-summary-mark-below gnus-summary-mark-below)
 	(gnus-orphan-score gnus-orphan-score)
 	;; Maybe some other gnus-summary local variables should also
 	;; be put here.
+gnus-headers
+gnus-score
+articles arts
+	category predicate info marks score-param
 	)
 (unless (gnus-check-group group)
 (error "Can't open server for %s" group))
 ;; Fetch headers.
-(when (and (or (gnus-active group) (gnus-activate-group group))
+(when (or gnus-newsgroup-active
-	       (setq articles (gnus-agent-fetch-headers group))
+(gnus-active group)
-	       (let ((nntp-server-buffer gnus-agent-overview-buffer))
+(gnus-activate-group group))
-		 ;; Parse them and see which articles we want to fetch.
+(let ((marked-articles gnus-newsgroup-downloadable))
-		 (setq gnus-newsgroup-dependencies
+;; Identify the articles marked for download
-		       (make-vector (length articles) 0))
+(unless gnus-newsgroup-active
-		 (setq gnus-newsgroup-headers
+	  ;; The variable gnus-newsgroup-active was selected as I need
-		       (gnus-get-newsgroup-headers-xover articles nil nil
+	  ;; a gnus-summary local variable that is NOT bound to any
-							 group))
+	  ;; value (its global value should default to nil).
-		 ;; `gnus-agent-overview-buffer' may be killed for
+(dolist (mark gnus-agent-download-marks)
-		 ;; timeout reason.  If so, recreate it.
+(let ((arts (cdr (assq mark (gnus-info-marks
-		 (gnus-agent-create-buffer)))
+(setq info (gnus-get-info group)))))))
-(setq category (gnus-group-category group))
+(when arts
-(setq predicate
+(setq marked-articles (nconc (gnus-uncompress-range arts)
-	    (gnus-get-predicate
+marked-articles))
-	     (or (gnus-group-find-parameter group 'agent-predicate t)
+))))
-		 (cadr category))))
+(setq marked-articles (sort marked-articles '<))
-(if (memq (caaddr predicate) '(gnus-agent-true gnus-agent-false))
-	  ;; Simple implementation
+;; Fetch any new articles from the server
-	  (setq arts
+(setq articles (gnus-agent-fetch-headers group))
-		(and (eq (caaddr predicate) 'gnus-agent-true) articles))
-	(setq arts nil)
+;; Merge new articles with marked
-	(setq score-param
+(setq articles (sort (append marked-articles articles) '<))
-	      (or (gnus-group-get-parameter group 'agent-score t)
-		  (caddr category)))
+(when articles
-	;; Translate score-param into real one
+;; Parse them and see which articles we want to fetch.
-	(cond
+(setq gnus-newsgroup-dependencies
-	 ((not score-param))
+(or gnus-newsgroup-dependencies
-	 ((eq score-param 'file)
+(make-vector (length articles) 0)))
-	  (setq score-param (gnus-all-score-files group)))
+(setq gnus-newsgroup-headers
-	 ((stringp (car score-param)))
+(or gnus-newsgroup-headers
-	 (t
+(gnus-get-newsgroup-headers-xover articles nil nil
-	  (setq score-param (list (list score-param)))))
+group)))
-	(when score-param
+;; `gnus-agent-overview-buffer' may be killed for
-	  (gnus-score-headers score-param))
+;; timeout reason.  If so, recreate it.
-	(while (setq gnus-headers (pop gnus-newsgroup-headers))
+(gnus-agent-create-buffer)
-	  (setq gnus-score
-		(or (cdr (assq (mail-header-number gnus-headers)
+;; Figure out how to select articles in this group
-			       gnus-newsgroup-scored))
+(setq category (gnus-group-category group))
-		    gnus-summary-default-score))
-	  (when (funcall predicate)
+(setq predicate
-	    (push (mail-header-number gnus-headers)
+(gnus-get-predicate
-		  arts))))
+(gnus-agent-find-parameter group 'agent-predicate)))
-;; Fetch the articles.
-(when arts
+;; If the selection predicate requires scoring, score each header
-	(gnus-agent-fetch-articles group arts)))
+(unless (memq predicate '(gnus-agent-true gnus-agent-false))
-;; Perhaps we have some additional articles to fetch.
+(let ((score-param
-(setq arts (assq 'download (gnus-info-marks
+(gnus-agent-find-parameter group 'agent-score-file)))
-				(setq info (gnus-get-info group)))))
+;; Translate score-param into real one
-(when (cdr arts)
+(cond
-(gnus-agent-fetch-articles
+((not score-param))
-group (gnus-uncompress-range (cdr arts)))
+((eq score-param 'file)
-(setq marks (delq arts (gnus-info-marks info)))
+(setq score-param (gnus-all-score-files group)))
-(gnus-info-set-marks info marks)
+((stringp (car score-param)))
-(gnus-dribble-enter
+(t
-(concat "(gnus-group-set-info '"
+(setq score-param (list (list score-param)))))
-	       (gnus-prin1-to-string info)
+(when score-param
-	       ")")))))
+(gnus-score-headers score-param))))
+(unless (and (eq predicate 'gnus-agent-false)
+(not marked-articles))
+(let ((arts (list nil)))
+(let ((arts-tail arts)
+(alist (gnus-agent-load-alist group))
+(marked-articles marked-articles)
+(gnus-newsgroup-headers gnus-newsgroup-headers))
+(while (setq gnus-headers (pop gnus-newsgroup-headers))
+(let ((num (mail-header-number gnus-headers)))
+;; Determine if this article is already in the cache
+(while (and alist
+(> num (caar alist)))
+(setq alist (cdr alist)))
+(unless (and (eq num (caar alist))
+(cdar alist))
+;; Determine if this article was marked for download.
+(while (and marked-articles
+(> num (car marked-articles)))
+(setq marked-articles
+(cdr marked-articles)))
+;; When this article is marked, or selected by the
+;; predicate, add it to the download list
+(when (or (eq num (car marked-articles))
+(let ((gnus-score
+(or (cdr
+					    (assq num gnus-newsgroup-scored))
+gnus-summary-default-score))
+(gnus-agent-long-article
+(gnus-agent-find-parameter
+group 'agent-long-article))
+(gnus-agent-short-article
+(gnus-agent-find-parameter
+group 'agent-short-article))
+(gnus-agent-low-score
+(gnus-agent-find-parameter
+group 'agent-low-score))
+(gnus-agent-high-score
+(gnus-agent-find-parameter
+group 'agent-high-score))
+(gnus-agent-expire-days
+(gnus-agent-find-parameter
+group 'agent-days-until-old)))
+(funcall predicate)))
+(gnus-agent-append-to-list arts-tail num))))))
+(let (fetched-articles)
+;; Fetch all selected articles
+(setq gnus-newsgroup-undownloaded
+(gnus-sorted-ndifference
+		       gnus-newsgroup-undownloaded
+		       (setq fetched-articles
+			     (if (cdr arts)
+				 (gnus-agent-fetch-articles group (cdr arts))
+			       nil))))
+(let ((unfetched-articles
+		       (gnus-sorted-ndifference (cdr arts) fetched-articles)))
+(if gnus-newsgroup-active
+;; Update the summary buffer
+(progn
+(dolist (article marked-articles)
+(gnus-summary-set-agent-mark article t))
+(dolist (article fetched-articles)
+(when gnus-agent-mark-unread-after-downloaded
+			    (setq gnus-newsgroup-downloadable
+				  (delq article gnus-newsgroup-downloadable))
+(gnus-summary-mark-article
+			       article gnus-unread-mark))
+(when (gnus-summary-goto-subject article nil t)
+(gnus-summary-update-download-mark article)))
+(dolist (article unfetched-articles)
+(gnus-summary-mark-article
+			   article gnus-canceled-mark)))
+;; Update the group buffer.
+;; When some, or all, of the marked articles came
+;; from the download mark.  Remove that mark.  I
+;; didn't do this earlier as I only want to remove
+;; the marks after the fetch is completed.
+(dolist (mark gnus-agent-download-marks)
+(when (eq mark 'download)
+(let ((marked-arts
+			       (assq mark (gnus-info-marks
+					   (setq info (gnus-get-info group))))))
+(when (cdr marked-arts)
+(setq marks
+				  (delq marked-arts (gnus-info-marks info)))
+(gnus-info-set-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)))
+(gnus-group-update-group group t)
+(sit-for 0)
+(gnus-dribble-enter
+(concat "(gnus-group-set-info '"
+(gnus-prin1-to-string info)
+")"))))))))))))
 ;;;
 ;;; Agent Category Mode
 ;;;
 (defvar gnus-category-mode-hook nil
 "Hook run in `gnus-category-mode' buffers.")
 (defvar gnus-category-line-format "     %(%20c%): %g\n"
-"Format of category lines.")
+"Format of category lines.
+Valid specifiers include:
+%c  Topic name (string)
+%g  The number of groups in the topic (integer)
+General format specifiers can also be used.  See Info node
+`(gnus)Formatting Variables'.")
 (defvar gnus-category-mode-line-format "Gnus: %%b"
 "The format specification for the category mode line.")
+(defvar gnus-agent-predicate 'false
+"The selection predicate used when no other source is available.")
 (defvar gnus-agent-short-article 100
 "Articles that have fewer lines than this are short.")
 (defvar gnus-agent-long-article 200
 (gnus-define-keys gnus-category-mode-map
 "q" gnus-category-exit
 "k" gnus-category-kill
 "c" gnus-category-copy
 "a" gnus-category-add
+"e" gnus-agent-customize-category
 "p" gnus-category-edit-predicate
 "g" gnus-category-edit-groups
 "s" gnus-category-edit-score
 "l" gnus-category-list
 gnus-category-menu gnus-category-mode-map ""
 '("Categories"
 ["Add" gnus-category-add t]
 ["Kill" gnus-category-kill t]
 ["Copy" gnus-category-copy t]
+["Edit category" gnus-agent-customize-category t]
 ["Edit predicate" gnus-category-edit-predicate t]
 ["Edit score" gnus-category-edit-score t]
 ["Edit groups" gnus-category-edit-groups t]
 ["Exit" gnus-category-exit t]))
 "Major mode for listing and editing agent categories.
 All normal editing commands are switched off.
 \\<gnus-category-mode-map>
 For more in-depth information on this mode, read the manual
-(`\\[gnus-info-find-node]').
+\(`\\[gnus-info-find-node]').
 The following commands are available:
 \\{gnus-category-mode-map}"
 (interactive)
 (setq mode-line-process nil)
 (use-local-map gnus-category-mode-map)
 (buffer-disable-undo)
 (setq truncate-lines t)
 (setq buffer-read-only t)
-(gnus-run-hooks 'gnus-category-mode-hook))
+(gnus-run-mode-hooks 'gnus-category-mode-hook))
 (defalias 'gnus-category-position-point 'gnus-goto-colon)
 (defun gnus-category-insert-line (category)
-(let* ((gnus-tmp-name (car category))
+(let* ((gnus-tmp-name (format "%s" (car category)))
-	 (gnus-tmp-groups (length (cadddr category))))
+	 (gnus-tmp-groups (length (gnus-agent-cat-groups category))))
 (beginning-of-line)
 (gnus-add-text-properties
 (point)
 (prog1 (1+ (point))
 ;; Insert the text.
 (gnus-category-insert-line (pop alist)))
 (goto-char (point-min))
 (gnus-category-position-point)))
 (defun gnus-category-name ()
-(or (get-text-property (gnus-point-at-bol) 'gnus-category)
+(or (intern (get-text-property (gnus-point-at-bol) 'gnus-category))
 (error "No category on the current line")))
 (defun gnus-category-read ()
 "Read the category alist."
 (setq gnus-category-alist
-	(or (gnus-agent-read-file
+(or
-	     (nnheader-concat gnus-agent-directory "lib/categories"))
+(with-temp-buffer
-	    (list (list 'default 'short nil nil)))))
+(ignore-errors
+(nnheader-insert-file-contents (nnheader-concat gnus-agent-directory "lib/categories"))
+(goto-char (point-min))
+;; This code isn't temp, it will be needed so long as
+;; anyone may be migrating from an older version.
+;; Once we're certain that people will not revert to an
+;; earlier version, we can take out the old-list code in
+;; gnus-category-write.
+(let* ((old-list (read (current-buffer)))
+(new-list (ignore-errors (read (current-buffer)))))
+(if new-list
+new-list
+;; Convert from a positional list to an alist.
+(mapcar
+(lambda (c)
+(setcdr c
+(delq nil
+(gnus-mapcar
+(lambda (valu symb)
+(if valu
+(cons symb valu)))
+(cdr c)
+'(agent-predicate agent-score-file agent-groups))))
+c)
+old-list)))))
+(list (gnus-agent-cat-make 'default 'short)))))
 (defun gnus-category-write ()
 "Write the category alist."
 (setq gnus-category-predicate-cache nil
 	gnus-category-group-cache nil)
 (gnus-make-directory (nnheader-concat gnus-agent-directory "lib"))
 (with-temp-file (nnheader-concat gnus-agent-directory "lib/categories")
+;; This prin1 is temporary.  It exists so that people can revert
+;; to an earlier version of gnus-agent.
+(prin1 (mapcar (lambda (c)
+(list (car c)
+(cdr (assoc 'agent-predicate c))
+(cdr (assoc 'agent-score-file c))
+(cdr (assoc 'agent-groups c))))
+gnus-category-alist)
+(current-buffer))
+(newline)
 (prin1 gnus-category-alist (current-buffer))))
 (defun gnus-category-edit-predicate (category)
 "Edit the predicate for CATEGORY."
 (interactive (list (gnus-category-name)))
 (let ((info (assq category gnus-category-alist)))
 (gnus-edit-form
-(cadr info) (format "Editing the predicate for category %s" category)
+(gnus-agent-cat-predicate info)
+(format "Editing the select predicate for category %s" category)
 `(lambda (predicate)
-	(setcar (cdr (assq ',category gnus-category-alist)) predicate)
+;; Avoid run-time execution of setf form
+;; (setf (gnus-agent-cat-predicate (assq ',category gnus-category-alist))
+;;       predicate)
+;; use its expansion instead:
+(gnus-agent-cat-set-property (assq ',category gnus-category-alist)
+'agent-predicate predicate)
 	(gnus-category-write)
 	(gnus-category-list)))))
 (defun gnus-category-edit-score (category)
 "Edit the score expression for CATEGORY."
 (interactive (list (gnus-category-name)))
 (let ((info (assq category gnus-category-alist)))
 (gnus-edit-form
-(caddr info)
+(gnus-agent-cat-score-file info)
 (format "Editing the score expression for category %s" category)
-`(lambda (groups)
+`(lambda (score-file)
-	(setcar (cddr (assq ',category gnus-category-alist)) groups)
+;; Avoid run-time execution of setf form
+;; (setf (gnus-agent-cat-score-file (assq ',category gnus-category-alist))
+;;       score-file)
+;; use its expansion instead:
+(gnus-agent-cat-set-property (assq ',category gnus-category-alist)
+'agent-score-file score-file)
 	(gnus-category-write)
 	(gnus-category-list)))))
 (defun gnus-category-edit-groups (category)
 "Edit the group list for CATEGORY."
 (interactive (list (gnus-category-name)))
 (let ((info (assq category gnus-category-alist)))
 (gnus-edit-form
-(cadddr info) (format "Editing the group list for category %s" category)
+(gnus-agent-cat-groups info)
+(format "Editing the group list for category %s" category)
 `(lambda (groups)
-	(setcar (nthcdr 3 (assq ',category gnus-category-alist)) groups)
+;; Avoid run-time execution of setf form
+;; (setf (gnus-agent-cat-groups (assq ',category gnus-category-alist))
+;;       groups)
+;; use its expansion instead:
+(gnus-agent-set-cat-groups (assq ',category gnus-category-alist)
+groups)
 	(gnus-category-write)
 	(gnus-category-list)))))
 (defun gnus-category-kill (category)
 "Kill the current category."
 (defun gnus-category-copy (category to)
 "Copy the current category."
 (interactive (list (gnus-category-name) (intern (read-string "New name: "))))
 (let ((info (assq category gnus-category-alist)))
-(push (list to (gnus-copy-sequence (cadr info))
+(push (let ((newcat (gnus-copy-sequence info)))
-		(gnus-copy-sequence (caddr info)) nil)
+(setf (gnus-agent-cat-name newcat) to)
+(setf (gnus-agent-cat-groups newcat) nil)
+newcat)
 	  gnus-category-alist)
 (gnus-category-write)
 (gnus-category-list)))
 (defun gnus-category-add (category)
 "Create a new category."
 (interactive "SCategory name: ")
 (when (assq category gnus-category-alist)
 (error "Category %s already exists" category))
-(push (list category 'false nil nil)
+(push (gnus-agent-cat-make category)
 	gnus-category-alist)
 (gnus-category-write)
 (gnus-category-list))
 (defun gnus-category-list ()
 '((spam . gnus-agent-spam-p)
 (short . gnus-agent-short-p)
 (long . gnus-agent-long-p)
 (low . gnus-agent-low-scored-p)
 (high . gnus-agent-high-scored-p)
+(read . gnus-agent-read-p)
 (true . gnus-agent-true)
 (false . gnus-agent-false))
 "Mapping from short score predicate symbols to predicate functions.")
 (defun gnus-agent-spam-p ()
 (defun gnus-agent-high-scored-p ()
 "Say whether an article has a high score or not."
 (> gnus-score gnus-agent-high-score))
-(defun gnus-category-make-function (cat)
+(defun gnus-agent-read-p ()
-"Make a function from category CAT."
+"Say whether an article is read or not."
-`(lambda () ,(gnus-category-make-function-1 cat)))
+(gnus-member-of-range (mail-header-number gnus-headers)
+			(gnus-info-read (gnus-get-info gnus-newsgroup-name))))
+(defun gnus-category-make-function (predicate)
+"Make a function from PREDICATE."
+(let ((func (gnus-category-make-function-1 predicate)))
+(if (and (= (length func) 1)
+	     (symbolp (car func)))
+	(car func)
+(gnus-byte-compile `(lambda () ,func)))))
 (defun gnus-agent-true ()
 "Return t."
 t)
 (defun gnus-agent-false ()
 "Return nil."
 nil)
-(defun gnus-category-make-function-1 (cat)
+(defun gnus-category-make-function-1 (predicate)
-"Make a function from category CAT."
+"Make a function from PREDICATE."
 (cond
 ;; Functions are just returned as is.
-((or (symbolp cat)
+((or (symbolp predicate)
-	(gnus-functionp cat))
+	(functionp predicate))
-`(,(or (cdr (assq cat gnus-category-predicate-alist))
+`(,(or (cdr (assq predicate gnus-category-predicate-alist))
-	   cat)))
+	   predicate)))
-;; More complex category.
+;; More complex predicate.
-((consp cat)
+((consp predicate)
 `(,(cond
-	((memq (car cat) '(& and))
+	((memq (car predicate) '(& and))
 	 'and)
-	((memq (car cat) '(| or))
+	((memq (car predicate) '(| or))
 	 'or)
-	((memq (car cat) gnus-category-not)
+	((memq (car predicate) gnus-category-not)
 	 'not))
-,@(mapcar 'gnus-category-make-function-1 (cdr cat))))
+,@(mapcar 'gnus-category-make-function-1 (cdr predicate))))
 (t
-(error "Unknown category type: %s" cat))))
+(error "Unknown predicate type: %s" predicate))))
 (defun gnus-get-predicate (predicate)
-"Return the predicate for CATEGORY."
+"Return the function implementing PREDICATE."
 (or (cdr (assoc predicate gnus-category-predicate-cache))
-(cdar (push (cons predicate
+(let ((func (gnus-category-make-function predicate)))
-			(gnus-category-make-function predicate))
+	(setq gnus-category-predicate-cache
-		  gnus-category-predicate-cache))))
+	      (nconc gnus-category-predicate-cache
+		     (list (cons predicate func))))
+	func)))
+(defun gnus-predicate-implies-unread (predicate)
+"Say whether PREDICATE implies unread articles only.
+It is okay to miss some cases, but there must be no false positives.
+That is, if this predicate returns true, then indeed the predicate must
+return only unread articles."
+(eq t (gnus-function-implies-unread-1
+(gnus-category-make-function-1 predicate))))
+(defun gnus-function-implies-unread-1 (function)
+"Recursively evaluate a predicate function to determine whether it can select
+any read articles.  Returns t if the function is known to never
+return read articles, nil when it is known to always return read
+articles, and t_nil when the function may return both read and unread
+articles."
+(let ((func (car function))
+(args (mapcar 'gnus-function-implies-unread-1 (cdr function))))
+(cond ((eq func 'and)
+(cond ((memq t args) ; if any argument returns only unread articles
+;; then that argument constrains the result to only unread articles.
+t)
+((memq 't_nil args) ; if any argument is indeterminate
+;; then the result is indeterminate
+'t_nil)))
+((eq func 'or)
+(cond ((memq nil args) ; if any argument returns read articles
+;; then that argument ensures that the results includes read articles.
+nil)
+((memq 't_nil args) ; if any argument is indeterminate
+;; then that argument ensures that the results are indeterminate
+'t_nil)
+(t ; if all arguments return only unread articles
+;; then the result returns only unread articles
+t)))
+((eq func 'not)
+(cond ((eq (car args) 't_nil) ; if the argument is indeterminate
+; then the result is indeterminate
+(car args))
+(t ; otherwise
+; toggle the result to be the opposite of the argument
+(not (car args)))))
+((eq func 'gnus-agent-read-p)
+nil) ; The read predicate NEVER returns unread articles
+((eq func 'gnus-agent-false)
+t) ; The false predicate returns t as the empty set excludes all read articles
+((eq func 'gnus-agent-true)
+nil) ; The true predicate ALWAYS returns read articles
+((catch 'found-match
+(let ((alist gnus-category-predicate-alist))
+(while alist
+(if (eq func (cdar alist))
+(throw 'found-match t)
+(setq alist (cdr alist))))))
+'t_nil) ; All other predicates return read and unread articles
+(t
+(error "Unknown predicate function: %s" function)))))
 (defun gnus-group-category (group)
 "Return the category GROUP belongs to."
 (unless gnus-category-group-cache
 (setq gnus-category-group-cache (gnus-make-hashtable 1000))
 (let ((cs gnus-category-alist)
 	  groups cat)
 (while (setq cat (pop cs))
-	(setq groups (cadddr cat))
+	(setq groups (gnus-agent-cat-groups cat))
 	(while groups
 	  (gnus-sethash (pop groups) cat gnus-category-group-cache)))))
 (or (gnus-gethash group gnus-category-group-cache)
 (assq 'default gnus-category-alist)))
-(defun gnus-agent-expire ()
+(defun gnus-agent-expire-group (group &optional articles force)
-"Expire all old articles."
+"Expire all old articles in GROUP.
+If you want to force expiring of certain articles, this function can
+take ARTICLES, and FORCE parameters as well.
+The articles on which the expiration process runs are selected as follows:
+if ARTICLES is null, all read and unmarked articles.
+if ARTICLES is t, all articles.
+if ARTICLES is a list, just those articles.
+FORCE is equivalent to setting the expiration predicates to true."
+(interactive
+(list (let ((def (or (gnus-group-group-name)
+gnus-newsgroup-name)))
+(let ((select (read-string (if def
+(concat "Group Name ("
+def "): ")
+"Group Name: "))))
+(if (and (equal "" select)
+def)
+def
+select)))))
+(if (not group)
+(gnus-agent-expire articles group force)
+(let ( ;; Bind gnus-agent-expire-stats to enable tracking of
+	   ;; expiration statistics of this single group
+(gnus-agent-expire-stats (list 0 0 0.0)))
+(if (or (not (eq articles t))
+(yes-or-no-p
+(concat "Are you sure that you want to "
+"expire all articles in " group "? ")))
+(let ((gnus-command-method (gnus-find-method-for-group group))
+(overview (gnus-get-buffer-create " *expire overview*"))
+orig)
+(unwind-protect
+(let ((active-file (gnus-agent-lib-file "active")))
+(when (file-exists-p active-file)
+(with-temp-buffer
+(nnheader-insert-file-contents active-file)
+(gnus-active-to-gnus-format
+gnus-command-method
+(setq orig (gnus-make-hashtable
+(count-lines (point-min) (point-max))))))
+(save-excursion
+(gnus-agent-expire-group-1
+group overview (gnus-gethash-safe group orig)
+articles force))))
+(kill-buffer overview))))
+(gnus-message 4 (gnus-agent-expire-done-message)))))
+(defun gnus-agent-expire-group-1 (group overview active articles force)
+;; Internal function - requires caller to have set
+;; gnus-command-method, initialized overview buffer, and to have
+;; provided a non-nil active
+(let ((dir (gnus-agent-group-pathname group)))
+(when (boundp 'gnus-agent-expire-current-dirs)
+(set 'gnus-agent-expire-current-dirs
+	   (cons dir
+		 (symbol-value 'gnus-agent-expire-current-dirs))))
+(if (and (not force)
+	     (eq 'DISABLE (gnus-agent-find-parameter group
+						     'agent-enable-expiration)))
+	(gnus-message 5 "Expiry skipping over %s" group)
+(gnus-message 5 "Expiring articles in %s" group)
+(gnus-agent-load-alist group)
+(let* ((bytes-freed 0)
+	     (files-deleted 0)
+	     (nov-entries-deleted 0)
+	     (info (gnus-get-info group))
+	     (alist gnus-agent-article-alist)
+	     (day (- (time-to-days (current-time))
+		     (gnus-agent-find-parameter group 'agent-days-until-old)))
+	     (specials (if (and alist
+				(not force))
+			   ;; This could be a bit of a problem.  I need to
+			   ;; keep the last article to avoid refetching
+			   ;; headers when using nntp in the backend.  At
+			   ;; the same time, if someone uses a backend
+			   ;; that supports article moving then I may have
+			   ;; to remove the last article to complete the
+			   ;; move.  Right now, I'm going to assume that
+			   ;; FORCE overrides specials.
+			   (list (caar (last alist)))))
+	     (unreads ;; Articles that are excluded from the
+	      ;; expiration process
+	      (cond (gnus-agent-expire-all
+		     ;; All articles are marked read by global decree
+		     nil)
+		    ((eq articles t)
+		     ;; All articles are marked read by function
+		     ;; parameter
+		     nil)
+		    ((not articles)
+		     ;; Unread articles are marked protected from
+		     ;; expiration Don't call
+		     ;; gnus-list-of-unread-articles as it returns
+		     ;; articles that have not been fetched into the
+		     ;; agent.
+		     (ignore-errors
+		      (gnus-agent-unread-articles group)))
+		    (t
+		     ;; All articles EXCEPT those named by the caller
+		     ;; are protected from expiration
+		     (gnus-sorted-difference
+		      (gnus-uncompress-range
+		       (cons (caar alist)
+			     (caar (last alist))))
+		      (sort articles '<)))))
+	     (marked ;; More articles that are excluded from the
+	      ;; expiration process
+	      (cond (gnus-agent-expire-all
+		     ;; All articles are unmarked by global decree
+		     nil)
+		    ((eq articles t)
+		     ;; All articles are unmarked by function
+		     ;; parameter
+		     nil)
+		    (articles
+		     ;; All articles may as well be unmarked as the
+		     ;; unreads list already names the articles we are
+		     ;; going to keep
+		     nil)
+		    (t
+		     ;; Ticked and/or dormant articles are excluded
+		     ;; from expiration
+		     (nconc
+		      (gnus-uncompress-range
+		       (cdr (assq 'tick (gnus-info-marks info))))
+		      (gnus-uncompress-range
+		       (cdr (assq 'dormant
+				  (gnus-info-marks info))))))))
+	     (nov-file (concat dir ".overview"))
+	     (cnt 0)
+	     (completed -1)
+	     dlist
+	     type)
+	;; The normal article alist contains elements that look like
+	;; (article# .  fetch_date) I need to combine other
+	;; information with this list.  For example, a flag indicating
+	;; that a particular article MUST BE KEPT.  To do this, I'm
+	;; going to transform the elements to look like (article#
+	;; fetch_date keep_flag NOV_entry_marker) Later, I'll reverse
+	;; the process to generate the expired article alist.
+	;; Convert the alist elements to (article# fetch_date nil
+	;; nil).
+	(setq dlist (mapcar (lambda (e)
+			      (list (car e) (cdr e) nil nil)) alist))
+	;; Convert the keep lists to elements that look like (article#
+	;; nil keep_flag nil) then append it to the expanded dlist
+	;; These statements are sorted by ascending precidence of the
+	;; keep_flag.
+	(setq dlist (nconc dlist
+			   (mapcar (lambda (e)
+				     (list e nil 'unread  nil))
+				   unreads)))
+	(setq dlist (nconc dlist
+			   (mapcar (lambda (e)
+				     (list e nil 'marked  nil))
+				   marked)))
+	(setq dlist (nconc dlist
+			   (mapcar (lambda (e)
+				     (list e nil 'special nil))
+				   specials)))
+	(set-buffer overview)
+	(erase-buffer)
+	(buffer-disable-undo)
+	(when (file-exists-p nov-file)
+	  (gnus-message 7 "gnus-agent-expire: Loading overview...")
+	  (nnheader-insert-file-contents nov-file)
+	  (goto-char (point-min))
+	  (let (p)
+	    (while (< (setq p (point)) (point-max))
+	      (condition-case nil
+		  ;; If I successfully read an integer (the plus zero
+		  ;; ensures a numeric type), prepend a marker entry
+		  ;; to the list
+		  (push (list (+ 0 (read (current-buffer))) nil nil
+			      (set-marker (make-marker) p))
+			dlist)
+		(error
+		 (gnus-message 1 "gnus-agent-expire: read error \
+occurred when reading expression at %s in %s.  Skipping to next \
+line." (point) nov-file)))
+	      ;; Whether I succeeded, or failed, it doesn't matter.
+	      ;; Move to the next line then try again.
+	      (forward-line 1)))
+	  (gnus-message
+	   7 "gnus-agent-expire: Loading overview... Done"))
+	(set-buffer-modified-p nil)
+	;; At this point, all of the information is in dlist.  The
+	;; only problem is that much of it is spread across multiple
+	;; entries.  Sort then MERGE!!
+	(gnus-message 7 "gnus-agent-expire: Sorting entries... ")
+	;; If two entries have the same article-number then sort by
+	;; ascending keep_flag.
+	(let ((special 0)
+	      (marked 1)
+	      (unread 2))
+	  (setq dlist
+		(sort dlist
+		      (lambda (a b)
+			(cond ((< (nth 0 a) (nth 0 b))
+			       t)
+			      ((> (nth 0 a) (nth 0 b))
+			       nil)
+			      (t
+			       (let ((a (or (symbol-value (nth 2 a))
+					    3))
+				     (b (or (symbol-value (nth 2 b))
+					    3)))
+				 (<= a b))))))))
+	(gnus-message 7 "gnus-agent-expire: Sorting entries... Done")
+	(gnus-message 7 "gnus-agent-expire: Merging entries... ")
+	(let ((dlist dlist))
+	  (while (cdr dlist)		; I'm not at the end-of-list
+	    (if (eq (caar dlist) (caadr dlist))
+		(let ((first (cdr (car dlist)))
+		      (secnd (cdr (cadr dlist))))
+		  (setcar first (or (car first)
+				    (car secnd))) ; fetch_date
+		  (setq first (cdr first)
+			secnd (cdr secnd))
+		  (setcar first (or (car first)
+				    (car secnd))) ; Keep_flag
+		  (setq first (cdr first)
+			secnd (cdr secnd))
+		  (setcar first (or (car first)
+				    (car secnd))) ; NOV_entry_marker
+		  (setcdr dlist (cddr dlist)))
+	      (setq dlist (cdr dlist)))))
+	(gnus-message 7 "gnus-agent-expire: Merging entries... Done")
+	(let* ((len (float (length dlist)))
+	       (alist (list nil))
+	       (tail-alist alist))
+	  (while dlist
+	    (let ((new-completed (truncate (* 100.0
+					      (/ (setq cnt (1+ cnt))
+						 len))))
+		  message-log-max)
+	      (when (> new-completed completed)
+		(setq completed new-completed)
+		(gnus-message 7 "%3d%% completed..."  completed)))
+	    (let* ((entry          (car dlist))
+		   (article-number (nth 0 entry))
+		   (fetch-date     (nth 1 entry))
+		   (keep           (nth 2 entry))
+		   (marker         (nth 3 entry)))
+	      (cond
+	       ;; Kept articles are unread, marked, or special.
+	       (keep
+		(gnus-agent-message 10
+				    "gnus-agent-expire: %s:%d: Kept %s article%s."
+				    group article-number keep (if fetch-date " and file" ""))
+		(when fetch-date
+		  (unless (file-exists-p
+			   (concat dir (number-to-string
+					article-number)))
+		    (setf (nth 1 entry) nil)
+		    (gnus-agent-message 3 "gnus-agent-expire cleared \
+download flag on %s:%d as the cached article file is missing."
+					group (caar dlist)))
+		  (unless marker
+		    (gnus-message 1 "gnus-agent-expire detected a \
+missing NOV entry.  Run gnus-agent-regenerate-group to restore it.")))
+		(gnus-agent-append-to-list
+		 tail-alist
+		 (cons article-number fetch-date)))
+	       ;; The following articles are READ, UNMARKED, and
+	       ;; ORDINARY.  See if they can be EXPIRED!!!
+	       ((setq type
+		      (cond
+		       ((not (integerp fetch-date))
+			 'read)	;; never fetched article (may expire
+		       ;; right now)
+		       ((not (file-exists-p
+			      (concat dir (number-to-string
+					   article-number))))
+			(setf (nth 1 entry) nil)
+			'externally-expired) ;; Can't find the cached
+		       ;; article.  Handle case
+		       ;; as though this article
+		       ;; was never fetched.
+		       ;; We now have the arrival day, so we see
+		       ;; whether it's old enough to be expired.
+		       ((< fetch-date day)
+			'expired)
+		       (force
+			'forced)))
+		;; I found some reason to expire this entry.
+		(let ((actions nil))
+		  (when (memq type '(forced expired))
+		    (ignore-errors	; Just being paranoid.
+		     (let* ((file-name (nnheader-concat dir (number-to-string
+							     article-number)))
+			    (size (float (nth 7 (file-attributes file-name)))))
+		       (incf bytes-freed size)
+		       (incf files-deleted)
+		       (delete-file file-name))
+		     (push "expired cached article" actions))
+		    (setf (nth 1 entry) nil)
+		    )
+		  (when marker
+		    (push "NOV entry removed" actions)
+		    (goto-char marker)
+		    (incf nov-entries-deleted)
+		    (let ((from (gnus-point-at-bol))
+			  (to (progn (forward-line 1) (point))))
+		      (incf bytes-freed (- to from))
+		      (delete-region from to)))
+		  ;; If considering all articles is set, I can only
+		  ;; expire article IDs that are no longer in the
+		  ;; active range (That is, articles that preceed the
+		  ;; first article in the new alist).
+		  (if (and gnus-agent-consider-all-articles
+			   (>= article-number (car active)))
+		      ;; I have to keep this ID in the alist
+		      (gnus-agent-append-to-list
+		       tail-alist (cons article-number fetch-date))
+		    (push (format "Removed %s article number from \
+article alist" type) actions))
+		  (when actions
+		    (gnus-agent-message 8 "gnus-agent-expire: %s:%d: %s"
+					group article-number
+					(mapconcat 'identity actions ", ")))))
+	       (t
+		(gnus-agent-message
+		 10 "gnus-agent-expire: %s:%d: Article kept as \
+expiration tests failed." group article-number)
+		(gnus-agent-append-to-list
+		 tail-alist (cons article-number fetch-date)))
+	       )
+	      ;; Clean up markers as I want to recycle this buffer
+	      ;; over several groups.
+	      (when marker
+		(set-marker marker nil))
+	      (setq dlist (cdr dlist))))
+	  (setq alist (cdr alist))
+	  (let ((inhibit-quit t))
+	    (unless (equal alist gnus-agent-article-alist)
+	      (setq gnus-agent-article-alist alist)
+	      (gnus-agent-save-alist group))
+	    (when (buffer-modified-p)
+	      (let ((coding-system-for-write
+		     gnus-agent-file-coding-system))
+		(gnus-make-directory dir)
+		(write-region (point-min) (point-max) nov-file nil
+			      'silent)
+		;; clear the modified flag as that I'm not confused by
+		;; its status on the next pass through this routine.
+		(set-buffer-modified-p nil)))
+	    (when (eq articles t)
+	      (gnus-summary-update-info))))
+	(when (boundp 'gnus-agent-expire-stats)
+	  (let ((stats (symbol-value 'gnus-agent-expire-stats)))
+	    (incf (nth 2 stats) bytes-freed)
+	    (incf (nth 1 stats) files-deleted)
+	    (incf (nth 0 stats) nov-entries-deleted)))
+	))))
+(defun gnus-agent-expire (&optional articles group force)
+"Expire all old articles.
+If you want to force expiring of certain articles, this function can
+take ARTICLES, GROUP and FORCE parameters as well.
+The articles on which the expiration process runs are selected as follows:
+if ARTICLES is null, all read and unmarked articles.
+if ARTICLES is t, all articles.
+if ARTICLES is a list, just those articles.
+Setting GROUP will limit expiration to that group.
+FORCE is equivalent to setting the expiration predicates to true."
 (interactive)
-(let ((methods gnus-agent-covered-methods)
-	(day (- (time-to-days (current-time)) gnus-agent-expire-days))
+(if group
-	gnus-command-method sym group articles
+(gnus-agent-expire-group group articles force)
-	history overview file histories elem art nov-file low info
+(if (or (not (eq articles t))
-	unreads marked article orig lowest highest)
+(yes-or-no-p "Are you sure that you want to expire all \
-(save-excursion
+articles in every agentized group? "))
-(setq overview (gnus-get-buffer-create " *expire overview*"))
+(let ((methods (gnus-agent-covered-methods))
-(while (setq gnus-command-method (pop methods))
+;; Bind gnus-agent-expire-current-dirs to enable tracking
-	(when (file-exists-p (gnus-agent-lib-file "active"))
+;; of agent directories.
-	  (with-temp-buffer
+(gnus-agent-expire-current-dirs nil)
-	    (nnheader-insert-file-contents (gnus-agent-lib-file "active"))
+;; Bind gnus-agent-expire-stats to enable tracking of
-	    (gnus-active-to-gnus-format
+;; expiration statistics across all groups
-	     gnus-command-method
+(gnus-agent-expire-stats (list 0 0 0.0))
-	     (setq orig (gnus-make-hashtable
+gnus-command-method overview orig)
-			 (count-lines (point-min) (point-max))))))
+(setq overview (gnus-get-buffer-create " *expire overview*"))
-	  (let ((expiry-hashtb (gnus-make-hashtable 1023)))
+(unwind-protect
-	    (gnus-agent-open-history)
+(while (setq gnus-command-method (pop methods))
-	    (set-buffer
+(let ((active-file (gnus-agent-lib-file "active")))
-	     (setq gnus-agent-current-history
+(when (file-exists-p active-file)
-		   (setq history (gnus-agent-history-buffer))))
+(with-temp-buffer
-	    (goto-char (point-min))
+(nnheader-insert-file-contents active-file)
-	    (when (> (buffer-size) 1)
+(gnus-active-to-gnus-format
-	      (goto-char (point-min))
+gnus-command-method
-	      (while (not (eobp))
+(setq orig (gnus-make-hashtable
-		(skip-chars-forward "^\t")
+(count-lines (point-min) (point-max))))))
-		(if (> (read (current-buffer)) day)
+(dolist (expiring-group (gnus-groups-from-server
-		    ;; New article; we don't expire it.
+gnus-command-method))
-		    (forward-line 1)
+(let* ((active
-		  ;; Old article.  Schedule it for possible nuking.
+(gnus-gethash-safe expiring-group orig)))
-		  (while (not (eolp))
-		    (setq sym (let ((obarray expiry-hashtb) s)
+(when active
-				(setq s (read (current-buffer)))
+(save-excursion
-				(if (stringp s) (intern s) s)))
+(gnus-agent-expire-group-1
-		    (if (boundp sym)
+expiring-group overview active articles force))))))))
-			(set sym (cons (cons (read (current-buffer)) (point))
+(kill-buffer overview))
-				       (symbol-value sym)))
+(gnus-agent-expire-unagentized-dirs)
-		      (set sym (list (cons (read (current-buffer)) (point)))))
+(gnus-message 4 (gnus-agent-expire-done-message))))))
-		    (skip-chars-forward " "))
-		  (forward-line 1)))
+(defun gnus-agent-expire-done-message ()
-	      ;; We now have all articles that can possibly be expired.
+(if (and (> gnus-verbose 4)
-	      (mapatoms
+(boundp 'gnus-agent-expire-stats))
-	       (lambda (sym)
+(let* ((stats (symbol-value 'gnus-agent-expire-stats))
-		 (setq group (symbol-name sym)
+(size (nth 2 stats))
-		       articles (sort (symbol-value sym) 'car-less-than-car)
+(units '(B KB MB GB)))
-		       low (car (gnus-active group))
+(while (and (> size 1024.0)
-		       info (gnus-get-info group)
+(cdr units))
-		       unreads (ignore-errors
+(setq size (/ size 1024.0)
-				 (gnus-list-of-unread-articles group))
+units (cdr units)))
-		       marked (nconc
-			       (gnus-uncompress-range
+(format "Expiry recovered %d NOV entries, deleted %d files,\
-				(cdr (assq 'tick (gnus-info-marks info))))
+and freed %f %s."
-			       (gnus-uncompress-range
+(nth 0 stats)
-				(cdr (assq 'dormant
+(nth 1 stats)
-					   (gnus-info-marks info)))))
+size (car units)))
-		       nov-file (gnus-agent-article-name ".overview" group)
+"Expiry...done"))
-		       lowest nil
-		       highest nil)
+(defun gnus-agent-expire-unagentized-dirs ()
-		 (gnus-agent-load-alist group)
+(when (and gnus-agent-expire-unagentized-dirs
-		 (gnus-message 5 "Expiring articles in %s" group)
+(boundp 'gnus-agent-expire-current-dirs))
-		 (set-buffer overview)
+(let* ((keep (gnus-make-hashtable))
-		 (erase-buffer)
+	   ;; Formally bind gnus-agent-expire-current-dirs so that the
-		 (when (file-exists-p nov-file)
+	   ;; compiler will not complain about free references.
-		   (nnheader-insert-file-contents nov-file))
+	   (gnus-agent-expire-current-dirs
-		 (goto-char (point-min))
+	    (symbol-value 'gnus-agent-expire-current-dirs))
-		 (setq article 0)
+dir)
-		 (while (setq elem (pop articles))
-		   (setq article (car elem))
+(gnus-sethash gnus-agent-directory t keep)
-		   (when (or (null low)
+(while gnus-agent-expire-current-dirs
-			     (< article low)
+	(setq dir (pop gnus-agent-expire-current-dirs))
-			     gnus-agent-expire-all
+	(when (and (stringp dir)
-			     (and (not (memq article unreads))
+		   (file-directory-p dir))
-				  (not (memq article marked))))
+	  (while (not (gnus-gethash dir keep))
-		     ;; Find and nuke the NOV line.
+	    (gnus-sethash dir t keep)
-		     (while (and (not (eobp))
+	    (setq dir (file-name-directory (directory-file-name dir))))))
-				 (or (not (numberp
-					   (setq art (read (current-buffer)))))
+(let* (to-remove
-				     (< art article)))
+checker
-		       (if (and (numberp art)
+(checker
-				(file-exists-p
+(function
-				 (gnus-agent-article-name
+(lambda (d)
-				  (number-to-string art) group)))
+"Given a directory, check it and its subdirectories for
-			   (progn
+membership in the keep hash.  If it isn't found, add
-			     (unless lowest
+it to to-remove."
-			       (setq lowest art))
+(let ((files (directory-files d))
-			     (setq highest art)
+file)
-			     (forward-line 1))
+(while (setq file (pop files))
-			 ;; Remove old NOV lines that have no articles.
+(cond ((equal file ".") ; Ignore self
-			 (gnus-delete-line)))
+nil)
-		     (if (or (eobp)
+((equal file "..") ; Ignore parent
-			     (/= art article))
+nil)
-			 (beginning-of-line)
+((equal file ".overview")
-		       (gnus-delete-line))
+;; Directory must contain .overview to be
-		     ;; Nuke the article.
+;; agent's cache of a group.
-		     (when (file-exists-p
+(let ((d (file-name-as-directory d))
-			    (setq file (gnus-agent-article-name
+r)
-					(number-to-string article)
+;; Search ancestor's for last directory NOT
-					group)))
+;; found in keep hash.
-		       (delete-file file))
+(while (not (gnus-gethash
-		     ;; Schedule the history line for nuking.
+(setq d (file-name-directory d)) keep))
-		     (push (cdr elem) histories)))
+(setq r d
-		 (gnus-make-directory (file-name-directory nov-file))
+d (directory-file-name d)))
-		 (let ((coding-system-for-write
+;; if ANY ancestor was NOT in keep hash and
-			gnus-agent-file-coding-system))
+;; it it's already in to-remove, add it to
-		   (write-region (point-min) (point-max) nov-file nil 'silent))
+;; to-remove.
-		 ;; Delete the unwanted entries in the alist.
+(if (and r
-		 (setq gnus-agent-article-alist
+(not (member r to-remove)))
-		       (sort gnus-agent-article-alist 'car-less-than-car))
+(push r to-remove))))
-		 (let* ((alist gnus-agent-article-alist)
+((file-directory-p (setq file (nnheader-concat d file)))
-			(prev (cons nil alist))
+(funcall checker file)))))))))
-			(first prev)
+(funcall checker (expand-file-name gnus-agent-directory))
-			expired)
-		   (while (and alist
+(when (and to-remove
-			       (<= (caar alist) article))
+(or gnus-expert-user
-		     (if (or (not (cdar alist))
+(gnus-y-or-n-p
-			     (not (file-exists-p
+"gnus-agent-expire has identified local directories that are\
-				   (gnus-agent-article-name
+not currently required by any agentized group.	 Do you wish to consider\
-				    (number-to-string
+deleting them?")))
-				     (caar alist))
+(while to-remove
-				    group))))
+(let ((dir (pop to-remove)))
-			 (progn
+(if (gnus-y-or-n-p (format "Delete %s? " dir))
-			   (push (caar alist) expired)
+(let* (delete-recursive
-			   (setcdr prev (setq alist (cdr alist))))
+(delete-recursive
-		       (setq prev alist
+(function
-			     alist (cdr alist))))
+(lambda (f-or-d)
-		   (setq gnus-agent-article-alist (cdr first))
+(ignore-errors
-		   (gnus-agent-save-alist group)
+(if (file-directory-p f-or-d)
-		   ;; Mark all articles up to the first article
+(condition-case nil
-		   ;; in `gnus-article-alist' as read.
+(delete-directory f-or-d)
-		   (when (and info (caar gnus-agent-article-alist))
+(file-error
-		     (setcar (nthcdr 2 info)
+(mapcar (lambda (f)
-			     (gnus-range-add
+(or (member f '("." ".."))
-			      (nth 2 info)
+(funcall delete-recursive
-			      (cons 1 (- (caar gnus-agent-article-alist) 1)))))
+(nnheader-concat
-		   ;; Maybe everything has been expired from `gnus-article-alist'
+f-or-d f))))
-		   ;; and so the above marking as read could not be conducted,
+(directory-files f-or-d))
-		   ;; or there are expired article within the range of the alist.
+(delete-directory f-or-d)))
-		   (when (and info
+(delete-file f-or-d)))))))
-			      expired
+(funcall delete-recursive dir))))))))))
-			      (or (not (caar gnus-agent-article-alist))
-				  (> (car expired)
-				     (caar gnus-agent-article-alist))))
-		     (setcar (nthcdr 2 info)
-			     (gnus-add-to-range
-			      (nth 2 info)
-			      (nreverse expired))))
-		   (gnus-dribble-enter
-		    (concat "(gnus-group-set-info '"
-			    (gnus-prin1-to-string info)
-			    ")")))
-		 (when lowest
-		   (if (gnus-gethash group orig)
-		       (setcar (gnus-gethash group orig) lowest)
-		     (gnus-sethash group (cons lowest highest) orig))))
-	       expiry-hashtb)
-	      (set-buffer history)
-	      (setq histories (nreverse (sort histories '<)))
-	      (while histories
-		(goto-char (pop histories))
-		(gnus-delete-line))
-	      (gnus-agent-save-history)
-	      (gnus-agent-close-history)
-	      (gnus-write-active-file
-	       (gnus-agent-lib-file "active") orig))
-	    (gnus-message 4 "Expiry...done")))))))
 ;;;###autoload
 (defun gnus-agent-batch ()
+"Start Gnus, send queue and fetch session."
 (interactive)
 (let ((init-file-user "")
 	(gnus-always-read-dribble-file t))
 (gnus))
-(gnus-group-send-drafts)
+(let ((gnus-agent-confirmation-function 'gnus-agent-batch-confirmation))
-(gnus-agent-fetch-session))
+(gnus-group-send-queue)
+(gnus-agent-fetch-session)))
+(defun gnus-agent-unread-articles (group)
+(let* ((read (gnus-info-read (gnus-get-info group)))
+	 (known (gnus-agent-load-alist group))
+	 (unread (list nil))
+	 (tail-unread unread))
+(while (and known read)
+(let ((candidate (car (pop known))))
+	(while (let* ((range (car read))
+		      (min   (if (numberp range) range (car range)))
+		      (max   (if (numberp range) range (cdr range))))
+		 (cond ((or (not min)
+			    (< candidate min))
+			(gnus-agent-append-to-list tail-unread candidate)
+			nil)
+		       ((> candidate max)
+			(setq read (cdr read))
+;; return t so that I always loop one more
+;; time.  If I just iterated off the end of
+;; read, min will become nil and the current
+;; candidate will be added to the unread list.
+t))))))
+(while known
+(gnus-agent-append-to-list tail-unread (car (pop known))))
+(cdr unread)))
+(defun gnus-agent-uncached-articles (articles group &optional cached-header)
+"Restrict ARTICLES to numbers already fetched.
+Returns a sublist of ARTICLES that excludes those article ids in GROUP
+that have already been fetched.
+If CACHED-HEADER is nil, articles are only excluded if the article itself
+has been fetched."
+;; Logically equivalent to: (gnus-sorted-difference articles (mapcar
+;; 'car gnus-agent-article-alist))
+;; Functionally, I don't need to construct a temp list using mapcar.
+(if (and (or gnus-agent-cache (not gnus-plugged))
+(gnus-agent-load-alist group))
+(let* ((ref gnus-agent-article-alist)
+(arts articles)
+(uncached (list nil))
+(tail-uncached uncached))
+(while (and ref arts)
+(let ((v1 (car arts))
+(v2 (caar ref)))
+(cond ((< v1 v2) ; v1 does not appear in the reference list
+		 (gnus-agent-append-to-list tail-uncached v1)
+(setq arts (cdr arts)))
+((= v1 v2)
+(unless (or cached-header (cdar ref)) ; v1 is already cached
+		   (gnus-agent-append-to-list tail-uncached v1))
+(setq arts (cdr arts))
+(setq ref (cdr ref)))
+(t ; reference article (v2) preceeds the list being filtered
+(setq ref (cdr ref))))))
+(while arts
+	(gnus-agent-append-to-list tail-uncached (pop arts)))
+(cdr uncached))
+;; if gnus-agent-load-alist fails, no articles are cached.
+articles))
+(defun gnus-agent-retrieve-headers (articles group &optional fetch-old)
+(save-excursion
+(gnus-agent-create-buffer)
+(let ((gnus-decode-encoded-word-function 'identity)
+	  (file (gnus-agent-article-name ".overview" group))
+	  cached-articles uncached-articles)
+(gnus-make-directory (nnheader-translate-file-chars
+			    (file-name-directory file) t))
+;; Populate temp buffer with known headers
+(when (file-exists-p file)
+	(with-current-buffer gnus-agent-overview-buffer
+	  (erase-buffer)
+	  (let ((nnheader-file-coding-system
+		 gnus-agent-file-coding-system))
+	    (nnheader-insert-nov-file file (car articles)))))
+(if (setq uncached-articles (gnus-agent-uncached-articles articles group
+t))
+	  (progn
+;; Populate nntp-server-buffer with uncached headers
+	    (set-buffer nntp-server-buffer)
+	    (erase-buffer)
+(cond ((not (eq 'nov (let (gnus-agent) ; Turn off agent
+(gnus-retrieve-headers
+uncached-articles group fetch-old))))
+(nnvirtual-convert-headers))
+((eq 'nntp (car gnus-current-select-method))
+;; The author of gnus-get-newsgroup-headers-xover
+;; reports that the XOVER command is commonly
+;; unreliable. The problem is that recently
+;; posted articles may not be entered into the
+;; NOV database in time to respond to my XOVER
+;; query.
+;;
+;; I'm going to use his assumption that the NOV
+;; database is updated in order of ascending
+;; article ID.  Therefore, a response containing
+;; article ID N implies that all articles from 1
+;; to N-1 are up-to-date.  Therefore, missing
+;; articles in that range have expired.
+(set-buffer nntp-server-buffer)
+(let* ((fetched-articles (list nil))
+(tail-fetched-articles fetched-articles)
+(min (cond ((numberp fetch-old)
+(max 1 (- (car articles) fetch-old)))
+(fetch-old
+1)
+(t
+(car articles))))
+(max (car (last articles))))
+;; Get the list of articles that were fetched
+(goto-char (point-min))
+(let ((pm (point-max))
+			   art)
+(while (< (point) pm)
+			 (when (setq art (gnus-agent-read-article-number))
+(gnus-agent-append-to-list tail-fetched-articles art))
+(forward-line 1)))
+;; Clip this list to the headers that will
+;; actually be returned
+(setq fetched-articles (gnus-list-range-intersection
+(cdr fetched-articles)
+(cons min max)))
+;; Clip the uncached articles list to exclude
+;; IDs after the last FETCHED header.  The
+;; excluded IDs may be fetchable using HEAD.
+(if (car tail-fetched-articles)
+(setq uncached-articles
+(gnus-list-range-intersection
+uncached-articles
+(cons (car uncached-articles)
+(car tail-fetched-articles)))))
+;; Create the list of articles that were
+;; "successfully" fetched.  Success, in this
+;; case, means that the ID should not be
+;; fetched again.  In the case of an expired
+;; article, the header will not be fetched.
+(setq uncached-articles
+(gnus-sorted-nunion fetched-articles
+uncached-articles))
+)))
+;; Erase the temp buffer
+	    (set-buffer gnus-agent-overview-buffer)
+	    (erase-buffer)
+;; Copy the nntp-server-buffer to the temp buffer
+	    (set-buffer nntp-server-buffer)
+	    (copy-to-buffer gnus-agent-overview-buffer (point-min) (point-max))
+	    ;; Merge the temp buffer with the known headers (found on
+	    ;; disk in FILE) into the nntp-server-buffer
+	    (when uncached-articles
+	      (gnus-agent-braid-nov group uncached-articles file))
+	    ;; Save the new set of known headers to FILE
+	    (set-buffer nntp-server-buffer)
+	    (let ((coding-system-for-write
+		   gnus-agent-file-coding-system))
+	      (gnus-agent-check-overview-buffer)
+	      (write-region (point-min) (point-max) file nil 'silent))
+;; Update the group's article alist to include the newly
+;; fetched articles.
+	    (gnus-agent-load-alist group)
+	    (gnus-agent-save-alist group uncached-articles nil)
+)
+;; Copy the temp buffer to the nntp-server-buffer
+(set-buffer nntp-server-buffer)
+	(erase-buffer)
+	(insert-buffer-substring gnus-agent-overview-buffer)))
+(if (and fetch-old
+	     (not (numberp fetch-old)))
+	t				; Don't remove anything.
+(nnheader-nov-delete-outside-range
+(if fetch-old (max 1 (- (car articles) fetch-old))
+	 (car articles))
+(car (last articles)))
+t)
+'nov))
+(defun gnus-agent-request-article (article group)
+"Retrieve ARTICLE in GROUP from the agent cache."
+(when (and gnus-agent
+(or gnus-agent-cache
+(not gnus-plugged))
+(numberp article))
+(let* ((gnus-command-method (gnus-find-method-for-group group))
+(file (gnus-agent-article-name (number-to-string article) group))
+(buffer-read-only nil))
+(when (and (file-exists-p file)
+(> (nth 7 (file-attributes file)) 0))
+(erase-buffer)
+(gnus-kill-all-overlays)
+(let ((coding-system-for-read gnus-cache-coding-system))
+(insert-file-contents file))
+t))))
+(defun gnus-agent-regenerate-group (group &optional reread)
+"Regenerate GROUP.
+If REREAD is t, all articles in the .overview are marked as unread.
+If REREAD is a list, the specified articles will be marked as unread.
+In addition, their NOV entries in .overview will be refreshed using
+the articles' current headers.
+If REREAD is not nil, downloaded articles are marked as unread."
+(interactive
+(list (let ((def (or (gnus-group-group-name)
+gnus-newsgroup-name)))
+(let ((select (read-string (if def
+(concat "Group Name ("
+def "): ")
+"Group Name: "))))
+(if (and (equal "" select)
+def)
+def
+select)))
+(catch 'mark
+(while (let (c
+(cursor-in-echo-area t)
+(echo-keystrokes 0))
+(message "Mark as unread: (n)one / (a)ll / all (d)ownloaded articles? (n) ")
+(setq c (read-char-exclusive))
+(cond ((or (eq c ?\r) (eq c ?n) (eq c ?N))
+(throw 'mark nil))
+((or (eq c ?a) (eq c ?A))
+(throw 'mark t))
+((or (eq c ?d) (eq c ?D))
+(throw 'mark 'some)))
+(gnus-message 3 "Ignoring unexpected input")
+(sit-for 1)
+t)))))
+(when group
+(gnus-message 5 "Regenerating in %s" group)
+(let* ((gnus-command-method (or gnus-command-method
+(gnus-find-method-for-group group)))
+(file (gnus-agent-article-name ".overview" group))
+(dir (file-name-directory file))
+point
+(downloaded (if (file-exists-p dir)
+(sort (mapcar (lambda (name) (string-to-number name))
+(directory-files dir nil "^[0-9]+$" t))
+'>)
+(progn (gnus-make-directory dir) nil)))
+dl nov-arts
+alist header
+regenerated)
+(mm-with-unibyte-buffer
+(if (file-exists-p file)
+(let ((nnheader-file-coding-system
+gnus-agent-file-coding-system))
+(nnheader-insert-file-contents file)))
+(set-buffer-modified-p nil)
+;; Load the article IDs found in the overview file.  As a
+;; side-effect, validate the file contents.
+(let ((load t))
+(while load
+(setq load nil)
+(goto-char (point-min))
+(while (< (point) (point-max))
+(cond ((and (looking-at "[0-9]+\t")
+(<= (- (match-end 0) (match-beginning 0)) 9))
+(push (read (current-buffer)) nov-arts)
+(forward-line 1)
+(let ((l1 (car nov-arts))
+(l2 (cadr nov-arts)))
+(cond ((and (listp reread) (memq l1 reread))
+(gnus-delete-line)
+(setq nov-arts (cdr nov-arts))
+(gnus-message 4 "gnus-agent-regenerate-group: NOV\
+entry of article %s deleted." l1))
+((not l2)
+nil)
+((< l1 l2)
+(gnus-message 3 "gnus-agent-regenerate-group: NOV\
+entries are NOT in ascending order.")
+;; Don't sort now as I haven't verified
+;; that every line begins with a number
+(setq load t))
+((= l1 l2)
+(forward-line -1)
+(gnus-message 4 "gnus-agent-regenerate-group: NOV\
+entries contained duplicate of article %s.	 Duplicate deleted." l1)
+(gnus-delete-line)
+(setq nov-arts (cdr nov-arts))))))
+(t
+(gnus-message 1 "gnus-agent-regenerate-group: NOV\
+entries contained line that did not begin with an article number.  Deleted\
+line.")
+(gnus-delete-line))))
+(when load
+		(gnus-message 5 "gnus-agent-regenerate-group: Sorting NOV\
+entries into ascending order.")
+		(sort-numeric-fields 1 (point-min) (point-max))
+		(setq nov-arts nil))))
+(gnus-agent-check-overview-buffer)
+;; Construct a new article alist whose nodes match every header
+;; in the .overview file.  As a side-effect, missing headers are
+;; reconstructed from the downloaded article file.
+(while (or downloaded nov-arts)
+(cond ((and downloaded
+(or (not nov-arts)
+(> (car downloaded) (car nov-arts))))
+;; This entry is missing from the overview file
+(gnus-message 3 "Regenerating NOV %s %d..." group
+(car downloaded))
+(let ((file (concat dir (number-to-string (car downloaded)))))
+(mm-with-unibyte-buffer
+(nnheader-insert-file-contents file)
+(nnheader-remove-body)
+(setq header (nnheader-parse-naked-head)))
+(mail-header-set-number header (car downloaded))
+(if nov-arts
+(let ((key (concat "^" (int-to-string (car nov-arts))
+"\t")))
+(or (re-search-backward key nil t)
+(re-search-forward key))
+(forward-line 1))
+(goto-char (point-min)))
+(nnheader-insert-nov header))
+(setq nov-arts (cons (car downloaded) nov-arts)))
+((eq (car downloaded) (car nov-arts))
+;; This entry in the overview has been downloaded
+(push (cons (car downloaded)
+(time-to-days
+(nth 5 (file-attributes
+(concat dir (number-to-string
+(car downloaded))))))) alist)
+(setq downloaded (cdr downloaded))
+(setq nov-arts (cdr nov-arts)))
+(t
+;; This entry in the overview has not been downloaded
+(push (cons (car nov-arts) nil) alist)
+(setq nov-arts (cdr nov-arts)))))
+;; When gnus-agent-consider-all-articles is set,
+;; gnus-agent-regenerate-group should NOT remove article IDs from
+;; the alist.  Those IDs serve as markers to indicate that an
+;; attempt has been made to fetch that article's header.
+;; When gnus-agent-consider-all-articles is NOT set,
+;; gnus-agent-regenerate-group can remove the article ID of every
+;; article (with the exception of the last ID in the list - it's
+;; special) that no longer appears in the overview.  In this
+;; situtation, the last article ID in the list implies that it,
+;; and every article ID preceeding it, have been fetched from the
+;; server.
+(if gnus-agent-consider-all-articles
+;; Restore all article IDs that were not found in the overview file.
+(let* ((n (cons nil alist))
+(merged n)
+(o (gnus-agent-load-alist group)))
+(while o
+(let ((nID (caadr n))
+(oID (caar o)))
+(cond ((not nID)
+(setq n (setcdr n (list (list oID))))
+(setq o (cdr o)))
+((< oID nID)
+(setcdr n (cons (list oID) (cdr n)))
+(setq o (cdr o)))
+((= oID nID)
+(setq o (cdr o))
+(setq n (cdr n)))
+(t
+(setq n (cdr n))))))
+(setq alist (cdr merged)))
+;; Restore the last article ID if it is not already in the new alist
+(let ((n (last alist))
+(o (last (gnus-agent-load-alist group))))
+(cond ((not o)
+nil)
+((not n)
+(push (cons (caar o) nil) alist))
+((< (caar n) (caar o))
+(setcdr n (list (car o)))))))
+(let ((inhibit-quit t))
+(if (setq regenerated (buffer-modified-p))
+(let ((coding-system-for-write gnus-agent-file-coding-system))
+(write-region (point-min) (point-max) file nil 'silent)))
+(setq regenerated (or regenerated
+(and reread gnus-agent-article-alist)
+(not (equal alist gnus-agent-article-alist))))
+(setq gnus-agent-article-alist alist)
+(when regenerated
+(gnus-agent-save-alist group)
+;; I have to alter the group's active range NOW as
+;; gnus-make-ascending-articles-unread will use it to
+;; recalculate the number of unread articles in the group
+(let ((group (gnus-group-real-name group))
+(group-active (or (gnus-active group)
+(gnus-activate-group group))))
+(gnus-agent-possibly-alter-active group group-active)))))
+(when (and reread gnus-agent-article-alist)
+	(gnus-agent-synchronize-group-flags
+group
+	 (list (list
+(if (listp reread)
+reread
+(delq nil (mapcar (function (lambda (c)
+(cond ((eq reread t)
+(car c))
+((cdr c)
+(car c)))))
+				    gnus-agent-article-alist)))
+		'del '(read)))
+	 gnus-command-method)
+(when (gnus-buffer-live-p gnus-group-buffer)
+(gnus-group-update-group group t)))
+(gnus-message 5 "")
+regenerated)))
+;;;###autoload
+(defun gnus-agent-regenerate (&optional clean reread)
+"Regenerate all agent covered files.
+If CLEAN, obsolete (ignore)."
+(interactive "P")
+(let (regenerated)
+(gnus-message 4 "Regenerating Gnus agent files...")
+(dolist (gnus-command-method (gnus-agent-covered-methods))
+(dolist (group (gnus-groups-from-server gnus-command-method))
+(setq regenerated (or (gnus-agent-regenerate-group group reread)
+regenerated))))
+(gnus-message 4 "Regenerating Gnus agent files...done")
+regenerated))
+(defun gnus-agent-go-online (&optional force)
+"Switch servers into online status."
+(interactive (list t))
+(dolist (server gnus-opened-servers)
+(when (eq (nth 1 server) 'offline)
+(if (if (eq force 'ask)
+	      (gnus-y-or-n-p
+	       (format "Switch %s:%s into online status? "
+		       (caar server) (cadar server)))
+	    force)
+	  (setcar (nthcdr 1 server) 'close)))))
+(defun gnus-agent-toggle-group-plugged (group)
+"Toggle the status of the server of the current group."
+(interactive (list (gnus-group-group-name)))
+(let* ((method (gnus-find-method-for-group group))
+	 (status (cadr (assoc method gnus-opened-servers))))
+(if (eq status 'offline)
+	(gnus-server-set-status method 'closed)
+(gnus-close-server method)
+(gnus-server-set-status method 'offline))
+(message "Turn %s:%s from %s to %s." (car method) (cadr method)
+	     (if (eq status 'offline) 'offline 'online)
+	     (if (eq status 'offline) 'online 'offline))))
+(defun gnus-agent-group-covered-p (group)
+(gnus-agent-method-p (gnus-group-method group)))
 (provide 'gnus-agent)
+;;; arch-tag: b0ba4afc-5229-4cee-ad25-9956daa4e91e
 ;;; gnus-agent.el ends here

Mercurial > emacs

comparison lisp/gnus/gnus-agent.el @ 88155:d7ddb3e565de