Mercurial > emacs
comparison lisp/nnfolder.el @ 13401:178d730efae2
entered into RCS
author | Lars Magne Ingebrigtsen <larsi@gnus.org> |
---|---|
date | Sat, 04 Nov 1995 03:54:42 +0000 |
parents | |
children | 187735b53d52 |
comparison
equal
deleted
inserted
replaced
13400:4a57cda2a39a | 13401:178d730efae2 |
---|---|
1 ;;; nnfolder.el --- mail folder access for Gnus | |
2 ;; Copyright (C) 1995 Free Software Foundation, Inc. | |
3 | |
4 ;; Author: Scott Byer <byer@mv.us.adobe.com> | |
5 ;; Lars Magne Ingebrigtsen <larsi@ifi.uio.no> | |
6 ;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet> | |
7 ;; Keywords: news, mail | |
8 | |
9 ;; This file is part of GNU Emacs. | |
10 | |
11 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
12 ;; it under the terms of the GNU General Public License as published by | |
13 ;; the Free Software Foundation; either version 2, or (at your option) | |
14 ;; any later version. | |
15 | |
16 ;; GNU Emacs is distributed in the hope that it will be useful, | |
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
19 ;; GNU General Public License for more details. | |
20 | |
21 ;; You should have received a copy of the GNU General Public License | |
22 ;; along with GNU Emacs; see the file COPYING. If not, write to | |
23 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. | |
24 | |
25 ;;; Commentary: | |
26 | |
27 ;; For an overview of what the interface functions do, please see the | |
28 ;; Gnus sources. | |
29 | |
30 ;; Various enhancements by byer@mv.us.adobe.com (Scott Byer). | |
31 | |
32 ;;; Code: | |
33 | |
34 (require 'nnheader) | |
35 (require 'rmail) | |
36 (require 'nnmail) | |
37 | |
38 (defvar nnfolder-directory (expand-file-name "~/Mail/") | |
39 "The name of the mail box file in the users home directory.") | |
40 | |
41 (defvar nnfolder-active-file | |
42 (concat (file-name-as-directory nnfolder-directory) "active") | |
43 "The name of the active file.") | |
44 | |
45 ;; I renamed this variable to somehting more in keeping with the general GNU | |
46 ;; style. -SLB | |
47 | |
48 (defvar nnfolder-ignore-active-file nil | |
49 "If non-nil, causes nnfolder to do some extra work in order to determine the true active ranges of an mbox file. | |
50 Note that the active file is still saved, but it's values are not | |
51 used. This costs some extra time when scanning an mbox when opening | |
52 it.") | |
53 | |
54 ;; Note that this variable may not be completely implemented yet. -SLB | |
55 | |
56 (defvar nnfolder-always-close nil | |
57 "If non-nil, nnfolder attempts to only ever have one mbox open at a time. | |
58 This is a straight space/performance trade off, as the mboxes will have to | |
59 be scanned every time they are read in. If nil (default), nnfolder will | |
60 attempt to keep the buffers around (saving the nnfolder's buffer upon group | |
61 close, but not killing it), speeding some things up tremendously, especially | |
62 such things as moving mail. All buffers always get killed upon server close.") | |
63 | |
64 (defvar nnfolder-newsgroups-file | |
65 (concat (file-name-as-directory nnfolder-directory) "newsgroups") | |
66 "Mail newsgroups description file.") | |
67 | |
68 (defvar nnfolder-get-new-mail t | |
69 "If non-nil, nnfolder will check the incoming mail file and split the mail.") | |
70 | |
71 (defvar nnfolder-prepare-save-mail-hook nil | |
72 "Hook run narrowed to an article before saving.") | |
73 | |
74 | |
75 | |
76 (defconst nnfolder-version "nnfolder 1.0" | |
77 "nnfolder version.") | |
78 | |
79 (defconst nnfolder-article-marker "X-Gnus-Article-Number: " | |
80 "String used to demarcate what the article number for a message is.") | |
81 | |
82 (defvar nnfolder-current-group nil) | |
83 (defvar nnfolder-current-buffer nil) | |
84 (defvar nnfolder-status-string "") | |
85 (defvar nnfolder-group-alist nil) | |
86 (defvar nnfolder-buffer-alist nil) | |
87 (defvar nnfolder-active-timestamp nil) | |
88 | |
89 (defmacro nnfolder-article-string (article) | |
90 (` (concat "\n" nnfolder-article-marker (int-to-string (, article)) " "))) | |
91 | |
92 | |
93 | |
94 (defvar nnfolder-current-server nil) | |
95 (defvar nnfolder-server-alist nil) | |
96 (defvar nnfolder-server-variables | |
97 (list | |
98 (list 'nnfolder-directory nnfolder-directory) | |
99 (list 'nnfolder-active-file nnfolder-active-file) | |
100 (list 'nnfolder-newsgroups-file nnfolder-newsgroups-file) | |
101 (list 'nnfolder-get-new-mail nnfolder-get-new-mail) | |
102 '(nnfolder-current-group nil) | |
103 '(nnfolder-current-buffer nil) | |
104 '(nnfolder-status-string "") | |
105 '(nnfolder-group-alist nil) | |
106 '(nnfolder-buffer-alist nil) | |
107 '(nnfolder-active-timestamp nil))) | |
108 | |
109 | |
110 | |
111 ;;; Interface functions | |
112 | |
113 (defun nnfolder-retrieve-headers (sequence &optional newsgroup server) | |
114 (save-excursion | |
115 (set-buffer nntp-server-buffer) | |
116 (erase-buffer) | |
117 (let ((delim-string (concat "^" rmail-unix-mail-delimiter)) | |
118 article art-string start stop) | |
119 (nnfolder-possibly-change-group newsgroup) | |
120 (set-buffer nnfolder-current-buffer) | |
121 (goto-char (point-min)) | |
122 (if (stringp (car sequence)) | |
123 'headers | |
124 (while sequence | |
125 (setq article (car sequence)) | |
126 (setq art-string (nnfolder-article-string article)) | |
127 (set-buffer nnfolder-current-buffer) | |
128 (if (or (search-forward art-string nil t) | |
129 ;; Don't search the whole file twice! Also, articles | |
130 ;; probably have some locality by number, so searching | |
131 ;; backwards will be faster. Especially if we're at the | |
132 ;; beginning of the buffer :-). -SLB | |
133 (search-backward art-string nil t)) | |
134 (progn | |
135 (setq start (or (re-search-backward delim-string nil t) | |
136 (point))) | |
137 (search-forward "\n\n" nil t) | |
138 (setq stop (1- (point))) | |
139 (set-buffer nntp-server-buffer) | |
140 (insert (format "221 %d Article retrieved.\n" article)) | |
141 (insert-buffer-substring nnfolder-current-buffer start stop) | |
142 (goto-char (point-max)) | |
143 (insert ".\n"))) | |
144 (setq sequence (cdr sequence))) | |
145 | |
146 ;; Fold continuation lines. | |
147 (set-buffer nntp-server-buffer) | |
148 (goto-char (point-min)) | |
149 (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t) | |
150 (replace-match " " t t)) | |
151 'headers)))) | |
152 | |
153 (defun nnfolder-open-server (server &optional defs) | |
154 (nnheader-init-server-buffer) | |
155 (if (equal server nnfolder-current-server) | |
156 t | |
157 (if nnfolder-current-server | |
158 (setq nnfolder-server-alist | |
159 (cons (list nnfolder-current-server | |
160 (nnheader-save-variables nnfolder-server-variables)) | |
161 nnfolder-server-alist))) | |
162 (let ((state (assoc server nnfolder-server-alist))) | |
163 (if state | |
164 (progn | |
165 (nnheader-restore-variables (nth 1 state)) | |
166 (setq nnfolder-server-alist (delq state nnfolder-server-alist))) | |
167 (nnheader-set-init-variables nnfolder-server-variables defs))) | |
168 (setq nnfolder-current-server server))) | |
169 | |
170 (defun nnfolder-close-server (&optional server) | |
171 t) | |
172 | |
173 (defun nnfolder-server-opened (&optional server) | |
174 (and (equal server nnfolder-current-server) | |
175 nntp-server-buffer | |
176 (buffer-name nntp-server-buffer))) | |
177 | |
178 (defun nnfolder-request-close () | |
179 (let ((alist nnfolder-buffer-alist)) | |
180 (while alist | |
181 (nnfolder-close-group (car (car alist)) nil t) | |
182 (setq alist (cdr alist)))) | |
183 (setq nnfolder-buffer-alist nil | |
184 nnfolder-group-alist nil)) | |
185 | |
186 (defun nnfolder-status-message (&optional server) | |
187 nnfolder-status-string) | |
188 | |
189 (defun nnfolder-request-article (article &optional newsgroup server buffer) | |
190 (nnfolder-possibly-change-group newsgroup) | |
191 (if (stringp article) | |
192 nil | |
193 (save-excursion | |
194 (set-buffer nnfolder-current-buffer) | |
195 (goto-char (point-min)) | |
196 (if (search-forward (nnfolder-article-string article) nil t) | |
197 (let (start stop) | |
198 (re-search-backward (concat "^" rmail-unix-mail-delimiter) nil t) | |
199 (setq start (point)) | |
200 (forward-line 1) | |
201 (or (and (re-search-forward | |
202 (concat "^" rmail-unix-mail-delimiter) nil t) | |
203 (forward-line -1)) | |
204 (goto-char (point-max))) | |
205 (setq stop (point)) | |
206 (let ((nntp-server-buffer (or buffer nntp-server-buffer))) | |
207 (set-buffer nntp-server-buffer) | |
208 (erase-buffer) | |
209 (insert-buffer-substring nnfolder-current-buffer start stop) | |
210 (goto-char (point-min)) | |
211 (while (looking-at "From ") | |
212 (delete-char 5) | |
213 (insert "X-From-Line: ") | |
214 (forward-line 1)) | |
215 t)))))) | |
216 | |
217 (defun nnfolder-request-group (group &optional server dont-check) | |
218 (save-excursion | |
219 (nnmail-activate 'nnfolder) | |
220 (nnfolder-possibly-change-group group) | |
221 (and (assoc group nnfolder-group-alist) | |
222 (progn | |
223 (if dont-check | |
224 t | |
225 (nnfolder-get-new-mail group) | |
226 (let* ((active (assoc group nnfolder-group-alist)) | |
227 (group (car active)) | |
228 (range (car (cdr active))) | |
229 (minactive (car range)) | |
230 (maxactive (cdr range))) | |
231 ;; I've been getting stray 211 lines in my nnfolder active | |
232 ;; file. So, let's make sure that doesn't happen. -SLB | |
233 (set-buffer nntp-server-buffer) | |
234 (erase-buffer) | |
235 (if (not active) | |
236 () | |
237 (insert (format "211 %d %d %d %s\n" | |
238 (1+ (- maxactive minactive)) | |
239 minactive maxactive group)) | |
240 t))))))) | |
241 | |
242 ;; Don't close the buffer if we're not shutting down the server. This way, | |
243 ;; we can keep the buffer in the group buffer cache, and not have to grovel | |
244 ;; over the buffer again unless we add new mail to it or modify it in some | |
245 ;; way. | |
246 | |
247 (defun nnfolder-close-group (group &optional server force) | |
248 ;; Make sure we _had_ the group open. | |
249 (if (or (assoc group nnfolder-buffer-alist) | |
250 (equal group nnfolder-current-group)) | |
251 (progn | |
252 (nnfolder-possibly-change-group group) | |
253 (save-excursion | |
254 (set-buffer nnfolder-current-buffer) | |
255 ;; If the buffer was modified, write the file out now. | |
256 (and (buffer-modified-p) (save-buffer)) | |
257 (if (or force | |
258 nnfolder-always-close) | |
259 ;; If we're shutting the server down, we need to kill the | |
260 ;; buffer and remove it from the open buffer list. Or, of | |
261 ;; course, if we're trying to minimize our space impact. | |
262 (progn | |
263 (kill-buffer (current-buffer)) | |
264 (setq nnfolder-buffer-alist (delq (assoc group | |
265 nnfolder-buffer-alist) | |
266 nnfolder-buffer-alist))))))) | |
267 (setq nnfolder-current-group nil | |
268 nnfolder-current-buffer nil) | |
269 t) | |
270 | |
271 (defun nnfolder-request-create-group (group &optional server) | |
272 (nnmail-activate 'nnfolder) | |
273 (or (assoc group nnfolder-group-alist) | |
274 (let (active) | |
275 (setq nnfolder-group-alist | |
276 (cons (list group (setq active (cons 1 0))) | |
277 nnfolder-group-alist)) | |
278 (nnmail-save-active nnfolder-group-alist nnfolder-active-file))) | |
279 t) | |
280 | |
281 (defun nnfolder-request-list (&optional server) | |
282 (if server (nnfolder-get-new-mail)) | |
283 (save-excursion | |
284 (nnmail-find-file nnfolder-active-file) | |
285 (setq nnfolder-group-alist (nnmail-get-active)))) | |
286 | |
287 (defun nnfolder-request-newgroups (date &optional server) | |
288 (nnfolder-request-list server)) | |
289 | |
290 (defun nnfolder-request-list-newsgroups (&optional server) | |
291 (save-excursion | |
292 (nnmail-find-file nnfolder-newsgroups-file))) | |
293 | |
294 (defun nnfolder-request-post (&optional server) | |
295 (mail-send-and-exit nil)) | |
296 | |
297 (defalias 'nnfolder-request-post-buffer 'nnmail-request-post-buffer) | |
298 | |
299 (defun nnfolder-request-expire-articles | |
300 (articles newsgroup &optional server force) | |
301 (nnfolder-possibly-change-group newsgroup) | |
302 (let* ((days (or (and nnmail-expiry-wait-function | |
303 (funcall nnmail-expiry-wait-function newsgroup)) | |
304 nnmail-expiry-wait)) | |
305 (is-old t) | |
306 rest) | |
307 (nnmail-activate 'nnfolder) | |
308 | |
309 (save-excursion | |
310 (set-buffer nnfolder-current-buffer) | |
311 (while (and articles is-old) | |
312 (goto-char (point-min)) | |
313 (if (search-forward (nnfolder-article-string (car articles)) nil t) | |
314 (if (or force | |
315 (setq is-old | |
316 (> (nnmail-days-between | |
317 (current-time-string) | |
318 (buffer-substring | |
319 (point) (progn (end-of-line) (point)))) | |
320 days))) | |
321 (progn | |
322 (and gnus-verbose-backends | |
323 (message "Deleting article %s..." (car articles))) | |
324 (nnfolder-delete-mail)) | |
325 (setq rest (cons (car articles) rest)))) | |
326 (setq articles (cdr articles))) | |
327 (and (buffer-modified-p) (save-buffer)) | |
328 ;; Find the lowest active article in this group. | |
329 (let* ((active (car (cdr (assoc newsgroup nnfolder-group-alist)))) | |
330 (marker (concat "\n" nnfolder-article-marker)) | |
331 (number "[0-9]+") | |
332 (activemin (cdr active))) | |
333 (goto-char (point-min)) | |
334 (while (and (search-forward marker nil t) | |
335 (re-search-forward number nil t)) | |
336 (setq activemin (min activemin | |
337 (string-to-number (buffer-substring | |
338 (match-beginning 0) | |
339 (match-end 0)))))) | |
340 (setcar active activemin)) | |
341 (nnmail-save-active nnfolder-group-alist nnfolder-active-file) | |
342 (nconc rest articles)))) | |
343 | |
344 (defun nnfolder-request-move-article | |
345 (article group server accept-form &optional last) | |
346 (nnfolder-possibly-change-group group) | |
347 (let ((buf (get-buffer-create " *nnfolder move*")) | |
348 result) | |
349 (and | |
350 (nnfolder-request-article article group server) | |
351 (save-excursion | |
352 (set-buffer buf) | |
353 (buffer-disable-undo (current-buffer)) | |
354 (erase-buffer) | |
355 (insert-buffer-substring nntp-server-buffer) | |
356 (goto-char (point-min)) | |
357 (while (re-search-forward | |
358 (concat "^" nnfolder-article-marker) | |
359 (save-excursion (search-forward "\n\n" nil t) (point)) t) | |
360 (delete-region (progn (beginning-of-line) (point)) | |
361 (progn (forward-line 1) (point)))) | |
362 (setq result (eval accept-form)) | |
363 (kill-buffer buf) | |
364 result) | |
365 (save-excursion | |
366 (nnfolder-possibly-change-group group) | |
367 (set-buffer nnfolder-current-buffer) | |
368 (goto-char (point-min)) | |
369 (if (search-forward (nnfolder-article-string article) nil t) | |
370 (nnfolder-delete-mail)) | |
371 (and last | |
372 (buffer-modified-p) | |
373 (save-buffer)))) | |
374 result)) | |
375 | |
376 (defun nnfolder-request-accept-article (group &optional last) | |
377 (and (stringp group) (nnfolder-possibly-change-group group)) | |
378 (let ((buf (current-buffer)) | |
379 result) | |
380 (goto-char (point-min)) | |
381 (cond ((looking-at "X-From-Line: ") | |
382 (replace-match "From ")) | |
383 ((not (looking-at "From ")) | |
384 (insert "From nobody " (current-time-string) "\n"))) | |
385 (and | |
386 (nnfolder-request-list) | |
387 (save-excursion | |
388 (set-buffer buf) | |
389 (goto-char (point-min)) | |
390 (search-forward "\n\n" nil t) | |
391 (forward-line -1) | |
392 (while (re-search-backward (concat "^" nnfolder-article-marker) nil t) | |
393 (delete-region (point) (progn (forward-line 1) (point)))) | |
394 (setq result (car (nnfolder-save-mail (and (stringp group) group))))) | |
395 (save-excursion | |
396 (set-buffer nnfolder-current-buffer) | |
397 (and last (buffer-modified-p) (save-buffer)))) | |
398 (nnmail-save-active nnfolder-group-alist nnfolder-active-file) | |
399 result)) | |
400 | |
401 (defun nnfolder-request-replace-article (article group buffer) | |
402 (nnfolder-possibly-change-group group) | |
403 (save-excursion | |
404 (set-buffer nnfolder-current-buffer) | |
405 (goto-char (point-min)) | |
406 (if (not (search-forward (nnfolder-article-string article) nil t)) | |
407 nil | |
408 (nnfolder-delete-mail t t) | |
409 (insert-buffer-substring buffer) | |
410 (and (buffer-modified-p) (save-buffer)) | |
411 t))) | |
412 | |
413 | |
414 ;;; Internal functions. | |
415 | |
416 (defun nnfolder-delete-mail (&optional force leave-delim) | |
417 ;; Beginning of the article. | |
418 (save-excursion | |
419 (save-restriction | |
420 (narrow-to-region | |
421 (save-excursion | |
422 (re-search-backward (concat "^" rmail-unix-mail-delimiter) nil t) | |
423 (if leave-delim (progn (forward-line 1) (point)) | |
424 (match-beginning 0))) | |
425 (progn | |
426 (forward-line 1) | |
427 (or (and (re-search-forward (concat "^" rmail-unix-mail-delimiter) | |
428 nil t) | |
429 (if (and (not (bobp)) leave-delim) | |
430 (progn (forward-line -2) (point)) | |
431 (match-beginning 0))) | |
432 (point-max)))) | |
433 (delete-region (point-min) (point-max))))) | |
434 | |
435 (defun nnfolder-possibly-change-group (group) | |
436 (or (file-exists-p nnfolder-directory) | |
437 (make-directory (directory-file-name nnfolder-directory))) | |
438 (nnfolder-possibly-activate-groups nil) | |
439 (or (assoc group nnfolder-group-alist) | |
440 (not (file-exists-p (concat (file-name-as-directory nnfolder-directory) | |
441 group))) | |
442 (progn | |
443 (setq nnfolder-group-alist | |
444 (cons (list group (cons 1 0)) nnfolder-group-alist)) | |
445 (nnmail-save-active nnfolder-group-alist nnfolder-active-file))) | |
446 (let (inf file) | |
447 (if (and (equal group nnfolder-current-group) | |
448 nnfolder-current-buffer | |
449 (buffer-name nnfolder-current-buffer)) | |
450 () | |
451 (setq nnfolder-current-group group) | |
452 | |
453 ;; If we have to change groups, see if we don't already have the mbox | |
454 ;; in memory. If we do, verify the modtime and destroy the mbox if | |
455 ;; needed so we can rescan it. | |
456 (if (setq inf (assoc group nnfolder-buffer-alist)) | |
457 (setq nnfolder-current-buffer (nth 1 inf))) | |
458 | |
459 ;; If the buffer is not live, make sure it isn't in the alist. If it | |
460 ;; is live, verify that nobody else has touched the file since last | |
461 ;; time. | |
462 (if (or (not (and nnfolder-current-buffer | |
463 (buffer-name nnfolder-current-buffer))) | |
464 (not (and (bufferp nnfolder-current-buffer) | |
465 (verify-visited-file-modtime | |
466 nnfolder-current-buffer)))) | |
467 (progn | |
468 (if (and nnfolder-current-buffer | |
469 (buffer-name nnfolder-current-buffer) | |
470 (bufferp nnfolder-current-buffer)) | |
471 (kill-buffer nnfolder-current-buffer)) | |
472 (setq nnfolder-buffer-alist (delq inf nnfolder-buffer-alist)) | |
473 (setq inf nil))) | |
474 | |
475 (if inf | |
476 () | |
477 (save-excursion | |
478 (setq file (concat (file-name-as-directory nnfolder-directory) | |
479 group)) | |
480 (if (file-directory-p (file-truename file)) | |
481 () | |
482 (if (not (file-exists-p file)) | |
483 (write-region 1 1 file t 'nomesg)) | |
484 (setq nnfolder-current-buffer | |
485 (set-buffer (nnfolder-read-folder file))) | |
486 (setq nnfolder-buffer-alist (cons (list group (current-buffer)) | |
487 nnfolder-buffer-alist))))))) | |
488 (setq nnfolder-current-group group)) | |
489 | |
490 (defun nnfolder-save-mail (&optional group) | |
491 "Called narrowed to an article." | |
492 (let* ((nnmail-split-methods | |
493 (if group (list (list group "")) nnmail-split-methods)) | |
494 (group-art-list | |
495 (nreverse (nnmail-article-group 'nnfolder-active-number))) | |
496 save-list group-art) | |
497 (setq save-list group-art-list) | |
498 (nnmail-insert-lines) | |
499 (nnmail-insert-xref group-art-list) | |
500 (run-hooks 'nnfolder-prepare-save-mail-hook) | |
501 | |
502 ;; Insert the mail into each of the destination groups. | |
503 (while group-art-list | |
504 (setq group-art (car group-art-list) | |
505 group-art-list (cdr group-art-list)) | |
506 | |
507 ;; Kill the previous newsgroup markers. | |
508 (goto-char (point-min)) | |
509 (search-forward "\n\n" nil t) | |
510 (forward-line -1) | |
511 (while (search-backward (concat "\n" nnfolder-article-marker) nil t) | |
512 (delete-region (1+ (point)) (progn (forward-line 2) (point)))) | |
513 | |
514 ;; Insert the new newsgroup marker. | |
515 (nnfolder-possibly-change-group (car group-art)) | |
516 (nnfolder-insert-newsgroup-line group-art) | |
517 (let ((beg (point-min)) | |
518 (end (point-max)) | |
519 (obuf (current-buffer))) | |
520 (set-buffer nnfolder-current-buffer) | |
521 (goto-char (point-max)) | |
522 (insert-buffer-substring obuf beg end) | |
523 (set-buffer obuf))) | |
524 | |
525 ;; Did we save it anywhere? | |
526 save-list)) | |
527 | |
528 (defun nnfolder-insert-newsgroup-line (group-art) | |
529 (save-excursion | |
530 (goto-char (point-min)) | |
531 (if (search-forward "\n\n" nil t) | |
532 (progn | |
533 (forward-char -1) | |
534 (insert (format (concat nnfolder-article-marker "%d %s\n") | |
535 (cdr group-art) (current-time-string))))))) | |
536 | |
537 (defun nnfolder-possibly-activate-groups (&optional group) | |
538 (save-excursion | |
539 ;; If we're looking for the activation of a specific group, find out | |
540 ;; its real name and switch to it. | |
541 (if group (nnfolder-possibly-change-group group)) | |
542 ;; If the group alist isn't active, activate it now. | |
543 (nnmail-activate 'nnfolder))) | |
544 | |
545 (defun nnfolder-active-number (group) | |
546 (save-excursion | |
547 ;; Find the next article number in GROUP. | |
548 (prog1 | |
549 (let ((active (car (cdr (assoc group nnfolder-group-alist))))) | |
550 (if active | |
551 (setcdr active (1+ (cdr active))) | |
552 ;; This group is new, so we create a new entry for it. | |
553 ;; This might be a bit naughty... creating groups on the drop of | |
554 ;; a hat, but I don't know... | |
555 (setq nnfolder-group-alist | |
556 (cons (list group (setq active (cons 1 1))) | |
557 nnfolder-group-alist))) | |
558 (cdr active)) | |
559 (nnmail-save-active nnfolder-group-alist nnfolder-active-file) | |
560 (nnfolder-possibly-activate-groups group) | |
561 ))) | |
562 | |
563 | |
564 ;; This method has a problem if you've accidentally let the active list get | |
565 ;; out of sync with the files. This could happen, say, if you've | |
566 ;; accidentally gotten new mail with something other than Gnus (but why | |
567 ;; would _that_ ever happen? :-). In that case, we will be in the middle of | |
568 ;; processing the file, ready to add new X-Gnus article number markers, and | |
569 ;; we'll run accross a message with no ID yet - the active list _may_not_ be | |
570 ;; ready for us yet. | |
571 | |
572 ;; To handle this, I'm modifying this routine to maintain the maximum ID seen | |
573 ;; so far, and when we hit a message with no ID, we will _manually_ scan the | |
574 ;; rest of the message looking for any more, possibly higher IDs. We'll | |
575 ;; assume the maximum that we find is the highest active. Note that this | |
576 ;; shouldn't cost us much extra time at all, but will be a lot less | |
577 ;; vulnerable to glitches between the mbox and the active file. | |
578 | |
579 (defun nnfolder-read-folder (file) | |
580 (save-excursion | |
581 (nnfolder-possibly-activate-groups nil) | |
582 ;; We should be paranoid here and make sure the group is in the alist, | |
583 ;; and add it if it isn't. | |
584 ;;(if (not (assoc nnfoler-current-group nnfolder-group-alist) | |
585 (set-buffer (setq nnfolder-current-buffer | |
586 (nnheader-find-file-noselect file nil 'raw))) | |
587 (buffer-disable-undo (current-buffer)) | |
588 (let ((delim (concat "^" rmail-unix-mail-delimiter)) | |
589 (marker (concat "\n" nnfolder-article-marker)) | |
590 (number "[0-9]+") | |
591 (active (car (cdr (assoc nnfolder-current-group | |
592 nnfolder-group-alist)))) | |
593 activenumber activemin start end) | |
594 (goto-char (point-min)) | |
595 ;; | |
596 ;; Anytime the active number is 1 or 0, it is supect. In that case, | |
597 ;; search the file manually to find the active number. Or, of course, | |
598 ;; if we're being paranoid. (This would also be the place to build | |
599 ;; other lists from the header markers, such as expunge lists, etc., if | |
600 ;; we ever desired to abandon the active file entirely for mboxes.) | |
601 (setq activenumber (cdr active)) | |
602 (if (or nnfolder-ignore-active-file | |
603 (< activenumber 2)) | |
604 (progn | |
605 (setq activemin (max (1- (lsh 1 23)) | |
606 (1- (lsh 1 24)) | |
607 (1- (lsh 1 25)))) | |
608 (while (and (search-forward marker nil t) | |
609 (re-search-forward number nil t)) | |
610 (let ((newnum (string-to-number (buffer-substring | |
611 (match-beginning 0) | |
612 (match-end 0))))) | |
613 (setq activenumber (max activenumber newnum)) | |
614 (setq activemin (min activemin newnum)))) | |
615 (setcar active (max 1 (min activemin activenumber))) | |
616 (setcdr active (max activenumber (cdr active))) | |
617 (goto-char (point-min)))) | |
618 | |
619 ;; Keep track of the active number on our own, and insert it back into | |
620 ;; the active list when we're done. Also, prime the pump to cut down on | |
621 ;; the number of searches we do. | |
622 (setq end (point-marker)) | |
623 (set-marker end (or (and (re-search-forward delim nil t) | |
624 (match-beginning 0)) | |
625 (point-max))) | |
626 (while (not (= end (point-max))) | |
627 (setq start (marker-position end)) | |
628 (goto-char end) | |
629 ;; There may be more than one "From " line, so we skip past | |
630 ;; them. | |
631 (while (looking-at delim) | |
632 (forward-line 1)) | |
633 (set-marker end (or (and (re-search-forward delim nil t) | |
634 (match-beginning 0)) | |
635 (point-max))) | |
636 (goto-char start) | |
637 (if (not (search-forward marker end t)) | |
638 (progn | |
639 (narrow-to-region start end) | |
640 (nnmail-insert-lines) | |
641 (nnfolder-insert-newsgroup-line | |
642 (cons nil (nnfolder-active-number nnfolder-current-group))) | |
643 (widen)))) | |
644 | |
645 ;; Make absolutely sure that the active list reflects reality! | |
646 (nnmail-save-active nnfolder-group-alist nnfolder-active-file) | |
647 (current-buffer)))) | |
648 | |
649 (defun nnfolder-get-new-mail (&optional group) | |
650 "Read new incoming mail." | |
651 (let* ((spools (nnmail-get-spool-files group)) | |
652 (group-in group) | |
653 incomings incoming) | |
654 (if (or (not nnfolder-get-new-mail) (not nnmail-spool-file)) | |
655 () | |
656 ;; We first activate all the groups. | |
657 (nnfolder-possibly-activate-groups nil) | |
658 ;; The we go through all the existing spool files and split the | |
659 ;; mail from each. | |
660 (while spools | |
661 (and | |
662 (file-exists-p (car spools)) | |
663 (> (nth 7 (file-attributes (car spools))) 0) | |
664 (progn | |
665 (and gnus-verbose-backends | |
666 (message "nnfolder: Reading incoming mail...")) | |
667 (if (not (setq incoming | |
668 (nnmail-move-inbox | |
669 (car spools) | |
670 (concat (file-name-as-directory nnfolder-directory) | |
671 "Incoming")))) | |
672 () | |
673 (setq incomings (cons incoming incomings)) | |
674 (setq group (nnmail-get-split-group (car spools) group-in)) | |
675 (nnmail-split-incoming incoming 'nnfolder-save-mail nil group)))) | |
676 (setq spools (cdr spools))) | |
677 ;; If we did indeed read any incoming spools, we save all info. | |
678 (if incoming | |
679 (progn | |
680 (nnmail-save-active nnfolder-group-alist nnfolder-active-file) | |
681 (run-hooks 'nnmail-read-incoming-hook) | |
682 (and gnus-verbose-backends | |
683 (message "nnfolder: Reading incoming mail...done")))) | |
684 (let ((bufs nnfolder-buffer-alist)) | |
685 (save-excursion | |
686 (while bufs | |
687 (if (not (buffer-name (nth 1 (car bufs)))) | |
688 (setq nnfolder-buffer-alist | |
689 (delq (car bufs) nnfolder-buffer-alist)) | |
690 (set-buffer (nth 1 (car bufs))) | |
691 (and (buffer-modified-p) (save-buffer))) | |
692 (setq bufs (cdr bufs))))) | |
693 (while incomings | |
694 (setq incoming (car incomings)) | |
695 (and | |
696 nnmail-delete-incoming | |
697 (file-writable-p incoming) | |
698 (file-exists-p incoming) | |
699 (delete-file incoming)) | |
700 (setq incomings (cdr incomings)))))) | |
701 | |
702 (provide 'nnfolder) | |
703 | |
704 ;;; nnfolder.el ends here |