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