X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-agent.el;h=9b6de8e9ce73d0d3360e6fb94e3da46d1a326a8e;hb=cddb4672a1b8d0b3fb03dd1c5cad4b01f9fab219;hp=cd3d64777761824c7703b1baeac7a438de842c05;hpb=c971b856674f06a000b973ef6ac5e5e7134cd705;p=elisp%2Fgnus.git- diff --git a/lisp/gnus-agent.el b/lisp/gnus-agent.el index cd3d647..9b6de8e 100644 --- a/lisp/gnus-agent.el +++ b/lisp/gnus-agent.el @@ -1,7 +1,8 @@ -;;; gnus-agent.el --- unplugged support for Gnus +;;; gnus-agent.el --- unplugged support for Semi-gnus ;; Copyright (C) 1997,98,99 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen +;; Tatsuya Ichikawa ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify @@ -95,11 +96,8 @@ If nil, only read articles will be expired." (defvar gnus-agent-file-coding-system 'binary) (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.") + '("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) @@ -115,8 +113,6 @@ for download via the Agent.") (gnus-category-read) (setq gnus-agent-overview-buffer (gnus-get-buffer-create " *Gnus agent overview*")) - (with-current-buffer gnus-agent-overview-buffer - (mm-enable-multibyte)) (add-hook 'gnus-group-mode-hook 'gnus-agent-mode) (add-hook 'gnus-summary-mode-hook 'gnus-agent-mode) (add-hook 'gnus-server-mode-hook 'gnus-agent-mode)) @@ -321,7 +317,7 @@ agent 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 + (unless gnus-agent-send-mail-function (setq gnus-agent-send-mail-function message-send-mail-function message-send-mail-function 'gnus-agent-send-mail)) (unless gnus-agent-covered-methods @@ -333,7 +329,6 @@ agent minor mode in all Gnus buffers." (gnus-request-create-group "queue" '(nndraft "")) (let ((gnus-level-default-subscribed 1)) (gnus-subscribe-group "nndraft:queue" nil '(nndraft ""))) - (gnus-group-set-parameter "nndraft:queue" 'charset nil) (gnus-group-set-parameter "nndraft:queue" 'gnus-dummy '((gnus-draft-mode))))) @@ -368,11 +363,15 @@ be a select method." (defun gnus-agent-fetch-groups (n) "Put all new articles in the current groups into the Agent." (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) "Put all new articles in GROUP into the Agent." (interactive (list (gnus-group-group-name))) + (unless gnus-plugged + (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))) @@ -514,12 +513,21 @@ the actual number of articles toggled is returned." (when (and (not gnus-plugged) (gnus-agent-method-p gnus-command-method)) (gnus-agent-load-alist gnus-newsgroup-name) + ;; First mark all undownloaded articles as undownloaded. (let ((articles gnus-newsgroup-unreads) article) (while (setq article (pop articles)) (unless (or (cdr (assq article gnus-agent-article-alist)) (memq article gnus-newsgroup-downloadable)) - (push article gnus-newsgroup-undownloaded))))))) + (push article gnus-newsgroup-undownloaded)))) + ;; Then mark downloaded downloadable as not-downloadable, + ;; if you get my drift. + (let ((articles gnus-newsgroup-downloadable) + article) + (while (setq article (pop articles)) + (when (cdr (assq article gnus-agent-article-alist)) + (setq gnus-newsgroup-downloadable + (delq article gnus-newsgroup-downloadable)))))))) (defun gnus-agent-catchup () "Mark all undownloaded articles as read." @@ -539,8 +547,8 @@ the actual number of articles toggled is returned." (let* ((gnus-command-method method) (file (gnus-agent-lib-file "active"))) (gnus-make-directory (file-name-directory file)) - (let ((coding-system-for-write gnus-agent-file-coding-system)) - (write-region (point-min) (point-max) file nil 'silent)) + (write-region-as-coding-system + gnus-agent-file-coding-system (point-min) (point-max) file nil 'silent) (when (file-exists-p (gnus-agent-lib-file "groups")) (delete-file (gnus-agent-lib-file "groups")))))) @@ -548,8 +556,8 @@ the actual number of articles toggled is returned." (let* ((gnus-command-method method) (file (gnus-agent-lib-file "groups"))) (gnus-make-directory (file-name-directory file)) - (let ((coding-system-for-write gnus-agent-file-coding-system)) - (write-region (point-min) (point-max) file nil 'silent)) + (write-region-as-coding-system + gnus-agent-file-coding-system (point-min) (point-max) file nil 'silent) (when (file-exists-p (gnus-agent-lib-file "active")) (delete-file (gnus-agent-lib-file "active"))))) @@ -570,9 +578,9 @@ the actual number of articles toggled is returned." (concat "^" (regexp-quote group) " ") nil t) (gnus-delete-line)) (insert group " " (number-to-string (cdr active)) " " - (number-to-string (car active)) " y\n")) - (when (re-search-forward - (concat (regexp-quote group) "\\($\\| \\)") nil t) + (number-to-string (car active)) " y\n")) + (when (re-search-forward + (concat (regexp-quote group) "\\($\\| \\)") nil t) (gnus-delete-line)) (insert-buffer-substring nntp-server-buffer)))))) @@ -621,9 +629,9 @@ the actual number of articles toggled is returned." (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)))) + (write-region-as-coding-system + gnus-agent-file-coding-system + (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) @@ -720,11 +728,10 @@ the actual number of articles toggled is returned." (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)) + (write-region-as-coding-system + gnus-agent-file-coding-system + (point-min) (point-max) + (concat dir (number-to-string (caar pos))) nil 'silent) (when (setq elem (assq (caar pos) gnus-agent-article-alist)) (setcdr elem t)) (gnus-agent-enter-history @@ -764,12 +771,12 @@ the actual number of articles toggled is returned." (save-excursion (while gnus-agent-buffer-alist (set-buffer (cdar gnus-agent-buffer-alist)) - (let ((coding-system-for-write - gnus-agent-file-coding-system)) - (write-region (point-min) (point-max) - (gnus-agent-article-name ".overview" - (caar gnus-agent-buffer-alist)) - nil 'silent)) + (write-region-as-coding-system + gnus-agent-file-coding-system + (point-min) (point-max) + (gnus-agent-article-name ".overview" + (caar gnus-agent-buffer-alist)) + nil 'silent) (pop gnus-agent-buffer-alist)) (while gnus-agent-group-alist (with-temp-file (caar gnus-agent-group-alist) @@ -778,37 +785,37 @@ the actual number of articles toggled is returned." (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-decode-encoded-word-function 'identity) - (file (gnus-agent-article-name ".overview" group))) + (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-decode-encoded-word-function 'identity) + (file (gnus-agent-article-name ".overview" group))) ;; Fetch them. (gnus-make-directory (nnheader-translate-file-chars (file-name-directory file))) (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)) - (when (file-exists-p file) - (gnus-agent-braid-nov group articles file)) - (let ((coding-system-for-write - gnus-agent-file-coding-system)) - (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-days (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)) + (when (file-exists-p file) + (gnus-agent-braid-nov group articles file)) + (write-region-as-coding-system + gnus-agent-file-coding-system + (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-days (current-time))) + articles)))) (defsubst gnus-agent-copy-nov-line (article) (let (b e) @@ -927,7 +934,7 @@ 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)) - ;; No need to call `gnus-get-newsgroup-headers-xover' with + ;; 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)) @@ -935,21 +942,21 @@ the actual number of articles toggled is returned." (gnus-get-newsgroup-headers-xover articles nil nil group))) (setq category (gnus-group-category group)) (setq predicate - (gnus-get-predicate + (gnus-get-predicate (or (gnus-group-get-parameter group 'agent-predicate t) (cadr category)))) ;; 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) + (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 + (or (gnus-group-get-parameter group 'agent-score t) (caddr category)))) (when score-method @@ -967,7 +974,7 @@ the actual number of articles toggled is returned." gnus-agent-scoreable-headers) (push (car list) score-file)) (setq list (cdr list))) - (setq score-param + (setq score-param (append score-param (list (nreverse score-file))) score-file nil entries (cdr entries))) (list score-param)) @@ -1153,7 +1160,7 @@ The following commands are available: (or (gnus-agent-read-file (nnheader-concat gnus-agent-directory "lib/categories")) (list (list 'default 'short nil nil))))) - + (defun gnus-category-write () "Write the category alist." (setq gnus-category-predicate-cache nil @@ -1172,7 +1179,7 @@ The following commands are available: (setf (cadr (assq ',category gnus-category-alist)) predicate) (gnus-category-write) (gnus-category-list))))) - + (defun gnus-category-edit-score (category) "Edit the score expression for CATEGORY." (interactive (list (gnus-category-name))) @@ -1287,7 +1294,7 @@ The following commands are available: (defun gnus-agent-false () "Return nil." nil) - + (defun gnus-category-make-function-1 (cat) "Make a function from category CAT." (cond @@ -1415,9 +1422,9 @@ The following commands are available: ;; Schedule the history line for nuking. (push (cdr elem) histories))) (gnus-make-directory (file-name-directory nov-file)) - (let ((coding-system-for-write - gnus-agent-file-coding-system)) - (write-region (point-min) (point-max) nov-file nil 'silent)) + (write-region-as-coding-system + gnus-agent-file-coding-system + (point-min) (point-max) nov-file nil 'silent) ;; Delete the unwanted entries in the alist. (setq gnus-agent-article-alist (sort gnus-agent-article-alist 'car-less-than-car)) @@ -1450,15 +1457,15 @@ The following commands are available: ;; Maybe everything has been expired from `gnus-article-alist' ;; and so the above marking as read could not be conducted, ;; or there are expired article within the range of the alist. - (when (and info - expired - (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)))) + (when (and info + expired + (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)