X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-agent.el;h=9b6de8e9ce73d0d3360e6fb94e3da46d1a326a8e;hb=cddb4672a1b8d0b3fb03dd1c5cad4b01f9fab219;hp=39f1f2f1069bd4ef2bfd0d8a158e62e53fd279bc;hpb=870822142dbdbf720ada0e93c8f0649bbac1bd16;p=elisp%2Fgnus.git- diff --git a/lisp/gnus-agent.el b/lisp/gnus-agent.el index 39f1f2f..9b6de8e 100644 --- a/lisp/gnus-agent.el +++ b/lisp/gnus-agent.el @@ -1,5 +1,5 @@ ;;; gnus-agent.el --- unplugged support for Semi-gnus -;; Copyright (C) 1997,98 Free Software Foundation, Inc. +;; Copyright (C) 1997,98,99 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Tatsuya Ichikawa @@ -93,14 +93,11 @@ If nil, only read articles will be expired." (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 'no-conversion) +(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) @@ -223,7 +220,8 @@ for download via the Agent.") "Jj" gnus-agent-toggle-plugged "Js" gnus-agent-fetch-session "JS" gnus-group-send-drafts - "Ja" gnus-agent-add-group) + "Ja" gnus-agent-add-group + "Jr" gnus-agent-remove-group) (defun gnus-agent-group-make-menu-bar () (unless (boundp 'gnus-agent-group-menu) @@ -319,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 @@ -365,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))) @@ -398,6 +400,16 @@ be a select method." (setf (cadddr cat) (nconc (cadddr 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))) + (setf (cadddr c) (delete group (cadddr c)))))) + (gnus-category-write))) + ;;; ;;; Server mode commands ;;; @@ -435,6 +447,7 @@ be a select method." (defun gnus-agent-write-servers () "Write the alist of covered servers." + (gnus-make-directory (nnheader-concat gnus-agent-directory "lib")) (with-temp-file (nnheader-concat gnus-agent-directory "lib/servers") (prin1 gnus-agent-covered-methods (current-buffer)))) @@ -500,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." @@ -525,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")))))) @@ -534,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"))))) @@ -557,7 +579,8 @@ the actual number of articles toggled is returned." (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) + (when (re-search-forward + (concat (regexp-quote group) "\\($\\| \\)") nil t) (gnus-delete-line)) (insert-buffer-substring nntp-server-buffer)))))) @@ -606,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) @@ -672,7 +695,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)) - (with-temp-file nil + (with-temp-buffer (let (article) (while (setq article (pop articles)) (when (gnus-request-article article group) @@ -705,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 @@ -749,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) @@ -770,8 +792,11 @@ the actual number of articles toggled is returned." (cons (1+ (caar (last gnus-agent-article-alist))) (cdr (gnus-active group))))) (gnus-list-of-unread-articles group))) - (gnus-decode-encoded-word-function 'identity)) + (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 @@ -780,21 +805,17 @@ the actual number of articles toggled is returned." (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))) - (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))))) + (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) @@ -902,6 +923,7 @@ the actual number of articles toggled is returned." (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-scored gnus-headers gnus-score gnus-use-cache articles arts @@ -912,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)) @@ -920,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 @@ -952,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)) @@ -980,7 +1002,11 @@ the actual number of articles toggled is returned." (gnus-agent-fetch-articles group (gnus-uncompress-range (cdr arts))) (setq marks (delq arts (gnus-info-marks info))) - (gnus-info-set-marks info marks)))) + (gnus-info-set-marks info marks) + (gnus-dribble-enter + (concat "(gnus-group-set-info '" + (gnus-prin1-to-string info) + ")"))))) ;;; ;;; Agent Category Mode @@ -1134,11 +1160,12 @@ 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 gnus-category-group-cache nil) + (gnus-make-directory (nnheader-concat gnus-agent-directory "lib")) (with-temp-file (nnheader-concat gnus-agent-directory "lib/categories") (prin1 gnus-category-alist (current-buffer)))) @@ -1152,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))) @@ -1267,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 @@ -1395,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))