X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-agent.el;h=fc75586ccd80d0a17fea48e0f6ef5b1087b61c11;hb=0814c236bf5b827fd046819bbd6ad591986c9caf;hp=26222119b984073aa67eda0cd1cc71e7df9bceed;hpb=5b4714867e19c949481adb3fa8cd532d7f63b9c2;p=gnus diff --git a/lisp/gnus-agent.el b/lisp/gnus-agent.el index 26222119b..fc75586cc 100644 --- a/lisp/gnus-agent.el +++ b/lisp/gnus-agent.el @@ -1,6 +1,6 @@ ;;; gnus-agent.el --- unplugged support for Gnus -;; Copyright (C) 1997-2011 Free Software Foundation, Inc. +;; Copyright (C) 1997-2015 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; This file is part of GNU Emacs. @@ -186,7 +186,7 @@ When found, offer to remove them." (defcustom gnus-agent-auto-agentize-methods nil "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'." +See Info nodes `(gnus)Server Buffer', `(gnus)Agent Variables'." :version "22.1" :type '(repeat symbol) :group 'gnus-agent) @@ -242,7 +242,6 @@ NOTES: (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) (defvar gnus-agent-total-fetched-hashtb nil) @@ -355,23 +354,11 @@ 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 - ))))) + (list 'cdr (list 'assq '',prop-name category))) + + (defsetf ,name (category) (value) + (list 'gnus-agent-cat-set-property + category '',prop-name value)))) ) (defmacro gnus-agent-cat-name (category) @@ -399,22 +386,10 @@ manipulated as follows: 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--)))) - ) +;; This form may expand to code that uses CL functions at run-time, +;; but that's OK since those functions will only ever be called from +;; something like `setf', so only when CL is loaded anyway. +(defsetf gnus-agent-cat-groups gnus-agent-set-cat-groups) (defun gnus-agent-set-cat-groups (category groups) (unless (eq groups 'ignore) @@ -517,7 +492,7 @@ manipulated as follows: (push (cons mode (symbol-value (intern (format "gnus-agent-%s-mode-map" buffer)))) minor-mode-map-alist)) - (when (eq major-mode 'gnus-group-mode) + (when (derived-mode-p 'gnus-group-mode) (let ((init-plugged gnus-plugged) (gnus-agent-go-online nil)) ;; g-a-t-p does nothing when gnus-plugged isn't changed. @@ -602,7 +577,7 @@ manipulated as follows: (make-mode-line-mouse-map mouse-button mouse-func) 'mouse-face (if (and (featurep 'xemacs) - ;; XEmacs' `facep' only checks for a face + ;; XEmacs's `facep' only checks for a face ;; object, not for a face name, so it's useless ;; to check with `facep'. (find-face 'modeline)) @@ -683,11 +658,7 @@ This will modify the `gnus-setup-news-hook', and minor mode in all Gnus buffers." (interactive) (gnus-open-agent) - (unless gnus-agent-send-mail-function - (setq gnus-agent-send-mail-function - (or message-send-mail-real-function - (function (lambda () (funcall message-send-mail-function)))) - message-send-mail-real-function 'gnus-agent-send-mail)) + (setq message-send-mail-real-function 'gnus-agent-send-mail) ;; If the servers file doesn't exist, auto-agentize some servers and ;; save the servers file so this auto-agentizing isn't invoked @@ -723,7 +694,7 @@ Optional arg GROUP-NAME allows to specify another group." (defun gnus-agent-send-mail () (if (or (not gnus-agent-queue-mail) (and gnus-plugged (not (eq gnus-agent-queue-mail 'always)))) - (funcall gnus-agent-send-mail-function) + (message-multi-smtp-send-mail) (goto-char (point-min)) (re-search-forward (concat "^" (regexp-quote mail-header-separator) "\n")) @@ -897,8 +868,9 @@ be a select method." (not (eq gnus-agent-synchronize-flags 'ask))) (and (eq gnus-agent-synchronize-flags 'ask) (gnus-y-or-n-p - (format "Synchronize flags on server `%s'? " - (cadr method)))))) + (gnus-format-message + "Synchronize flags on server `%s'? " + (cadr method)))))) (gnus-agent-synchronize-flags-server method))) ;;;###autoload @@ -910,11 +882,11 @@ 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) + (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) + (let ((gnus-command-method new-command-method)) (gnus-agent-group-pathname new-group)))) (file-name-coding-system nnmail-pathname-coding-system)) (gnus-rename-file old-path new-path t) @@ -943,19 +915,18 @@ 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) + (let ((gnus-command-method command-method)) (gnus-agent-group-pathname group)))) (file-name-coding-system nnmail-pathname-coding-system)) (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))))) + ;; FIXME: Does gnus-agent-get-local have any useful side-effect? + (gnus-agent-get-local group real-group command-method) + (gnus-agent-set-local group + nil nil + real-group command-method)))) ;;; ;;; Server mode commands @@ -1130,7 +1101,7 @@ article's mark is toggled." (setq alist (cdr alist))) ((> a h) ;; Headers that are not in the alist should be - ;; fictious (see nnagent-retrieve-headers); they + ;; fictitious (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) @@ -1181,6 +1152,7 @@ downloadable." (gnus-summary-position-point))) (defun gnus-agent-summary-fetch-series () + "Fetch the process-marked articles into the Agent." (interactive) (when gnus-newsgroup-processable (setq gnus-newsgroup-downloadable @@ -1228,8 +1200,9 @@ Optional arg ALL, if non-nil, means to fetch all articles." (cond (gnus-agent-mark-unread-after-downloaded (setq gnus-newsgroup-downloadable (delq article gnus-newsgroup-downloadable)) - - (gnus-summary-mark-article article gnus-unread-mark)) + (when (and (not (member article gnus-newsgroup-dormant)) + (not (member article gnus-newsgroup-marked))) + (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) @@ -1302,12 +1275,18 @@ This can be added to `gnus-select-article-hook' or (gnus-group-update-group group t))) nil)) -(defun gnus-agent-save-active (method) +(defun gnus-agent-save-active (method &optional groups-p) + "Sync the agent's active file with the current buffer. +Pass non-nil for GROUPS-P if the buffer starts out in groups format. +Regardless, both the file and the buffer end up in active format +if METHOD is agentized; otherwise the function is a no-op." (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"))) - (gnus-active-to-gnus-format nil new) + (if groups-p + (gnus-groups-to-gnus-format nil new) + (gnus-active-to-gnus-format nil new)) (gnus-agent-write-active file new) (erase-buffer) (let ((nnheader-file-coding-system gnus-agent-file-coding-system)) @@ -1368,7 +1347,7 @@ downloaded into the agent." ;; 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. + ;; encompass the new active range. (gnus-agent-set-local group agent-min (1- active-min))))))) (defun gnus-agent-save-group-info (method group active) @@ -1510,7 +1489,8 @@ downloaded into the agent." (defun gnus-agent-fetch-articles (group articles) "Fetch ARTICLES from GROUP and put them into the Agent." - (when articles + (when (and articles + (gnus-online (gnus-group-method group))) (gnus-agent-load-alist group) (let* ((alist gnus-agent-article-alist) (headers (if (< (length articles) 2) nil gnus-newsgroup-headers)) @@ -1569,7 +1549,7 @@ downloaded into the agent." (dir (gnus-agent-group-pathname group)) (date (time-to-days (current-time))) (case-fold-search t) - pos crosses id + pos crosses (file-name-coding-system nnmail-pathname-coding-system)) (setcar selected-sets (nreverse (car selected-sets))) @@ -1623,11 +1603,6 @@ downloaded into the agent." (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) @@ -1747,7 +1722,7 @@ and that there are no duplicates." (or backed-up (setq backed-up (gnus-agent-backup-overview-buffer))) (gnus-message 1 - "Overview buffer contains garbage '%s'." + "Overview buffer contains garbage `%s'." (buffer-substring p (point-at-eol)))) ((= cur prev-num) @@ -1852,7 +1827,7 @@ variables. Returns the first non-nil value found." . gnus-agent-enable-expiration) (agent-predicate . gnus-agent-predicate))))))) -(defun gnus-agent-fetch-headers (group &optional force) +(defun gnus-agent-fetch-headers (group) "Fetch interesting headers into the agent. The group's overview file will be updated to include the headers while a list of available article numbers will be returned." @@ -1927,13 +1902,13 @@ article numbers will be returned." (when articles (gnus-message - 10 "gnus-agent-fetch-headers: undownloaded articles are '%s'" + 10 "gnus-agent-fetch-headers: undownloaded articles are `%s'" (gnus-compress-sequence articles t))) (with-current-buffer nntp-server-buffer (if articles (progn - (gnus-message 7 "Fetching headers for %s..." + (gnus-message 8 "Fetching headers for %s..." (gnus-agent-decoded-group-name group)) ;; Fetch them. @@ -1951,7 +1926,7 @@ article numbers will be returned." ;; 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) + (gnus-agent-braid-nov articles file) (let ((coding-system-for-write gnus-agent-file-coding-system)) (gnus-agent-check-overview-buffer) @@ -2000,7 +1975,7 @@ article numbers will be returned." (set-buffer nntp-server-buffer) (insert-buffer-substring gnus-agent-overview-buffer b e)))) -(defun gnus-agent-braid-nov (group articles file) +(defun gnus-agent-braid-nov (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 @@ -2174,7 +2149,7 @@ doesn't exist, to valid the overview buffer." (let* ((file-name-coding-system nnmail-pathname-coding-system) (prev (cons nil gnus-agent-article-alist)) (all prev) - print-level print-length item article) + print-level print-length article) (while (setq article (pop articles)) (while (and (cdr prev) (< (caadr prev) article)) @@ -2229,7 +2204,10 @@ doesn't exist, to valid the overview buffer." article counts for each of the method's subscribed groups." (let ((gnus-command-method (or method gnus-command-method))) (when (or (null gnus-agent-article-local-times) - (zerop gnus-agent-article-local-times)) + (zerop gnus-agent-article-local-times) + (not (gnus-methods-equal-p + gnus-command-method + (symbol-value (intern "+method" gnus-agent-article-local))))) (setq gnus-agent-article-local (gnus-cache-file-contents (gnus-agent-lib-file "local") @@ -2305,7 +2283,7 @@ modified) original contents, they are first saved to their own file." (file-name-coding-system nnmail-pathname-coding-system)) (with-temp-file dest (let ((gnus-command-method (symbol-value (intern "+method" my-obarray))) - print-level print-length item article + print-level print-length (standard-output (current-buffer))) (mapatoms (lambda (symbol) (cond ((not (boundp symbol)) @@ -2428,6 +2406,18 @@ modified) original contents, they are first saved to their own file." (gnus-run-hooks 'gnus-agent-fetched-hook) (gnus-message 6 "Finished fetching articles into the Gnus agent")))) +(defvar gnus-agent-short-article 500 + "Articles that have fewer lines than this are short.") + +(defvar gnus-agent-long-article 1000 + "Articles that have more lines than this are long.") + +(defvar gnus-agent-low-score 0 + "Articles that have a score lower than this have a low score.") + +(defvar gnus-agent-high-score 0 + "Articles that have a score higher than this have a high score.") + (defun gnus-agent-fetch-group-1 (group method) "Fetch GROUP." (let ((gnus-command-method method) @@ -2444,8 +2434,8 @@ modified) original contents, they are first saved to their own file." gnus-headers gnus-score - articles arts - category predicate info marks score-param + articles + predicate info marks ) (unless (gnus-check-group group) (error "Can't open server for %s" group)) @@ -2488,9 +2478,6 @@ modified) original contents, they are first saved to their own file." ;; timeout reason. If so, recreate it. (gnus-agent-create-buffer) - ;; Figure out how to select articles in this group - (setq category (gnus-group-category group)) - (setq predicate (gnus-get-predicate (gnus-agent-find-parameter group 'agent-predicate))) @@ -2641,23 +2628,14 @@ General format specifiers can also be used. See Info node (defvar gnus-agent-predicate 'false "The selection predicate used when no other source is available.") -(defvar gnus-agent-short-article 500 - "Articles that have fewer lines than this are short.") - -(defvar gnus-agent-long-article 1000 - "Articles that have more lines than this are long.") - -(defvar gnus-agent-low-score 0 - "Articles that have a score lower than this have a low score.") - -(defvar gnus-agent-high-score 0 - "Articles that have a score higher than this have a high score.") - ;;; Internal variables. (defvar gnus-category-buffer "*Agent Category*") +(defvar gnus-tmp-name) +(defvar gnus-tmp-groups) + (defvar gnus-category-line-format-alist `((?c gnus-tmp-name ?s) (?g gnus-tmp-groups ?d))) @@ -2709,7 +2687,7 @@ General format specifiers can also be used. See Info node (gnus-run-hooks 'gnus-category-menu-hook))) -(defun gnus-category-mode () +(define-derived-mode gnus-category-mode fundamental-mode "Category" "Major mode for listing and editing agent categories. All normal editing commands are switched off. @@ -2720,20 +2698,14 @@ For more in-depth information on this mode, read the manual The following commands are available: \\{gnus-category-mode-map}" - (interactive) (when (gnus-visual-p 'category-menu 'menu) (gnus-category-make-menu-bar)) - (kill-all-local-variables) (gnus-simplify-mode-line) - (setq major-mode 'gnus-category-mode) - (setq mode-name "Category") (gnus-set-default-directory) (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-mode-hooks 'gnus-category-mode-hook)) + (setq buffer-read-only t)) (defalias 'gnus-category-position-point 'gnus-goto-colon) @@ -3009,9 +2981,7 @@ The following commands are available: "Return the function implementing PREDICATE." (or (cdr (assoc predicate gnus-category-predicate-cache)) (let ((func (gnus-category-make-function predicate))) - (setq gnus-category-predicate-cache - (nconc gnus-category-predicate-cache - (list (cons predicate func)))) + (push (cons predicate func) gnus-category-predicate-cache) func))) (defun gnus-predicate-implies-unread (predicate) @@ -3083,6 +3053,9 @@ articles." (or (gnus-gethash group gnus-category-group-cache) (assq 'default gnus-category-alist))) +(defvar gnus-agent-expire-current-dirs) +(defvar gnus-agent-expire-stats) + (defun gnus-agent-expire-group (group &optional articles force) "Expire all old articles in GROUP. If you want to force expiring of certain articles, this function can @@ -3097,7 +3070,7 @@ FORCE is equivalent to setting the expiration predicates to true." (if (not group) (gnus-agent-expire articles group force) - (let ( ;; Bind gnus-agent-expire-stats to enable tracking of + (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)) @@ -3134,9 +3107,7 @@ FORCE is equivalent to setting the expiration predicates to true." (gnus-agent-with-refreshed-group group (when (boundp 'gnus-agent-expire-current-dirs) - (set 'gnus-agent-expire-current-dirs - (cons dir - (symbol-value 'gnus-agent-expire-current-dirs)))) + (push dir gnus-agent-expire-current-dirs)) (if (and (not force) (eq 'DISABLE (gnus-agent-find-parameter group @@ -3232,7 +3203,7 @@ FORCE is equivalent to setting the expiration predicates to true." ;; 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 + ;; These statements are sorted by ascending precedence of the ;; keep_flag. (setq dlist (nconc dlist (mapcar (lambda (e) @@ -3280,24 +3251,24 @@ line." (point) nov-file))) ;; 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)))))))) + (setq dlist + (sort dlist + (lambda (a b) + (cond ((< (nth 0 a) (nth 0 b)) + t) + ((> (nth 0 a) (nth 0 b)) + nil) + (t + ;; If two entries have the same article-number + ;; then sort by ascending keep_flag. + (let* ((kf-score '((special . 0) + (marked . 1) + (unread . 2))) + (a (or (cdr (assq (nth 2 a) kf-score)) + 3)) + (b (or (cdr (assq (nth 2 b) kf-score)) + 3))) + (<= a b))))))) (gnus-message 7 "gnus-agent-expire: Sorting entries... Done") (gnus-message 7 "gnus-agent-expire: Merging entries... ") (let ((dlist dlist)) @@ -3491,7 +3462,7 @@ expiration tests failed." decoded article-number) (gnus-summary-update-info)))) (when (boundp 'gnus-agent-expire-stats) - (let ((stats (symbol-value 'gnus-agent-expire-stats))) + (let ((stats gnus-agent-expire-stats)) (incf (nth 2 stats) bytes-freed) (incf (nth 1 stats) files-deleted) (incf (nth 0 stats) nov-entries-deleted))) @@ -3551,7 +3522,7 @@ articles in every agentized group? ")) (defun gnus-agent-expire-done-message () (if (and (> gnus-verbose 4) (boundp 'gnus-agent-expire-stats)) - (let* ((stats (symbol-value 'gnus-agent-expire-stats)) + (let* ((stats gnus-agent-expire-stats) (size (nth 2 stats)) (units '(B KB MB GB))) (while (and (> size 1024.0) @@ -3570,16 +3541,10 @@ articles in every agentized group? ")) (when (and gnus-agent-expire-unagentized-dirs (boundp 'gnus-agent-expire-current-dirs)) (let* ((keep (gnus-make-hashtable)) - ;; Formally bind gnus-agent-expire-current-dirs so that the - ;; compiler will not complain about free references. - (gnus-agent-expire-current-dirs - (symbol-value 'gnus-agent-expire-current-dirs)) - dir (file-name-coding-system nnmail-pathname-coding-system)) (gnus-sethash gnus-agent-directory t keep) - (while gnus-agent-expire-current-dirs - (setq dir (pop gnus-agent-expire-current-dirs)) + (dolist (dir gnus-agent-expire-current-dirs) (when (and (stringp dir) (file-directory-p dir)) (while (not (gnus-gethash dir keep)) @@ -3613,7 +3578,7 @@ articles in every agentized group? ")) (setq r d d (directory-file-name d))) ;; if ANY ancestor was NOT in keep hash and - ;; it it's already in to-remove, add it to + ;; it's not already in to-remove, add it to ;; to-remove. (if (and r (not (member r to-remove))) @@ -3732,11 +3697,18 @@ has been fetched." (let ((gnus-decode-encoded-word-function 'identity) (gnus-decode-encoded-address-function 'identity) (file (gnus-agent-article-name ".overview" group)) - cached-articles uncached-articles + uncached-articles (file-name-coding-system nnmail-pathname-coding-system)) (gnus-make-directory (nnheader-translate-file-chars (file-name-directory file) t)) + (when fetch-old + (setq articles (gnus-uncompress-range + (cons (if (numberp fetch-old) + (max 1 (- (car articles) fetch-old)) + 1) + (car (last articles)))))) + ;; Populate temp buffer with known headers (when (file-exists-p file) (with-current-buffer gnus-agent-overview-buffer @@ -3773,12 +3745,7 @@ has been fetched." (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)))) + (min (car articles)) (max (car (last articles)))) ;; Get the list of articles that were fetched @@ -3827,7 +3794,7 @@ has been fetched." ;; 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)) + (gnus-agent-braid-nov uncached-articles file)) ;; Save the new set of known headers to FILE (set-buffer nntp-server-buffer) @@ -3853,8 +3820,7 @@ has been fetched." (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 articles) (car (last articles))) t) @@ -3885,7 +3851,12 @@ has been fetched." (coding-system-for-write gnus-cache-coding-system)) (when (not (file-exists-p file)) (gnus-make-directory (file-name-directory file)) - (write-region (point-min) (point-max) file nil 'silent)))) + (write-region (point-min) (point-max) file nil 'silent) + ;; Tell the Agent when the article was fetched, so that it can + ;; be expired later. + (gnus-agent-load-alist group) + (gnus-agent-save-alist group (list article) + (time-to-days (current-time)))))) (defun gnus-agent-regenerate-group (group &optional reread) "Regenerate GROUP. @@ -3918,7 +3889,6 @@ If REREAD is not nil, downloaded articles are marked as unread." (gnus-find-method-for-group group))) (file (gnus-agent-article-name ".overview" group)) (dir (file-name-directory file)) - point (file-name-coding-system nnmail-pathname-coding-system) (downloaded (if (file-exists-p dir) (sort (delq nil (mapcar (lambda (name) @@ -3927,7 +3897,7 @@ If REREAD is not nil, downloaded articles are marked as unread." (directory-files dir nil "^[0-9]+$" t))) '>) (progn (gnus-make-directory dir) nil))) - dl nov-arts + nov-arts alist header regenerated) @@ -4031,7 +4001,7 @@ If REREAD is not nil, downloaded articles are marked as unread." ;; 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, + ;; situation, the last article ID in the list implies that it, ;; and every article ID preceding it, have been fetched from the ;; server. @@ -4110,16 +4080,16 @@ If REREAD is not nil, downloaded articles are marked as unread." regenerated))) ;;;###autoload -(defun gnus-agent-regenerate (&optional clean reread) +(defun gnus-agent-regenerate (&optional _clean reread) "Regenerate all agent covered files. -If CLEAN, obsolete (ignore)." - (interactive "P") +CLEAN is obsolete and ignored." + (interactive) (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)))) + (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)) @@ -4152,8 +4122,8 @@ If CLEAN, obsolete (ignore)." (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) +(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 @@ -4166,27 +4136,29 @@ agent has fetched." (gnus-sethash path (make-list 3 0) gnus-agent-total-fetched-hashtb))) (file-name-coding-system nnmail-pathname-coding-system)) - (when (listp delta) - (if delta - (let ((sum 0.0) + (when (file-exists-p path) + (when (listp delta) + (if delta + (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)) + (let ((sum (- (nth 2 entry))) + (info (directory-files-and-attributes + path nil "^-?[0-9]+$" t)) 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)) - (let ((sum (- (nth 2 entry))) - (info (directory-files-and-attributes path nil "^-?[0-9]+$" t)) - file) - (while (setq file (pop info)) - (incf sum (float (or (nth 8 file) 0)))) - (setq delta sum)))) + (while (setq file (pop info)) + (incf sum (float (or (nth 8 file) 0)))) + (setq delta sum)))) - (setq gnus-agent-need-update-total-fetched-for t) - (incf (nth 2 entry) delta))))) + (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)