X-Git-Url: http://git.chise.org/gitweb/?p=elisp%2Fgnus.git-;a=blobdiff_plain;f=lisp%2Fgnus-agent.el;h=cf6b1bd59f20814ebe30f9bd939872a8fe8af936;hp=aaa700be635b64d469119a1a8e2655676611105d;hb=cda270b73d89201b8072b013dfde919798b168d6;hpb=f487225f56bb13abb2f7f286b97b968c76511733 diff --git a/lisp/gnus-agent.el b/lisp/gnus-agent.el index aaa700b..cf6b1bd 100644 --- a/lisp/gnus-agent.el +++ b/lisp/gnus-agent.el @@ -27,7 +27,8 @@ (require 'gnus-cache) (require 'nnvirtual) (require 'gnus-sum) -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl) + (require 'gnus-score)) (defcustom gnus-agent-directory (nnheader-concat gnus-directory "agent/") "Where the Gnus agent will store its files." @@ -77,8 +78,6 @@ If nil, only read articles will be expired." ;;; Internal variables -(defvar gnus-agent-meta-information-header "X-Gnus-Agent-Meta-Information") - (defvar gnus-agent-history-buffers nil) (defvar gnus-agent-buffer-alist nil) (defvar gnus-agent-article-alist nil) @@ -94,6 +93,13 @@ If nil, only read articles will be expired." (defvar gnus-agent-send-mail-function nil) (defvar gnus-agent-article-file-coding-system 'no-conversion) +(defconst gnus-agent-scoreable-headers + (list + "subject" "from" "date" "message-id" + "references" "chars" "lines" "xref") + "Headers that are considered when scoring articles +for download via the Agent.") + ;; Dynamic variables (defvar gnus-headers) (defvar gnus-score) @@ -127,7 +133,7 @@ If nil, only read articles will be expired." (defun gnus-agent-read-file (file) "Load FILE and do a `read' there." - (nnheader-temp-write nil + (with-temp-buffer (ignore-errors (nnheader-insert-file-contents file) (goto-char (point-min)) @@ -427,7 +433,7 @@ be a select method." (defun gnus-agent-write-servers () "Write the alist of covered servers." - (nnheader-temp-write (nnheader-concat gnus-agent-directory "lib/servers") + (with-temp-file (nnheader-concat gnus-agent-directory "lib/servers") (prin1 gnus-agent-covered-methods (current-buffer)))) ;;; @@ -537,7 +543,7 @@ the actual number of articles toggled is returned." (gnus-agent-lib-file "active") (gnus-agent-lib-file "groups")))) (gnus-make-directory (file-name-directory file)) - (nnheader-temp-write file + (with-temp-file file (when (file-exists-p file) (nnheader-insert-file-contents file)) (goto-char (point-min)) @@ -654,7 +660,7 @@ the actual number of articles toggled is returned." (let ((dir (concat (gnus-agent-directory) (gnus-agent-group-path group) "/")) - (date (gnus-time-to-day (current-time))) + (date (time-to-day (current-time))) (case-fold-search t) pos crosses id elem) (gnus-make-directory dir) @@ -662,7 +668,7 @@ the actual number of articles toggled is returned." ;; Fetch the articles from the backend. (if (gnus-check-backend-function 'retrieve-articles group) (setq pos (gnus-retrieve-articles articles group)) - (nnheader-temp-write nil + (with-temp-file nil (let (article) (while (setq article (pop articles)) (when (gnus-request-article article group) @@ -745,41 +751,41 @@ the actual number of articles toggled is returned." nil 'silent) (pop gnus-agent-buffer-alist)) (while gnus-agent-group-alist - (nnheader-temp-write (caar gnus-agent-group-alist) + (with-temp-file (caar gnus-agent-group-alist) (princ (cdar gnus-agent-group-alist)) (insert "\n")) (pop gnus-agent-group-alist)))) (defun gnus-agent-fetch-headers (group &optional force) (let ((articles (if (gnus-agent-load-alist group) - (gnus-sorted-intersection - (gnus-list-of-unread-articles group) - (gnus-uncompress-range - (cons (1+ (caar (last gnus-agent-article-alist))) - (cdr (gnus-active group))))) - (gnus-list-of-unread-articles group)))) + (gnus-sorted-intersection + (gnus-list-of-unread-articles group) + (gnus-uncompress-range + (cons (1+ (caar (last gnus-agent-article-alist))) + (cdr (gnus-active group))))) + (gnus-list-of-unread-articles group)))) ;; Fetch them. (when articles (gnus-message 7 "Fetching headers for %s..." group) (save-excursion - (set-buffer nntp-server-buffer) - (unless (eq 'nov (gnus-retrieve-headers articles group)) - (nnvirtual-convert-headers)) - ;; Save these headers for later processing. - (copy-to-buffer gnus-agent-overview-buffer (point-min) (point-max)) - (let (file) - (when (file-exists-p - (setq file (gnus-agent-article-name ".overview" group))) - (gnus-agent-braid-nov group articles file)) - (gnus-make-directory (nnheader-translate-file-chars - (file-name-directory file))) - (write-region (point-min) (point-max) file nil 'silent) - (gnus-agent-save-alist group articles nil) - (gnus-agent-enter-history - "last-header-fetched-for-session" - (list (cons group (nth (- (length articles) 1) articles))) - (gnus-time-to-day (current-time))) - articles))))) + (set-buffer nntp-server-buffer) + (unless (eq 'nov (gnus-retrieve-headers articles group)) + (nnvirtual-convert-headers)) + ;; Save these headers for later processing. + (copy-to-buffer gnus-agent-overview-buffer (point-min) (point-max)) + (let (file) + (when (file-exists-p + (setq file (gnus-agent-article-name ".overview" group))) + (gnus-agent-braid-nov group articles file)) + (gnus-make-directory (nnheader-translate-file-chars + (file-name-directory file))) + (write-region (point-min) (point-max) file nil 'silent) + (gnus-agent-save-alist group articles nil) + (gnus-agent-enter-history + "last-header-fetched-for-session" + (list (cons group (nth (- (length articles) 1) articles))) + (time-to-day (current-time))) + articles))))) (defsubst gnus-agent-copy-nov-line (article) (let (b e) @@ -840,9 +846,9 @@ the actual number of articles toggled is returned." (defun gnus-agent-save-alist (group &optional articles state dir) "Save the article-state alist for GROUP." - (nnheader-temp-write (if dir - (concat dir ".agentview") - (gnus-agent-article-name ".agentview" group)) + (with-temp-file (if dir + (concat dir ".agentview") + (gnus-agent-article-name ".agentview" group)) (princ (setq gnus-agent-article-alist (nconc gnus-agent-article-alist (mapcar (lambda (article) (cons article state)) @@ -897,27 +903,63 @@ the actual number of articles toggled is returned." ;; Parse them and see which articles we want to fetch. (setq gnus-newsgroup-dependencies (make-vector (length articles) 0)) - (setq gnus-newsgroup-headers - (gnus-get-newsgroup-headers-xover articles nil nil group)) + ;; No need to call `gnus-get-newsgroup-headers-xover' with + ;; the entire .overview for group as we still have the just + ;; downloaded headers in `gnus-agent-overview-buffer'. + (let ((nntp-server-buffer gnus-agent-overview-buffer)) + (setq gnus-newsgroup-headers + (gnus-get-newsgroup-headers-xover articles nil nil group))) (setq category (gnus-group-category group)) (setq predicate (gnus-get-predicate - (or (gnus-group-get-parameter group 'agent-predicate) + (or (gnus-group-get-parameter group 'agent-predicate t) (cadr category)))) - (setq score-param - (or (gnus-group-get-parameter group 'agent-score) - (caddr category))) - (when score-param - (gnus-score-headers (list (list score-param)))) - (setq arts nil) - (while (setq gnus-headers (pop gnus-newsgroup-headers)) - (setq gnus-score - (or (cdr (assq (mail-header-number gnus-headers) - gnus-newsgroup-scored)) - gnus-summary-default-score)) - (when (funcall predicate) - (push (mail-header-number gnus-headers) - arts))) + ;; Do we want to download everything, or nothing? + (if (or (eq (caaddr predicate) 'gnus-agent-true) + (eq (caaddr predicate) 'gnus-agent-false)) + ;; Yes. + (setq arts (symbol-value + (cadr (assoc (caaddr predicate) + '((gnus-agent-true articles) + (gnus-agent-false nil)))))) + ;; No, we need to decide what we want. + (setq score-param + (let ((score-method (or + (gnus-group-get-parameter group 'agent-score t) + (caddr category)))) + (when score-method + (require 'gnus-score) + (if (eq score-method 'file) + (let ((entries + (gnus-score-load-files + (gnus-all-score-files group))) + list score-file) + (while (setq list (car entries)) + (push (car list) score-file) + (setq list (cdr list)) + (while list + (when (member (caar list) + gnus-agent-scoreable-headers) + (push (car list) score-file)) + (setq list (cdr list))) + (setq score-param + (append score-param (list (nreverse score-file))) + score-file nil entries (cdr entries))) + (list score-param)) + (if (stringp (car score-method)) + score-method + (list (list score-method))))))) + (when score-param + (gnus-score-headers score-param)) + (setq arts nil) + (while (setq gnus-headers (pop gnus-newsgroup-headers)) + (setq gnus-score + (or (cdr (assq (mail-header-number gnus-headers) + gnus-newsgroup-scored)) + gnus-summary-default-score)) + (when (funcall predicate) + (push (mail-header-number gnus-headers) + arts)))) ;; Fetch the articles. (when arts (gnus-agent-fetch-articles group arts))) @@ -1087,7 +1129,7 @@ The following commands are available: "Write the category alist." (setq gnus-category-predicate-cache nil gnus-category-group-cache nil) - (nnheader-temp-write (nnheader-concat gnus-agent-directory "lib/categories") + (with-temp-file (nnheader-concat gnus-agent-directory "lib/categories") (prin1 gnus-category-alist (current-buffer)))) (defun gnus-category-edit-predicate (category) @@ -1261,7 +1303,7 @@ The following commands are available: "Expire all old articles." (interactive) (let ((methods gnus-agent-covered-methods) - (day (- (gnus-time-to-day (current-time)) gnus-agent-expire-days)) + (day (- (time-to-day (current-time)) gnus-agent-expire-days)) gnus-command-method sym group articles history overview file histories elem art nov-file low info unreads marked article)