X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-agent.el;h=d37bd7b16649dcc75ff5704f875df49c1c83f5d9;hb=a45dd507bf71d9e3fbfb6067896554323b02b643;hp=5128fc318c058b45e71286e71373e326946eb66c;hpb=37b7cc19618900d290af35abd0fe6c53db8fbdc2;p=elisp%2Fgnus.git- diff --git a/lisp/gnus-agent.el b/lisp/gnus-agent.el index 5128fc3..d37bd7b 100644 --- a/lisp/gnus-agent.el +++ b/lisp/gnus-agent.el @@ -1,4 +1,4 @@ -;;; gnus-agent.el --- unplugged support for Gnus +;;; gnus-agent.el --- unplugged support for Semi-gnus ;; Copyright (C) 1997,98 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -92,7 +92,7 @@ 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-article-file-coding-system 'no-conversion) +(defvar gnus-agent-file-coding-system 'no-conversion) ;; Dynamic variables (defvar gnus-headers) @@ -129,7 +129,7 @@ If nil, only read articles will be expired." "Load FILE and do a `read' there." (nnheader-temp-write nil (ignore-errors - (insert-file-contents file) + (nnheader-insert-file-contents file) (goto-char (point-min)) (read (current-buffer))))) @@ -517,8 +517,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-article-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")))))) @@ -526,9 +526,10 @@ 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)) - (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")))) + (delete-file (gnus-agent-lib-file "active"))))) (defun gnus-agent-save-group-info (method group active) (when (gnus-agent-method-p method) @@ -539,7 +540,7 @@ the actual number of articles toggled is returned." (gnus-make-directory (file-name-directory file)) (nnheader-temp-write file (when (file-exists-p file) - (insert-file-contents file)) + (nnheader-insert-file-contents file)) (goto-char (point-min)) (if nntp-server-list-active-group (progn @@ -547,7 +548,7 @@ 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)) "\n")) + (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)))))) @@ -597,8 +598,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)) - (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) @@ -644,7 +646,7 @@ the actual number of articles toggled is returned." ;; Prune off articles that we have already fetched. (while (and articles (cdr (assq (car articles) gnus-agent-article-alist))) - (pop articles)) + (pop articles)) (let ((arts articles)) (while (cdr arts) (if (cdr (assq (cadr arts) gnus-agent-article-alist)) @@ -695,11 +697,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-article-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 @@ -728,7 +729,7 @@ the actual number of articles toggled is returned." (when (= (point-max) (point-min)) (push (cons group (current-buffer)) gnus-agent-buffer-alist) (ignore-errors - (insert-file-contents + (nnheader-insert-file-contents (gnus-agent-article-name ".overview" group)))) (nnheader-find-nov-line (string-to-number (cdar crosses))) (insert (string-to-number (cdar crosses))) @@ -739,10 +740,12 @@ the actual number of articles toggled is returned." (save-excursion (while gnus-agent-buffer-alist (set-buffer (cdar gnus-agent-buffer-alist)) - (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 (nnheader-temp-write (caar gnus-agent-group-alist) @@ -751,32 +754,37 @@ the actual number of articles toggled is returned." (pop gnus-agent-group-alist)))) (defun gnus-agent-fetch-headers (group &optional force) - (when (gnus-agent-load-alist group) - (let ((articles (gnus-uncompress-range - (cons (1+ (caar (last (gnus-agent-load-alist group)))) - (cdr (gnus-active 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)))))) + (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)))) + ;; 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-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))) + (gnus-time-to-day (current-time))) + articles))))) (defsubst gnus-agent-copy-nov-line (article) (let (b e) @@ -795,7 +803,7 @@ the actual number of articles toggled is returned." (goto-char (point-min)) (set-buffer nntp-server-buffer) (erase-buffer) - (insert-file-contents file) + (nnheader-insert-file-contents file) (goto-char (point-max)) (if (or (= (point-min) (point-max)) (progn @@ -1302,14 +1310,14 @@ The following commands are available: (cdr (assq 'dormant (gnus-info-marks info))))) nov-file (gnus-agent-article-name ".overview" group)) - (gnus-agent-load-alist group) + (gnus-agent-load-alist group) (gnus-message 5 "Expiring articles in %s" group) (set-buffer overview) (erase-buffer) (when (file-exists-p nov-file) - (insert-file-contents nov-file)) + (nnheader-insert-file-contents nov-file)) (goto-char (point-min)) - (setq article 0) + (setq article 0) (while (setq elem (pop articles)) (setq article (car elem)) (when (or (null low) @@ -1340,13 +1348,16 @@ The following commands are available: ;; Schedule the history line for nuking. (push (cdr elem) histories))) (gnus-make-directory (file-name-directory nov-file)) - (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)) (let* ((alist gnus-agent-article-alist) (prev (cons nil alist)) - (first prev)) + (first prev) + expired) (while (and alist (<= (caar alist) article)) (if (or (not (cdar alist)) @@ -1355,22 +1366,34 @@ The following commands are available: (number-to-string (caar alist)) group)))) - (setcdr prev (setq alist (cdr alist))) + (progn + (push (caar alist) expired) + (setcdr prev (setq alist (cdr alist)))) (setq prev alist alist (cdr alist)))) (setq gnus-agent-article-alist (cdr first)) ;;; Mark all articles up to the first article ;;; in `gnus-article-alist' as read. - (when (caar gnus-agent-article-alist) + (when (and info (caar gnus-agent-article-alist)) (setcar (nthcdr 2 info) (gnus-range-add (nth 2 info) (cons 1 (- (caar gnus-agent-article-alist) 1))))) + ;; 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 (car 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) - ")")) - (gnus-agent-save-alist group))) + ")")))) expiry-hashtb) (set-buffer history) (setq histories (nreverse (sort histories '<)))