+ (let ((gnus-agent-confirmation-function 'gnus-agent-batch-confirmation))
+ (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 thos 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)))
+ (while (< (point) pm)
+ (when (looking-at "[0-9]+\t")
+ (gnus-agent-append-to-list
+ tail-fetched-articles
+ (read (current-buffer))))
+ (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 (and uncached-articles (file-exists-p file))
+ (gnus-agent-braid-nov group uncached-articles file))
+
+ ;; Save the new set of known headers to FILE
+ (set-buffer nntp-server-buffer)
+ (gnus-agent-check-overview-buffer)
+ (write-region-as-coding-system
+ gnus-agent-file-coding-system
+ (point-min) (point-max) file nil 'silent)
+
+ (gnus-agent-update-view-total-fetched-for group t)
+
+ ;; 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)
+ (insert-file-contents-as-coding-system gnus-cache-coding-system 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-int 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))
+ (write-region-as-coding-system
+ gnus-agent-file-coding-system
+ (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-make-ascending-articles-unread
+ group
+ (if (listp reread)
+ reread
+ (delq nil (mapcar (function (lambda (c)
+ (cond ((eq reread t)
+ (car c))
+ ((cdr c)
+ (car c)))))
+ gnus-agent-article-alist))))
+
+ (when regenerated
+ (gnus-agent-update-files-total-fetched-for group nil)))
+
+ (gnus-message 5 nil)
+ 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)))
+
+(defun gnus-agent-update-files-total-fetched-for
+ (group delta &optional method path)
+ "Update, or set, the total disk space used by the articles that the
+agent has fetched."
+ (when gnus-agent-total-fetched-hashtb
+ (gnus-agent-with-refreshed-group
+ group
+ ;; if null, gnus-agent-group-pathname will calc method.
+ (let* ((gnus-command-method method)
+ (path (or path (gnus-agent-group-pathname group)))
+ (entry (or (gnus-gethash path gnus-agent-total-fetched-hashtb)
+ (gnus-sethash path (make-list 3 0)
+ gnus-agent-total-fetched-hashtb))))
+ (when (listp delta)
+ (unless delta
+ (setq delta (directory-files path nil "^-?[0-9]+$" t)))
+
+ (let ((sum 0.0)
+ file)
+ (while (setq file (pop delta))
+ (incf sum (float (or (nth 7 (file-attributes
+ (nnheader-concat
+ path
+ (if (numberp file)
+ (number-to-string file)
+ file)))) 0))))
+ (setq delta sum)))
+
+ (setq gnus-agent-need-update-total-fetched-for t)
+ (incf (nth 2 entry) delta)))))
+
+(defun gnus-agent-update-view-total-fetched-for
+ (group agent-over &optional method path)
+ "Update, or set, the total disk space used by the .agentview and
+.overview files. These files are calculated separately as they can be
+modified."
+ (when gnus-agent-total-fetched-hashtb
+ (gnus-agent-with-refreshed-group
+ group
+ ;; if null, gnus-agent-group-pathname will calc method.
+ (let* ((gnus-command-method method)
+ (path (or path (gnus-agent-group-pathname group)))
+ (entry (or (gnus-gethash path gnus-agent-total-fetched-hashtb)
+ (gnus-sethash path (make-list 3 0)
+ gnus-agent-total-fetched-hashtb)))
+ (size (or (nth 7 (file-attributes
+ (nnheader-concat
+ path (if agent-over
+ ".overview"
+ ".agentview"))))
+ 0)))
+ (setq gnus-agent-need-update-total-fetched-for t)
+ (setf (nth (if agent-over 1 0) entry) size)))))
+
+(defun gnus-agent-total-fetched-for (group &optional method no-inhibit)
+ "Get the total disk space used by the specified GROUP."
+ (unless gnus-agent-total-fetched-hashtb
+ (setq gnus-agent-total-fetched-hashtb (gnus-make-hashtable 1024)))
+
+ ;; if null, gnus-agent-group-pathname will calc method.
+ (let* ((gnus-command-method method)
+ (path (gnus-agent-group-pathname group))
+ (entry (gnus-gethash path gnus-agent-total-fetched-hashtb)))
+ (if entry
+ (apply '+ entry)
+ (let ((gnus-agent-inhibit-update-total-fetched-for (not no-inhibit)))
+ (+
+ (gnus-agent-update-view-total-fetched-for group nil method path)
+ (gnus-agent-update-view-total-fetched-for group t method path)
+ (gnus-agent-update-files-total-fetched-for group nil method path))))))