1 |
;;; nnfolder.el --- mail folder access for Gnus |
;;; nnfolder.el --- mail folder access for Gnus |
2 |
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001 |
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 |
3 |
;; Free Software Foundation, Inc. |
;; Free Software Foundation, Inc. |
4 |
|
|
5 |
;; Author: Scott Byer <byer@mv.us.adobe.com> |
;; Author: Simon Josefsson <simon@josefsson.org> (adding MARKS) |
6 |
|
;; ShengHuo Zhu <zsh@cs.rochester.edu> (adding NOV) |
7 |
|
;; Scott Byer <byer@mv.us.adobe.com> |
8 |
;; Lars Magne Ingebrigtsen <larsi@gnus.org> |
;; Lars Magne Ingebrigtsen <larsi@gnus.org> |
9 |
;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet> |
;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet> |
10 |
;; Keywords: mail |
;; Keywords: mail |
11 |
|
|
12 |
;; This file is part of GNU Emacs. |
;; This file is part of GNU Emacs. |
35 |
(require 'nnmail) |
(require 'nnmail) |
36 |
(require 'nnoo) |
(require 'nnoo) |
37 |
(eval-when-compile (require 'cl)) |
(eval-when-compile (require 'cl)) |
38 |
|
(require 'gnus) |
39 |
(require 'gnus-util) |
(require 'gnus-util) |
40 |
(require 'gnus-range) |
(require 'gnus-range) |
41 |
|
|
42 |
|
(eval-and-compile |
43 |
|
(autoload 'gnus-article-unpropagatable-p "gnus-sum") |
44 |
|
(autoload 'gnus-intersection "gnus-range")) |
45 |
|
|
46 |
(nnoo-declare nnfolder) |
(nnoo-declare nnfolder) |
47 |
|
|
48 |
(defvoo nnfolder-directory (expand-file-name message-directory) |
(defvoo nnfolder-directory (expand-file-name message-directory) |
49 |
"The name of the nnfolder directory.") |
"The name of the nnfolder directory.") |
50 |
|
|
51 |
|
(defvoo nnfolder-nov-directory nil |
52 |
|
"The name of the nnfolder NOV directory. |
53 |
|
If nil, `nnfolder-directory' is used.") |
54 |
|
|
55 |
|
(defvoo nnfolder-marks-directory nil |
56 |
|
"The name of the nnfolder MARKS directory. |
57 |
|
If nil, `nnfolder-directory' is used.") |
58 |
|
|
59 |
(defvoo nnfolder-active-file |
(defvoo nnfolder-active-file |
60 |
(nnheader-concat nnfolder-directory "active") |
(nnheader-concat nnfolder-directory "active") |
61 |
"The name of the active file.") |
"The name of the active file.") |
91 |
(defvoo nnfolder-save-buffer-hook nil |
(defvoo nnfolder-save-buffer-hook nil |
92 |
"Hook run before saving the nnfolder mbox buffer.") |
"Hook run before saving the nnfolder mbox buffer.") |
93 |
|
|
94 |
|
|
95 |
(defvoo nnfolder-inhibit-expiry nil |
(defvoo nnfolder-inhibit-expiry nil |
96 |
"If non-nil, inhibit expiry.") |
"If non-nil, inhibit expiry.") |
97 |
|
|
98 |
|
|
99 |
|
|
100 |
(defconst nnfolder-version "nnfolder 1.0" |
(defconst nnfolder-version "nnfolder 2.0" |
101 |
"nnfolder version.") |
"nnfolder version.") |
102 |
|
|
103 |
(defconst nnfolder-article-marker "X-Gnus-Article-Number: " |
(defconst nnfolder-article-marker "X-Gnus-Article-Number: " |
116 |
(defvoo nnfolder-file-coding-system mm-text-coding-system) |
(defvoo nnfolder-file-coding-system mm-text-coding-system) |
117 |
(defvoo nnfolder-file-coding-system-for-write nnheader-file-coding-system |
(defvoo nnfolder-file-coding-system-for-write nnheader-file-coding-system |
118 |
"Coding system for save nnfolder file. |
"Coding system for save nnfolder file. |
119 |
If nil, `nnfolder-file-coding-system' is used.") |
if nil, `nnfolder-file-coding-system' is used.") ; FIXME: fill-in the doc-string of this variable |
120 |
|
|
121 |
|
(defvoo nnfolder-nov-is-evil nil |
122 |
|
"If non-nil, Gnus will never generate and use nov databases for mail groups. |
123 |
|
Using nov databases will speed up header fetching considerably. |
124 |
|
This variable shouldn't be flipped much. If you have, for some reason, |
125 |
|
set this to t, and want to set it to nil again, you should always run |
126 |
|
the `nnfolder-generate-active-file' command. The function will go |
127 |
|
through all nnfolder directories and generate nov databases for them |
128 |
|
all. This may very well take some time.") |
129 |
|
|
130 |
|
(defvoo nnfolder-nov-file-suffix ".nov") |
131 |
|
|
132 |
|
(defvoo nnfolder-nov-buffer-alist nil) |
133 |
|
|
134 |
|
(defvar nnfolder-nov-buffer-file-name nil) |
135 |
|
|
136 |
|
(defvoo nnfolder-marks-is-evil nil |
137 |
|
"If non-nil, Gnus will never generate and use marks file for mail groups. |
138 |
|
Using marks files makes it possible to backup and restore mail groups |
139 |
|
separately from `.newsrc.eld'. If you have, for some reason, set |
140 |
|
this to t, and want to set it to nil again, you should always remove |
141 |
|
the corresponding marks file (usually base nnfolder file name |
142 |
|
concatenated with `.mrk', but see `nnfolder-marks-file-suffix') for |
143 |
|
the group. Then the marks file will be regenerated properly by Gnus.") |
144 |
|
|
145 |
|
(defvoo nnfolder-marks nil) |
146 |
|
|
147 |
|
(defvoo nnfolder-marks-file-suffix ".mrk") |
148 |
|
|
149 |
|
(defvar nnfolder-marks-modtime (gnus-make-hashtable)) |
150 |
|
|
151 |
|
|
152 |
|
|
158 |
(save-excursion |
(save-excursion |
159 |
(set-buffer nntp-server-buffer) |
(set-buffer nntp-server-buffer) |
160 |
(erase-buffer) |
(erase-buffer) |
161 |
(let (article start stop) |
(let (article start stop num) |
162 |
(nnfolder-possibly-change-group group server) |
(nnfolder-possibly-change-group group server) |
163 |
(when nnfolder-current-buffer |
(when nnfolder-current-buffer |
164 |
(set-buffer nnfolder-current-buffer) |
(set-buffer nnfolder-current-buffer) |
165 |
(goto-char (point-min)) |
(goto-char (point-min)) |
166 |
(if (stringp (car articles)) |
(if (stringp (car articles)) |
167 |
'headers |
'headers |
168 |
(while (setq article (pop articles)) |
(if (nnfolder-retrieve-headers-with-nov articles fetch-old) |
169 |
(set-buffer nnfolder-current-buffer) |
'nov |
170 |
(when (nnfolder-goto-article article) |
(setq articles (gnus-sorted-intersection |
171 |
(setq start (point)) |
;; Is ARTICLES sorted? |
172 |
(setq stop (if (search-forward "\n\n" nil t) |
(sort articles '<) |
173 |
(1- (point)) |
(nnfolder-existing-articles))) |
174 |
(point-max))) |
(while (setq article (pop articles)) |
175 |
(set-buffer nntp-server-buffer) |
(set-buffer nnfolder-current-buffer) |
176 |
(insert (format "221 %d Article retrieved.\n" article)) |
(cond ((nnfolder-goto-article article) |
177 |
(insert-buffer-substring nnfolder-current-buffer start stop) |
(setq start (point)) |
178 |
(goto-char (point-max)) |
(setq stop (if (search-forward "\n\n" nil t) |
179 |
(insert ".\n"))) |
(1- (point)) |
180 |
|
(point-max))) |
181 |
(set-buffer nntp-server-buffer) |
(set-buffer nntp-server-buffer) |
182 |
(nnheader-fold-continuation-lines) |
(insert (format "221 %d Article retrieved.\n" article)) |
183 |
'headers))))) |
(insert-buffer-substring nnfolder-current-buffer |
184 |
|
start stop) |
185 |
|
(goto-char (point-max)) |
186 |
|
(insert ".\n")) |
187 |
|
|
188 |
|
;; If we couldn't find this article, skip over ranges |
189 |
|
;; of missing articles so we don't search the whole file |
190 |
|
;; for each of them. |
191 |
|
((numberp article) |
192 |
|
(setq start (point)) |
193 |
|
(and |
194 |
|
;; Check that we are either at BOF or after an |
195 |
|
;; article with a lower number. We do this so we |
196 |
|
;; won't be confused by out-of-order article numbers, |
197 |
|
;; as caused by active file bogosity. |
198 |
|
(cond |
199 |
|
((bobp)) |
200 |
|
((search-backward (concat "\n" nnfolder-article-marker) |
201 |
|
nil t) |
202 |
|
(goto-char (match-end 0)) |
203 |
|
(setq num (string-to-int |
204 |
|
(buffer-substring |
205 |
|
(point) (gnus-point-at-eol)))) |
206 |
|
(goto-char start) |
207 |
|
(< num article))) |
208 |
|
;; Check that we are before an article with a |
209 |
|
;; higher number. |
210 |
|
(search-forward (concat "\n" nnfolder-article-marker) |
211 |
|
nil t) |
212 |
|
(progn |
213 |
|
(setq num (string-to-int |
214 |
|
(buffer-substring |
215 |
|
(point) (gnus-point-at-eol)))) |
216 |
|
(> num article)) |
217 |
|
;; Discard any article numbers before the one we're |
218 |
|
;; now looking at. |
219 |
|
(while (and articles |
220 |
|
(< (car articles) num)) |
221 |
|
(setq articles (cdr articles)))) |
222 |
|
(goto-char start)))) |
223 |
|
(set-buffer nntp-server-buffer) |
224 |
|
(nnheader-fold-continuation-lines) |
225 |
|
'headers)))))) |
226 |
|
|
227 |
(deffoo nnfolder-open-server (server &optional defs) |
(deffoo nnfolder-open-server (server &optional defs) |
228 |
(nnoo-change-server 'nnfolder server defs) |
(nnoo-change-server 'nnfolder server defs) |
229 |
(nnmail-activate 'nnfolder t) |
(nnmail-activate 'nnfolder t) |
230 |
(gnus-make-directory nnfolder-directory) |
(gnus-make-directory nnfolder-directory) |
231 |
|
(unless (or gnus-nov-is-evil nnfolder-nov-is-evil) |
232 |
|
(and nnfolder-nov-directory |
233 |
|
(gnus-make-directory nnfolder-nov-directory))) |
234 |
|
(unless nnfolder-marks-is-evil |
235 |
|
(and nnfolder-marks-directory |
236 |
|
(gnus-make-directory nnfolder-marks-directory))) |
237 |
(cond |
(cond |
238 |
((not (file-exists-p nnfolder-directory)) |
((not (file-exists-p nnfolder-directory)) |
239 |
(nnfolder-close-server) |
(nnfolder-close-server) |
285 |
(cons nnfolder-current-group |
(cons nnfolder-current-group |
286 |
(if (search-forward (concat "\n" nnfolder-article-marker) |
(if (search-forward (concat "\n" nnfolder-article-marker) |
287 |
nil t) |
nil t) |
288 |
(string-to-int |
(string-to-int (buffer-substring |
289 |
(buffer-substring |
(point) (gnus-point-at-eol))) |
|
(point) (progn (end-of-line) (point)))) |
|
290 |
-1)))))))) |
-1)))))))) |
291 |
|
|
292 |
(deffoo nnfolder-request-group (group &optional server dont-check) |
(deffoo nnfolder-request-group (group &optional server dont-check) |
406 |
(let ((marker (concat "\n" nnfolder-article-marker)) |
(let ((marker (concat "\n" nnfolder-article-marker)) |
407 |
(number "[0-9]+") |
(number "[0-9]+") |
408 |
numbers) |
numbers) |
|
|
|
409 |
(while (and (search-forward marker nil t) |
(while (and (search-forward marker nil t) |
410 |
(re-search-forward number nil t)) |
(re-search-forward number nil t)) |
411 |
(let ((newnum (string-to-number (match-string 0)))) |
(let ((newnum (string-to-number (match-string 0)))) |
412 |
(if (nnmail-within-headers-p) |
(if (nnmail-within-headers-p) |
413 |
(push newnum numbers)))) |
(push newnum numbers)))) |
414 |
numbers)))) |
;; The article numbers are increasing, so this result is sorted. |
415 |
|
(nreverse numbers))))) |
416 |
|
|
417 |
(deffoo nnfolder-request-expire-articles |
(deffoo nnfolder-request-expire-articles |
418 |
(articles newsgroup &optional server force) |
(articles newsgroup &optional server force) |
423 |
;; The articles that really exist and will |
;; The articles that really exist and will |
424 |
;; be expired if they are old enough. |
;; be expired if they are old enough. |
425 |
(maybe-expirable |
(maybe-expirable |
426 |
(gnus-intersection articles (nnfolder-existing-articles)))) |
(gnus-sorted-intersection articles (nnfolder-existing-articles)))) |
427 |
(nnmail-activate 'nnfolder) |
(nnmail-activate 'nnfolder) |
428 |
|
|
429 |
(save-excursion |
(save-excursion |
447 |
(with-temp-buffer |
(with-temp-buffer |
448 |
(nnfolder-request-article (car maybe-expirable) |
(nnfolder-request-article (car maybe-expirable) |
449 |
newsgroup server (current-buffer)) |
newsgroup server (current-buffer)) |
450 |
(let ((nnml-current-directory nil)) |
(let ((nnfolder-current-directory nil)) |
451 |
(nnmail-expiry-target-group |
(nnmail-expiry-target-group |
452 |
nnmail-expiry-target newsgroup)))) |
nnmail-expiry-target newsgroup))) |
453 |
|
(nnfolder-possibly-change-group newsgroup server)) |
454 |
(nnheader-message 5 "Deleting article %d in %s..." |
(nnheader-message 5 "Deleting article %d in %s..." |
455 |
(car maybe-expirable) newsgroup) |
(car maybe-expirable) newsgroup) |
456 |
(nnfolder-delete-mail) |
(nnfolder-delete-mail) |
457 |
|
(unless (or gnus-nov-is-evil nnfolder-nov-is-evil) |
458 |
|
(nnfolder-nov-delete-article newsgroup (car maybe-expirable))) |
459 |
;; Must remember which articles were actually deleted |
;; Must remember which articles were actually deleted |
460 |
(push (car maybe-expirable) deleted-articles))) |
(push (car maybe-expirable) deleted-articles))) |
461 |
(setq maybe-expirable (cdr maybe-expirable))) |
(setq maybe-expirable (cdr maybe-expirable))) |
464 |
(nnfolder-save-buffer) |
(nnfolder-save-buffer) |
465 |
(nnfolder-adjust-min-active newsgroup) |
(nnfolder-adjust-min-active newsgroup) |
466 |
(nnfolder-save-active nnfolder-group-alist nnfolder-active-file) |
(nnfolder-save-active nnfolder-group-alist nnfolder-active-file) |
467 |
(gnus-sorted-complement articles (nreverse deleted-articles))))) |
(gnus-sorted-difference articles (nreverse deleted-articles))))) |
468 |
|
|
469 |
(deffoo nnfolder-request-move-article (article group server |
(deffoo nnfolder-request-move-article (article group server |
470 |
accept-form &optional last) |
accept-form &optional last) |
482 |
(concat "^" nnfolder-article-marker) |
(concat "^" nnfolder-article-marker) |
483 |
(save-excursion (and (search-forward "\n\n" nil t) (point))) |
(save-excursion (and (search-forward "\n\n" nil t) (point))) |
484 |
t) |
t) |
485 |
(delete-region (progn (beginning-of-line) (point)) |
(gnus-delete-line)) |
|
(progn (forward-line 1) (point)))) |
|
486 |
(setq result (eval accept-form)) |
(setq result (eval accept-form)) |
487 |
(kill-buffer buf) |
(kill-buffer buf) |
488 |
result) |
result) |
492 |
(goto-char (point-min)) |
(goto-char (point-min)) |
493 |
(when (nnfolder-goto-article article) |
(when (nnfolder-goto-article article) |
494 |
(nnfolder-delete-mail)) |
(nnfolder-delete-mail)) |
495 |
|
(unless (or gnus-nov-is-evil nnfolder-nov-is-evil) |
496 |
|
(nnfolder-nov-delete-article group article)) |
497 |
(when last |
(when last |
498 |
(nnfolder-save-buffer) |
(nnfolder-save-buffer) |
499 |
(nnfolder-adjust-min-active group) |
(nnfolder-adjust-min-active group) |
511 |
(replace-match "From ") |
(replace-match "From ") |
512 |
(while (progn (forward-line) (looking-at "[ \t]")) |
(while (progn (forward-line) (looking-at "[ \t]")) |
513 |
(delete-char -1))) |
(delete-char -1))) |
514 |
(and |
(with-temp-buffer |
515 |
(nnfolder-request-list) |
(let ((nnmail-file-coding-system nnfolder-active-file-coding-system) |
516 |
(save-excursion |
(nntp-server-buffer (current-buffer))) |
517 |
(set-buffer buf) |
(nnmail-find-file nnfolder-active-file) |
518 |
(goto-char (point-min)) |
(setq nnfolder-group-alist (nnmail-parse-active)))) |
519 |
(if (search-forward "\n\n" nil t) |
(save-excursion |
520 |
(forward-line -1) |
(goto-char (point-min)) |
521 |
(goto-char (point-max))) |
(if (search-forward "\n\n" nil t) |
522 |
(while (re-search-backward (concat "^" nnfolder-article-marker) nil t) |
(forward-line -1) |
523 |
(delete-region (point) (progn (forward-line 1) (point)))) |
(goto-char (point-max))) |
524 |
(when nnmail-cache-accepted-message-ids |
(while (re-search-backward (concat "^" nnfolder-article-marker) nil t) |
525 |
(nnmail-cache-insert (nnmail-fetch-field "message-id"))) |
(delete-region (point) (progn (forward-line 1) (point)))) |
526 |
(setq result (if (stringp group) |
(when nnmail-cache-accepted-message-ids |
527 |
(list (cons group (nnfolder-active-number group))) |
(nnmail-cache-insert (nnmail-fetch-field "message-id") |
528 |
(setq art-group |
group |
529 |
(nnmail-article-group 'nnfolder-active-number)))) |
(nnmail-fetch-field "subject") |
530 |
(if (and (null result) |
(nnmail-fetch-field "from"))) |
531 |
(yes-or-no-p "Moved to `junk' group; delete article? ")) |
(setq result (if (stringp group) |
532 |
(setq result 'junk) |
(list (cons group (nnfolder-active-number group))) |
533 |
(setq result |
(setq art-group |
534 |
(car (nnfolder-save-mail result))))) |
(nnmail-article-group 'nnfolder-active-number)))) |
535 |
(when last |
(if (and (null result) |
536 |
(save-excursion |
(yes-or-no-p "Moved to `junk' group; delete article? ")) |
537 |
(nnfolder-possibly-change-folder (or (caar art-group) group)) |
(setq result 'junk) |
538 |
(nnfolder-save-buffer) |
(setq result |
539 |
(when nnmail-cache-accepted-message-ids |
(car (nnfolder-save-mail result))))) |
540 |
(nnmail-cache-close))))) |
(when last |
541 |
|
(save-excursion |
542 |
|
(nnfolder-possibly-change-folder (or (caar art-group) group)) |
543 |
|
(nnfolder-save-buffer) |
544 |
|
(when nnmail-cache-accepted-message-ids |
545 |
|
(nnmail-cache-close)))) |
546 |
(nnfolder-save-active nnfolder-group-alist nnfolder-active-file) |
(nnfolder-save-active nnfolder-group-alist nnfolder-active-file) |
547 |
(unless result |
(unless result |
548 |
(nnheader-report 'nnfolder "Couldn't store article")) |
(nnheader-report 'nnfolder "Couldn't store article")) |
553 |
(save-excursion |
(save-excursion |
554 |
(set-buffer buffer) |
(set-buffer buffer) |
555 |
(goto-char (point-min)) |
(goto-char (point-min)) |
556 |
(let (xfrom) |
(if (not (looking-at "X-From-Line: ")) |
557 |
(while (re-search-forward "^X-From-Line: \\(.*\\)$" nil t) |
(insert "From nobody " (current-time-string) "\n") |
558 |
(setq xfrom (match-string 1)) |
(replace-match "From ") |
559 |
(gnus-delete-line)) |
(forward-line 1) |
560 |
(goto-char (point-min)) |
(while (looking-at "[ \t]") |
561 |
(if xfrom |
(delete-char -1) |
562 |
(insert "From " xfrom "\n") |
(forward-line 1))) |
|
(unless (looking-at "From ") |
|
|
(insert "From nobody " (current-time-string) "\n")))) |
|
563 |
(nnfolder-normalize-buffer) |
(nnfolder-normalize-buffer) |
564 |
(set-buffer nnfolder-current-buffer) |
(set-buffer nnfolder-current-buffer) |
565 |
(goto-char (point-min)) |
(goto-char (point-min)) |
567 |
nil |
nil |
568 |
(nnfolder-delete-mail) |
(nnfolder-delete-mail) |
569 |
(insert-buffer-substring buffer) |
(insert-buffer-substring buffer) |
570 |
|
(unless (or gnus-nov-is-evil nnfolder-nov-is-evil) |
571 |
|
(save-excursion |
572 |
|
(set-buffer buffer) |
573 |
|
(let ((headers (nnfolder-parse-head article |
574 |
|
(point-min) (point-max)))) |
575 |
|
(with-current-buffer (nnfolder-open-nov group) |
576 |
|
(if (nnheader-find-nov-line article) |
577 |
|
(delete-region (point) (progn (forward-line 1) (point)))) |
578 |
|
(nnheader-insert-nov headers))))) |
579 |
(nnfolder-save-buffer) |
(nnfolder-save-buffer) |
580 |
t))) |
t))) |
581 |
|
|
585 |
(if (not force) |
(if (not force) |
586 |
() ; Don't delete the articles. |
() ; Don't delete the articles. |
587 |
;; Delete the file that holds the group. |
;; Delete the file that holds the group. |
588 |
(ignore-errors |
(let ((data (nnfolder-group-pathname group)) |
589 |
(delete-file (nnfolder-group-pathname group)))) |
(nov (nnfolder-group-nov-pathname group)) |
590 |
|
(mrk (nnfolder-group-marks-pathname group))) |
591 |
|
(ignore-errors (delete-file data)) |
592 |
|
(ignore-errors (delete-file nov)) |
593 |
|
(ignore-errors (delete-file mrk)))) |
594 |
;; Remove the group from all structures. |
;; Remove the group from all structures. |
595 |
(setq nnfolder-group-alist |
(setq nnfolder-group-alist |
596 |
(delq (assoc group nnfolder-group-alist) nnfolder-group-alist) |
(delq (assoc group nnfolder-group-alist) nnfolder-group-alist) |
606 |
(set-buffer nnfolder-current-buffer) |
(set-buffer nnfolder-current-buffer) |
607 |
(and (file-writable-p buffer-file-name) |
(and (file-writable-p buffer-file-name) |
608 |
(ignore-errors |
(ignore-errors |
609 |
(rename-file |
(let ((new-file (nnfolder-group-pathname new-name))) |
610 |
buffer-file-name |
(gnus-make-directory (file-name-directory new-file)) |
611 |
(let ((new-file (nnfolder-group-pathname new-name))) |
(rename-file buffer-file-name new-file) |
612 |
(gnus-make-directory (file-name-directory new-file)) |
(when (file-exists-p (nnfolder-group-nov-pathname group)) |
613 |
new-file)) |
(setq new-file (nnfolder-group-nov-pathname new-name)) |
614 |
|
(gnus-make-directory (file-name-directory new-file)) |
615 |
|
(rename-file (nnfolder-group-nov-pathname group) new-file)) |
616 |
|
(when (file-exists-p (nnfolder-group-marks-pathname group)) |
617 |
|
(setq new-file (nnfolder-group-marks-pathname new-name)) |
618 |
|
(gnus-make-directory (file-name-directory new-file)) |
619 |
|
(rename-file (nnfolder-group-marks-pathname group) new-file))) |
620 |
t) |
t) |
621 |
;; That went ok, so we change the internal structures. |
;; That went ok, so we change the internal structures. |
622 |
(let ((entry (assoc group nnfolder-group-alist))) |
(let ((entry (assoc group nnfolder-group-alist))) |
629 |
(kill-buffer (current-buffer)) |
(kill-buffer (current-buffer)) |
630 |
t)))) |
t)))) |
631 |
|
|
632 |
(defun nnfolder-request-regenerate (server) |
(deffoo nnfolder-request-regenerate (server) |
633 |
(nnfolder-possibly-change-group nil server) |
(nnfolder-possibly-change-group nil server) |
634 |
(nnfolder-generate-active-file) |
(nnfolder-generate-active-file) |
635 |
t) |
t) |
711 |
(setq nnfolder-current-buffer nil |
(setq nnfolder-current-buffer nil |
712 |
nnfolder-current-group nil)) |
nnfolder-current-group nil)) |
713 |
;; Change group. |
;; Change group. |
714 |
(when (and group |
(let ((file-name-coding-system nnmail-pathname-coding-system)) |
715 |
(not (equal group nnfolder-current-group))) |
(when (and group |
716 |
(let ((file-name-coding-system nnmail-pathname-coding-system)) |
(not (equal group nnfolder-current-group)) |
717 |
(nnmail-activate 'nnfolder) |
(progn |
718 |
(when (and (not (assoc group nnfolder-group-alist)) |
(nnmail-activate 'nnfolder) |
719 |
(not (file-exists-p |
(and (assoc group nnfolder-group-alist) |
720 |
(nnfolder-group-pathname group)))) |
(file-exists-p (nnfolder-group-pathname group))))) |
|
;; The group doesn't exist, so we create a new entry for it. |
|
|
(push (list group (cons 1 0)) nnfolder-group-alist) |
|
|
(nnfolder-save-active nnfolder-group-alist nnfolder-active-file)) |
|
|
|
|
721 |
(if dont-check |
(if dont-check |
722 |
(setq nnfolder-current-group group |
(setq nnfolder-current-group group |
723 |
nnfolder-current-buffer nil) |
nnfolder-current-buffer nil) |
724 |
(let (inf file) |
(let (inf file) |
725 |
;; If we have to change groups, see if we don't already have the |
;; If we have to change groups, see if we don't already have |
726 |
;; folder in memory. If we do, verify the modtime and destroy |
;; the folder in memory. If we do, verify the modtime and |
727 |
;; the folder if needed so we can rescan it. |
;; destroy the folder if needed so we can rescan it. |
728 |
(setq nnfolder-current-buffer |
(setq nnfolder-current-buffer |
729 |
(nth 1 (assoc group nnfolder-buffer-alist))) |
(nth 1 (assoc group nnfolder-buffer-alist))) |
730 |
|
|
731 |
;; If the buffer is not live, make sure it isn't in the alist. If it |
;; If the buffer is not live, make sure it isn't in the |
732 |
;; is live, verify that nobody else has touched the file since last |
;; alist. If it is live, verify that nobody else has |
733 |
;; time. |
;; touched the file since last time. |
734 |
(when (and nnfolder-current-buffer |
(when (and nnfolder-current-buffer |
735 |
(not (gnus-buffer-live-p nnfolder-current-buffer))) |
(not (gnus-buffer-live-p nnfolder-current-buffer))) |
736 |
(setq nnfolder-buffer-alist (delq inf nnfolder-buffer-alist) |
(setq nnfolder-buffer-alist (delq inf nnfolder-buffer-alist) |
799 |
(nnfolder-possibly-change-folder (car group-art)) |
(nnfolder-possibly-change-folder (car group-art)) |
800 |
(let ((buffer-read-only nil)) |
(let ((buffer-read-only nil)) |
801 |
(nnfolder-normalize-buffer) |
(nnfolder-normalize-buffer) |
802 |
(insert-buffer-substring obuf beg end))))) |
(insert-buffer-substring obuf beg end)) |
803 |
|
(unless (or gnus-nov-is-evil nnfolder-nov-is-evil) |
804 |
|
(set-buffer obuf) |
805 |
|
(nnfolder-add-nov (car group-art) (cdr group-art) |
806 |
|
(nnfolder-parse-head nil beg end)))))) |
807 |
|
|
808 |
;; Did we save it anywhere? |
;; Did we save it anywhere? |
809 |
save-list)) |
save-list)) |
813 |
(goto-char (point-max)) |
(goto-char (point-max)) |
814 |
(skip-chars-backward "\n") |
(skip-chars-backward "\n") |
815 |
(delete-region (point) (point-max)) |
(delete-region (point) (point-max)) |
816 |
(insert "\n\n")) |
(unless (bobp) |
817 |
|
(insert "\n\n"))) |
818 |
|
|
819 |
(defun nnfolder-insert-newsgroup-line (group-art) |
(defun nnfolder-insert-newsgroup-line (group-art) |
820 |
(save-excursion |
(save-excursion |
850 |
(push (list group (nnfolder-read-folder group)) |
(push (list group (nnfolder-read-folder group)) |
851 |
nnfolder-buffer-alist)))) |
nnfolder-buffer-alist)))) |
852 |
|
|
853 |
;; This method has a problem if you've accidentally let the active list get |
;; This method has a problem if you've accidentally let the active |
854 |
;; out of sync with the files. This could happen, say, if you've |
;; list get out of sync with the files. This could happen, say, if |
855 |
;; accidentally gotten new mail with something other than Gnus (but why |
;; you've accidentally gotten new mail with something other than Gnus |
856 |
;; would _that_ ever happen? :-). In that case, we will be in the middle of |
;; (but why would _that_ ever happen? :-). In that case, we will be |
857 |
;; processing the file, ready to add new X-Gnus article number markers, and |
;; in the middle of processing the file, ready to add new X-Gnus |
858 |
;; we'll run across a message with no ID yet - the active list _may_not_ be |
;; article number markers, and we'll run across a message with no ID |
859 |
;; ready for us yet. |
;; yet - the active list _may_not_ be ready for us yet. |
860 |
|
|
861 |
;; To handle this, I'm modifying this routine to maintain the maximum ID seen |
;; To handle this, I'm modifying this routine to maintain the maximum |
862 |
;; so far, and when we hit a message with no ID, we will _manually_ scan the |
;; ID seen so far, and when we hit a message with no ID, we will |
863 |
;; rest of the message looking for any more, possibly higher IDs. We'll |
;; _manually_ scan the rest of the message looking for any more, |
864 |
;; assume the maximum that we find is the highest active. Note that this |
;; possibly higher IDs. We'll assume the maximum that we find is the |
865 |
;; shouldn't cost us much extra time at all, but will be a lot less |
;; highest active. Note that this shouldn't cost us much extra time |
866 |
;; vulnerable to glitches between the mbox and the active file. |
;; at all, but will be a lot less vulnerable to glitches between the |
867 |
|
;; mbox and the active file. |
868 |
|
|
869 |
(defun nnfolder-read-folder (group) |
(defun nnfolder-read-folder (group) |
870 |
(let* ((file (nnfolder-group-pathname group)) |
(let* ((file (nnfolder-group-pathname group)) |
871 |
|
(nov (nnfolder-group-nov-pathname group)) |
872 |
(buffer (set-buffer |
(buffer (set-buffer |
873 |
(let ((nnheader-file-coding-system |
(let ((nnheader-file-coding-system |
874 |
nnfolder-file-coding-system)) |
nnfolder-file-coding-system)) |
898 |
(scantime (assoc group nnfolder-scantime-alist)) |
(scantime (assoc group nnfolder-scantime-alist)) |
899 |
(minid (lsh -1 -1)) |
(minid (lsh -1 -1)) |
900 |
maxid start end newscantime |
maxid start end newscantime |
901 |
|
novbuf articles newnum |
902 |
buffer-read-only) |
buffer-read-only) |
903 |
(buffer-disable-undo) |
(buffer-disable-undo) |
904 |
(setq maxid (cdr active)) |
(setq maxid (cdr active)) |
905 |
|
|
906 |
|
(unless (or gnus-nov-is-evil nnfolder-nov-is-evil |
907 |
|
(and (file-exists-p nov) |
908 |
|
(file-newer-than-file-p nov file))) |
909 |
|
(unless (file-exists-p nov) |
910 |
|
(gnus-make-directory (file-name-directory nov))) |
911 |
|
(with-current-buffer |
912 |
|
(setq novbuf (nnfolder-open-nov group)) |
913 |
|
(goto-char (point-min)) |
914 |
|
(while (not (eobp)) |
915 |
|
(push (read novbuf) articles) |
916 |
|
(forward-line 1)) |
917 |
|
(setq articles (nreverse articles)))) |
918 |
(goto-char (point-min)) |
(goto-char (point-min)) |
919 |
|
|
920 |
;; Anytime the active number is 1 or 0, it is suspect. In that |
;; Anytime the active number is 1 or 0, it is suspect. In |
921 |
;; case, search the file manually to find the active number. Or, |
;; that case, search the file manually to find the active |
922 |
;; of course, if we're being paranoid. (This would also be the |
;; number. Or, of course, if we're being paranoid. (This |
923 |
;; place to build other lists from the header markers, such as |
;; would also be the place to build other lists from the |
924 |
;; expunge lists, etc., if we ever desired to abandon the active |
;; header markers, such as expunge lists, etc., if we ever |
925 |
;; file entirely for mboxes.) |
;; desired to abandon the active file entirely for mboxes.) |
926 |
(when (or nnfolder-ignore-active-file |
(when (or nnfolder-ignore-active-file |
927 |
|
novbuf |
928 |
(< maxid 2)) |
(< maxid 2)) |
929 |
(while (and (search-forward marker nil t) |
(while (and (search-forward marker nil t) |
930 |
(re-search-forward number nil t)) |
(looking-at number)) |
931 |
(let ((newnum (string-to-number (match-string 0)))) |
(setq newnum (string-to-number (match-string 0))) |
932 |
(if (nnmail-within-headers-p) |
(when (nnmail-within-headers-p) |
933 |
(setq maxid (max maxid newnum) |
(setq maxid (max maxid newnum) |
934 |
minid (min minid newnum))))) |
minid (min minid newnum)) |
935 |
|
(when novbuf |
936 |
|
(if (memq newnum articles) |
937 |
|
(setq articles (delq newnum articles)) |
938 |
|
(let ((headers (nnfolder-parse-head newnum))) |
939 |
|
(with-current-buffer novbuf |
940 |
|
(nnheader-find-nov-line newnum) |
941 |
|
(nnheader-insert-nov headers))))))) |
942 |
|
(when (and novbuf articles) |
943 |
|
(with-current-buffer novbuf |
944 |
|
(dolist (article articles) |
945 |
|
(when (nnheader-find-nov-line article) |
946 |
|
(delete-region (point) |
947 |
|
(progn (forward-line 1) (point))))))) |
948 |
(setcar active (max 1 (min minid maxid))) |
(setcar active (max 1 (min minid maxid))) |
949 |
(setcdr active (max maxid (cdr active))) |
(setcdr active (max maxid (cdr active))) |
950 |
(goto-char (point-min))) |
(goto-char (point-min))) |
951 |
|
|
952 |
;; As long as we trust that the user will only insert unmarked mail |
;; As long as we trust that the user will only insert |
953 |
;; at the end, go to the end and search backwards for the last |
;; unmarked mail at the end, go to the end and search |
954 |
;; marker. Find the start of that message, and begin to search for |
;; backwards for the last marker. Find the start of that |
955 |
;; unmarked messages from there. |
;; message, and begin to search for unmarked messages from |
956 |
|
;; there. |
957 |
(when (not (or nnfolder-distrust-mbox |
(when (not (or nnfolder-distrust-mbox |
958 |
(< maxid 2))) |
(< maxid 2))) |
959 |
(goto-char (point-max)) |
(goto-char (point-max)) |
960 |
(unless (re-search-backward marker nil t) |
(unless (re-search-backward marker nil t) |
961 |
(goto-char (point-min))) |
(goto-char (point-min))) |
962 |
(when (nnmail-search-unix-mail-delim) |
;;(when (nnmail-search-unix-mail-delim) |
963 |
(goto-char (point-min)))) |
;; (goto-char (point-min))) |
964 |
|
) |
965 |
;; Keep track of the active number on our own, and insert it back |
|
966 |
;; into the active list when we're done. Also, prime the pump to |
;; Keep track of the active number on our own, and insert it |
967 |
;; cut down on the number of searches we do. |
;; back into the active list when we're done. Also, prime |
968 |
|
;; the pump to cut down on the number of searches we do. |
969 |
(unless (nnmail-search-unix-mail-delim) |
(unless (nnmail-search-unix-mail-delim) |
970 |
(goto-char (point-max))) |
(goto-char (point-max))) |
971 |
(setq end (point-marker)) |
(setq end (point-marker)) |
972 |
(while (not (= end (point-max))) |
(while (not (= end (point-max))) |
973 |
(setq start (marker-position end)) |
(setq start (marker-position end)) |
974 |
(goto-char end) |
(goto-char end) |
975 |
;; There may be more than one "From " line, so we skip past |
;; There may be more than one "From " line, so we skip past |
976 |
;; them. |
;; them. |
977 |
(while (looking-at delim) |
(while (looking-at delim) |
978 |
(forward-line 1)) |
(forward-line 1)) |
984 |
(narrow-to-region start end) |
(narrow-to-region start end) |
985 |
(nnmail-insert-lines) |
(nnmail-insert-lines) |
986 |
(nnfolder-insert-newsgroup-line |
(nnfolder-insert-newsgroup-line |
987 |
(cons nil (nnfolder-active-number nnfolder-current-group))) |
(cons nil |
988 |
|
(setq newnum |
989 |
|
(nnfolder-active-number group)))) |
990 |
|
(when novbuf |
991 |
|
(let ((headers (nnfolder-parse-head newnum (point-min) |
992 |
|
(point-max)))) |
993 |
|
(with-current-buffer novbuf |
994 |
|
(goto-char (point-max)) |
995 |
|
(nnheader-insert-nov headers)))) |
996 |
(widen))) |
(widen))) |
997 |
|
|
998 |
(set-marker end nil) |
(set-marker end nil) |
999 |
;; Make absolutely sure that the active list reflects reality! |
;; Make absolutely sure that the active list reflects |
1000 |
|
;; reality! |
1001 |
(nnfolder-save-active nnfolder-group-alist nnfolder-active-file) |
(nnfolder-save-active nnfolder-group-alist nnfolder-active-file) |
1002 |
|
|
1003 |
;; Set the scantime for this group. |
;; Set the scantime for this group. |
1004 |
(setq newscantime (visited-file-modtime)) |
(setq newscantime (visited-file-modtime)) |
1005 |
(if scantime |
(if scantime |
1006 |
(setcdr scantime (list newscantime)) |
(setcdr scantime (list newscantime)) |
1007 |
(push (list nnfolder-current-group newscantime) |
(push (list group newscantime) |
1008 |
nnfolder-scantime-alist)) |
nnfolder-scantime-alist)) |
1009 |
|
;; Save nov. |
1010 |
|
(when novbuf |
1011 |
|
(nnfolder-save-nov)) |
1012 |
(current-buffer)))))) |
(current-buffer)))))) |
1013 |
|
|
1014 |
;;;###autoload |
;;;###autoload |
1017 |
This command does not work if you use short group names." |
This command does not work if you use short group names." |
1018 |
(interactive) |
(interactive) |
1019 |
(nnmail-activate 'nnfolder) |
(nnmail-activate 'nnfolder) |
1020 |
|
(unless (or gnus-nov-is-evil nnfolder-nov-is-evil) |
1021 |
|
(dolist (file (directory-files (or nnfolder-nov-directory |
1022 |
|
nnfolder-directory) |
1023 |
|
t |
1024 |
|
(concat |
1025 |
|
(regexp-quote nnfolder-nov-file-suffix) |
1026 |
|
"$"))) |
1027 |
|
(when (not (message-mail-file-mbox-p file)) |
1028 |
|
(ignore-errors |
1029 |
|
(delete-file file))))) |
1030 |
(let ((files (directory-files nnfolder-directory)) |
(let ((files (directory-files nnfolder-directory)) |
1031 |
file) |
file) |
1032 |
(while (setq file (pop files)) |
(while (setq file (pop files)) |
1033 |
(when (and (not (backup-file-name-p file)) |
(when (and (not (backup-file-name-p file)) |
1034 |
(message-mail-file-mbox-p |
(message-mail-file-mbox-p |
1035 |
(nnheader-concat nnfolder-directory file))) |
(nnheader-concat nnfolder-directory file))) |
1036 |
(let ((oldgroup (assoc file nnfolder-group-alist))) |
(let ((oldgroup (assoc file nnfolder-group-alist))) |
1037 |
(if oldgroup |
(if oldgroup |
1038 |
(nnheader-message 5 "Refreshing group %s..." file) |
(nnheader-message 5 "Refreshing group %s..." file) |
1039 |
(nnheader-message 5 "Adding group %s..." file)) |
(nnheader-message 5 "Adding group %s..." file)) |
1040 |
(if oldgroup |
(if oldgroup |
1041 |
(setq nnfolder-group-alist |
(setq nnfolder-group-alist |
1042 |
(delq oldgroup (copy-sequence nnfolder-group-alist)))) |
(delq oldgroup (copy-sequence nnfolder-group-alist)))) |
1043 |
(push (list file (cons 1 0)) nnfolder-group-alist) |
(push (list file (cons 1 0)) nnfolder-group-alist) |
1044 |
(nnfolder-possibly-change-folder file) |
(nnfolder-possibly-change-folder file) |
1045 |
(nnfolder-possibly-change-group file) |
(nnfolder-possibly-change-group file) |
1046 |
(nnfolder-close-group file)))) |
(nnfolder-close-group file)))) |
1047 |
(nnheader-message 5 ""))) |
(nnheader-message 5 ""))) |
1048 |
|
|
1049 |
(defun nnfolder-group-pathname (group) |
(defun nnfolder-group-pathname (group) |
1058 |
;; If not, we translate dots into slashes. |
;; If not, we translate dots into slashes. |
1059 |
(concat dir (nnheader-replace-chars-in-string group ?. ?/))))) |
(concat dir (nnheader-replace-chars-in-string group ?. ?/))))) |
1060 |
|
|
1061 |
|
(defun nnfolder-group-nov-pathname (group) |
1062 |
|
"Make pathname for GROUP NOV." |
1063 |
|
(let ((nnfolder-directory |
1064 |
|
(or nnfolder-nov-directory nnfolder-directory))) |
1065 |
|
(concat (nnfolder-group-pathname group) nnfolder-nov-file-suffix))) |
1066 |
|
|
1067 |
(defun nnfolder-save-buffer () |
(defun nnfolder-save-buffer () |
1068 |
"Save the buffer." |
"Save the buffer." |
1069 |
(when (buffer-modified-p) |
(when (buffer-modified-p) |
1072 |
(let ((coding-system-for-write |
(let ((coding-system-for-write |
1073 |
(or nnfolder-file-coding-system-for-write |
(or nnfolder-file-coding-system-for-write |
1074 |
nnfolder-file-coding-system))) |
nnfolder-file-coding-system))) |
1075 |
(save-buffer)))) |
(save-buffer))) |
1076 |
|
(unless (or gnus-nov-is-evil nnfolder-nov-is-evil) |
1077 |
|
(nnfolder-save-nov))) |
1078 |
|
|
1079 |
(defun nnfolder-save-active (group-alist active-file) |
(defun nnfolder-save-active (group-alist active-file) |
1080 |
(let ((nnmail-active-file-coding-system |
(let ((nnmail-active-file-coding-system |
1082 |
nnfolder-active-file-coding-system))) |
nnfolder-active-file-coding-system))) |
1083 |
(nnmail-save-active group-alist active-file))) |
(nnmail-save-active group-alist active-file))) |
1084 |
|
|
1085 |
|
(defun nnfolder-open-nov (group) |
1086 |
|
(or (cdr (assoc group nnfolder-nov-buffer-alist)) |
1087 |
|
(let ((buffer (get-buffer-create (format " *nnfolder overview %s*" group)))) |
1088 |
|
(save-excursion |
1089 |
|
(set-buffer buffer) |
1090 |
|
(set (make-local-variable 'nnfolder-nov-buffer-file-name) |
1091 |
|
(nnfolder-group-nov-pathname group)) |
1092 |
|
(erase-buffer) |
1093 |
|
(when (file-exists-p nnfolder-nov-buffer-file-name) |
1094 |
|
(nnheader-insert-file-contents nnfolder-nov-buffer-file-name))) |
1095 |
|
(push (cons group buffer) nnfolder-nov-buffer-alist) |
1096 |
|
buffer))) |
1097 |
|
|
1098 |
|
(defun nnfolder-save-nov () |
1099 |
|
(save-excursion |
1100 |
|
(while nnfolder-nov-buffer-alist |
1101 |
|
(when (buffer-name (cdar nnfolder-nov-buffer-alist)) |
1102 |
|
(set-buffer (cdar nnfolder-nov-buffer-alist)) |
1103 |
|
(when (buffer-modified-p) |
1104 |
|
(gnus-make-directory (file-name-directory |
1105 |
|
nnfolder-nov-buffer-file-name)) |
1106 |
|
(nnmail-write-region 1 (point-max) nnfolder-nov-buffer-file-name |
1107 |
|
nil 'nomesg)) |
1108 |
|
(set-buffer-modified-p nil) |
1109 |
|
(kill-buffer (current-buffer))) |
1110 |
|
(setq nnfolder-nov-buffer-alist (cdr nnfolder-nov-buffer-alist))))) |
1111 |
|
|
1112 |
|
(defun nnfolder-nov-delete-article (group article) |
1113 |
|
(save-excursion |
1114 |
|
(set-buffer (nnfolder-open-nov group)) |
1115 |
|
(when (nnheader-find-nov-line article) |
1116 |
|
(delete-region (point) (progn (forward-line 1) (point)))) |
1117 |
|
t)) |
1118 |
|
|
1119 |
|
(defun nnfolder-retrieve-headers-with-nov (articles &optional fetch-old) |
1120 |
|
(if (or gnus-nov-is-evil nnfolder-nov-is-evil) |
1121 |
|
nil |
1122 |
|
(let ((nov (nnfolder-group-nov-pathname nnfolder-current-group))) |
1123 |
|
(when (file-exists-p nov) |
1124 |
|
(save-excursion |
1125 |
|
(set-buffer nntp-server-buffer) |
1126 |
|
(erase-buffer) |
1127 |
|
(nnheader-insert-file-contents nov) |
1128 |
|
(if (and fetch-old |
1129 |
|
(not (numberp fetch-old))) |
1130 |
|
t ; Don't remove anything. |
1131 |
|
(nnheader-nov-delete-outside-range |
1132 |
|
(if fetch-old (max 1 (- (car articles) fetch-old)) |
1133 |
|
(car articles)) |
1134 |
|
(car (last articles))) |
1135 |
|
t)))))) |
1136 |
|
|
1137 |
|
(defun nnfolder-parse-head (&optional number b e) |
1138 |
|
"Parse the head of the current buffer." |
1139 |
|
(let ((buf (current-buffer)) |
1140 |
|
chars) |
1141 |
|
(save-excursion |
1142 |
|
(unless b |
1143 |
|
(setq b (if (nnmail-search-unix-mail-delim-backward) |
1144 |
|
(point) (point-min))) |
1145 |
|
(forward-line 1) |
1146 |
|
(setq e (if (nnmail-search-unix-mail-delim) |
1147 |
|
(point) (point-max)))) |
1148 |
|
(setq chars (- e b)) |
1149 |
|
(unless (zerop chars) |
1150 |
|
(goto-char b) |
1151 |
|
(if (search-forward "\n\n" e t) (setq e (1- (point))))) |
1152 |
|
(with-temp-buffer |
1153 |
|
(insert-buffer-substring buf b e) |
1154 |
|
(let ((headers (nnheader-parse-naked-head))) |
1155 |
|
(mail-header-set-chars headers chars) |
1156 |
|
(mail-header-set-number headers number) |
1157 |
|
headers))))) |
1158 |
|
|
1159 |
|
(defun nnfolder-add-nov (group article headers) |
1160 |
|
"Add a nov line for the GROUP base." |
1161 |
|
(save-excursion |
1162 |
|
(set-buffer (nnfolder-open-nov group)) |
1163 |
|
(goto-char (point-max)) |
1164 |
|
(mail-header-set-number headers article) |
1165 |
|
(nnheader-insert-nov headers))) |
1166 |
|
|
1167 |
|
(deffoo nnfolder-request-set-mark (group actions &optional server) |
1168 |
|
(when (and server |
1169 |
|
(not (nnfolder-server-opened server))) |
1170 |
|
(nnfolder-open-server server)) |
1171 |
|
(unless nnfolder-marks-is-evil |
1172 |
|
(nnfolder-open-marks group server) |
1173 |
|
(dolist (action actions) |
1174 |
|
(let ((range (nth 0 action)) |
1175 |
|
(what (nth 1 action)) |
1176 |
|
(marks (nth 2 action))) |
1177 |
|
(assert (or (eq what 'add) (eq what 'del)) t |
1178 |
|
"Unknown request-set-mark action: %s" what) |
1179 |
|
(dolist (mark marks) |
1180 |
|
(setq nnfolder-marks (gnus-update-alist-soft |
1181 |
|
mark |
1182 |
|
(funcall (if (eq what 'add) 'gnus-range-add |
1183 |
|
'gnus-remove-from-range) |
1184 |
|
(cdr (assoc mark nnfolder-marks)) range) |
1185 |
|
nnfolder-marks))))) |
1186 |
|
(nnfolder-save-marks group server)) |
1187 |
|
nil) |
1188 |
|
|
1189 |
|
(deffoo nnfolder-request-update-info (group info &optional server) |
1190 |
|
;; Change servers. |
1191 |
|
(when (and server |
1192 |
|
(not (nnfolder-server-opened server))) |
1193 |
|
(nnfolder-open-server server)) |
1194 |
|
(when (and (not nnfolder-marks-is-evil) (nnfolder-marks-changed-p group)) |
1195 |
|
(nnheader-message 8 "Updating marks for %s..." group) |
1196 |
|
(nnfolder-open-marks group server) |
1197 |
|
;; Update info using `nnfolder-marks'. |
1198 |
|
(mapcar (lambda (pred) |
1199 |
|
(unless (memq (cdr pred) gnus-article-unpropagated-mark-lists) |
1200 |
|
(gnus-info-set-marks |
1201 |
|
info |
1202 |
|
(gnus-update-alist-soft |
1203 |
|
(cdr pred) |
1204 |
|
(cdr (assq (cdr pred) nnfolder-marks)) |
1205 |
|
(gnus-info-marks info)) |
1206 |
|
t))) |
1207 |
|
gnus-article-mark-lists) |
1208 |
|
(let ((seen (cdr (assq 'read nnfolder-marks)))) |
1209 |
|
(gnus-info-set-read info |
1210 |
|
(if (and (integerp (car seen)) |
1211 |
|
(null (cdr seen))) |
1212 |
|
(list (cons (car seen) (car seen))) |
1213 |
|
seen))) |
1214 |
|
(nnheader-message 8 "Updating marks for %s...done" group)) |
1215 |
|
info) |
1216 |
|
|
1217 |
|
(defun nnfolder-group-marks-pathname (group) |
1218 |
|
"Make pathname for GROUP NOV." |
1219 |
|
(let ((nnfolder-directory (or nnfolder-marks-directory nnfolder-directory))) |
1220 |
|
(concat (nnfolder-group-pathname group) nnfolder-marks-file-suffix))) |
1221 |
|
|
1222 |
|
(defun nnfolder-marks-changed-p (group) |
1223 |
|
(let ((file (nnfolder-group-marks-pathname group))) |
1224 |
|
(if (null (gnus-gethash file nnfolder-marks-modtime)) |
1225 |
|
t ;; never looked at marks file, assume it has changed |
1226 |
|
(not (equal (gnus-gethash file nnfolder-marks-modtime) |
1227 |
|
(nth 5 (file-attributes file))))))) |
1228 |
|
|
1229 |
|
(defun nnfolder-save-marks (group server) |
1230 |
|
(let ((file-name-coding-system nnmail-pathname-coding-system) |
1231 |
|
(file (nnfolder-group-marks-pathname group))) |
1232 |
|
(condition-case err |
1233 |
|
(progn |
1234 |
|
(with-temp-file file |
1235 |
|
(erase-buffer) |
1236 |
|
(gnus-prin1 nnfolder-marks) |
1237 |
|
(insert "\n")) |
1238 |
|
(gnus-sethash file |
1239 |
|
(nth 5 (file-attributes file)) |
1240 |
|
nnfolder-marks-modtime)) |
1241 |
|
(error (or (gnus-yes-or-no-p |
1242 |
|
(format "Could not write to %s (%s). Continue? " file err)) |
1243 |
|
(error "Cannot write to %s (%s)" err)))))) |
1244 |
|
|
1245 |
|
(defun nnfolder-open-marks (group server) |
1246 |
|
(let ((file (nnfolder-group-marks-pathname group))) |
1247 |
|
(if (file-exists-p file) |
1248 |
|
(condition-case err |
1249 |
|
(with-temp-buffer |
1250 |
|
(gnus-sethash file (nth 5 (file-attributes file)) |
1251 |
|
nnfolder-marks-modtime) |
1252 |
|
(nnheader-insert-file-contents file) |
1253 |
|
(setq nnfolder-marks (read (current-buffer))) |
1254 |
|
(dolist (el gnus-article-unpropagated-mark-lists) |
1255 |
|
(setq nnfolder-marks (gnus-remassoc el nnfolder-marks)))) |
1256 |
|
(error (or (gnus-yes-or-no-p |
1257 |
|
(format "Error reading nnfolder marks file %s (%s). Continuing will use marks from .newsrc.eld. Continue? " file err)) |
1258 |
|
(error "Cannot read nnfolder marks file %s (%s)" file err)))) |
1259 |
|
;; User didn't have a .marks file. Probably first time |
1260 |
|
;; user of the .marks stuff. Bootstrap it from .newsrc.eld. |
1261 |
|
(let ((info (gnus-get-info |
1262 |
|
(gnus-group-prefixed-name |
1263 |
|
group |
1264 |
|
(gnus-server-to-method (format "nnfolder:%s" server)))))) |
1265 |
|
(nnheader-message 7 "Bootstrapping marks for %s..." group) |
1266 |
|
(setq nnfolder-marks (gnus-info-marks info)) |
1267 |
|
(push (cons 'read (gnus-info-read info)) nnfolder-marks) |
1268 |
|
(dolist (el gnus-article-unpropagated-mark-lists) |
1269 |
|
(setq nnfolder-marks (gnus-remassoc el nnfolder-marks))) |
1270 |
|
(nnfolder-save-marks group server) |
1271 |
|
(nnheader-message 7 "Bootstrapping marks for %s...done" group))))) |
1272 |
|
|
1273 |
(provide 'nnfolder) |
(provide 'nnfolder) |
1274 |
|
|
1275 |
;;; arch-tag: a040d0f4-4f4e-445f-8972-839575c5f7e6 |
;;; arch-tag: a040d0f4-4f4e-445f-8972-839575c5f7e6 |