Importing gnus-5.6.5
[elisp/gnus.git-] / lisp / nnfolder.el
1 ;;; nnfolder.el --- mail folder access for Gnus
2 ;; Copyright (C) 1995,96,97,98 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: 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 the
23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
24 ;; Boston, MA 02111-1307, USA.
25
26 ;;; Commentary:
27
28 ;;; Code:
29
30 (require 'nnheader)
31 (require 'message)
32 (require 'nnmail)
33 (require 'nnoo)
34 (require 'cl)
35 (require 'gnus-util)
36
37 (nnoo-declare nnfolder)
38
39 (defvoo nnfolder-directory (expand-file-name message-directory)
40   "The name of the nnfolder directory.")
41
42 (defvoo nnfolder-active-file
43   (nnheader-concat nnfolder-directory "active")
44   "The name of the active file.")
45
46 ;; I renamed this variable to something more in keeping with the general GNU
47 ;; style. -SLB
48
49 (defvoo nnfolder-ignore-active-file nil
50   "If non-nil, causes nnfolder to do some extra work in order to determine
51 the true active ranges of an mbox file.  Note that the active file is still
52 saved, but it's values are not used.  This costs some extra time when
53 scanning an mbox when opening it.")
54
55 (defvoo nnfolder-distrust-mbox nil
56   "If non-nil, causes nnfolder to not trust the user with respect to
57 inserting unaccounted for mail in the middle of an mbox file.  This can greatly
58 slow down scans, which now must scan the entire file for unmarked messages.
59 When nil, scans occur forward from the last marked message, a huge
60 time saver for large mailboxes.")
61
62 (defvoo nnfolder-newsgroups-file
63   (concat (file-name-as-directory nnfolder-directory) "newsgroups")
64   "Mail newsgroups description file.")
65
66 (defvoo nnfolder-get-new-mail t
67   "If non-nil, nnfolder will check the incoming mail file and split the mail.")
68
69 (defvoo nnfolder-prepare-save-mail-hook nil
70   "Hook run narrowed to an article before saving.")
71
72 (defvoo nnfolder-save-buffer-hook nil
73   "Hook run before saving the nnfolder mbox buffer.")
74
75 (defvoo nnfolder-inhibit-expiry nil
76   "If non-nil, inhibit expiry.")
77
78 \f
79
80 (defconst nnfolder-version "nnfolder 1.0"
81   "nnfolder version.")
82
83 (defconst nnfolder-article-marker "X-Gnus-Article-Number: "
84   "String used to demarcate what the article number for a message is.")
85
86 (defvoo nnfolder-current-group nil)
87 (defvoo nnfolder-current-buffer nil)
88 (defvoo nnfolder-status-string "")
89 (defvoo nnfolder-group-alist nil)
90 (defvoo nnfolder-buffer-alist nil)
91 (defvoo nnfolder-scantime-alist nil)
92 (defvoo nnfolder-active-timestamp nil)
93
94 \f
95
96 ;;; Interface functions
97
98 (nnoo-define-basics nnfolder)
99
100 (deffoo nnfolder-retrieve-headers (articles &optional group server fetch-old)
101   (save-excursion
102     (set-buffer nntp-server-buffer)
103     (erase-buffer)
104     (let (article art-string start stop)
105       (nnfolder-possibly-change-group group server)
106       (when nnfolder-current-buffer
107         (set-buffer nnfolder-current-buffer)
108         (goto-char (point-min))
109         (if (stringp (car articles))
110             'headers
111           (while articles
112             (setq article (car articles))
113             (setq art-string (nnfolder-article-string article))
114             (set-buffer nnfolder-current-buffer)
115             (when (or (search-forward art-string nil t)
116                       ;; Don't search the whole file twice!  Also, articles
117                       ;; probably have some locality by number, so searching
118                       ;; backwards will be faster.  Especially if we're at the
119                       ;; beginning of the buffer :-). -SLB
120                       (search-backward art-string nil t))
121               (nnmail-search-unix-mail-delim-backward)
122               (setq start (point))
123               (search-forward "\n\n" nil t)
124               (setq stop (1- (point)))
125               (set-buffer nntp-server-buffer)
126               (insert (format "221 %d Article retrieved.\n" article))
127               (insert-buffer-substring nnfolder-current-buffer start stop)
128               (goto-char (point-max))
129               (insert ".\n"))
130             (setq articles (cdr articles)))
131
132           (set-buffer nntp-server-buffer)
133           (nnheader-fold-continuation-lines)
134           'headers)))))
135
136 (deffoo nnfolder-open-server (server &optional defs)
137   (nnoo-change-server 'nnfolder server defs)
138   (nnmail-activate 'nnfolder t)
139   (gnus-make-directory nnfolder-directory)
140   (cond
141    ((not (file-exists-p nnfolder-directory))
142     (nnfolder-close-server)
143     (nnheader-report 'nnfolder "Couldn't create directory: %s"
144                      nnfolder-directory))
145    ((not (file-directory-p (file-truename nnfolder-directory)))
146     (nnfolder-close-server)
147     (nnheader-report 'nnfolder "Not a directory: %s" nnfolder-directory))
148    (t
149     (nnmail-activate 'nnfolder)
150     (nnheader-report 'nnfolder "Opened server %s using directory %s"
151                      server nnfolder-directory)
152     t)))
153
154 (deffoo nnfolder-request-close ()
155   (let ((alist nnfolder-buffer-alist))
156     (while alist
157       (nnfolder-close-group (caar alist) nil t)
158       (setq alist (cdr alist))))
159   (nnoo-close-server 'nnfolder)
160   (setq nnfolder-buffer-alist nil
161         nnfolder-group-alist nil))
162
163 (deffoo nnfolder-request-article (article &optional group server buffer)
164   (nnfolder-possibly-change-group group server)
165   (save-excursion
166     (set-buffer nnfolder-current-buffer)
167     (goto-char (point-min))
168     (when (search-forward (nnfolder-article-string article) nil t)
169       (let (start stop)
170         (nnmail-search-unix-mail-delim-backward)
171         (setq start (point))
172         (forward-line 1)
173         (unless (and (nnmail-search-unix-mail-delim)
174                      (forward-line -1))
175           (goto-char (point-max)))
176         (setq stop (point))
177         (let ((nntp-server-buffer (or buffer nntp-server-buffer)))
178           (set-buffer nntp-server-buffer)
179           (erase-buffer)
180           (insert-buffer-substring nnfolder-current-buffer start stop)
181           (goto-char (point-min))
182           (while (looking-at "From ")
183             (delete-char 5)
184             (insert "X-From-Line: ")
185             (forward-line 1))
186           (if (numberp article)
187               (cons nnfolder-current-group article)
188             (goto-char (point-min))
189             (search-forward (concat "\n" nnfolder-article-marker))
190             (cons nnfolder-current-group
191                   (string-to-int
192                    (buffer-substring
193                     (point) (progn (end-of-line) (point)))))))))))
194
195 (deffoo nnfolder-request-group (group &optional server dont-check)
196   (nnfolder-possibly-change-group group server t)
197   (save-excursion
198     (if (not (assoc group nnfolder-group-alist))
199         (nnheader-report 'nnfolder "No such group: %s" group)
200       (if dont-check
201           (progn
202             (nnheader-report 'nnfolder "Selected group %s" group)
203             t)
204         (let* ((active (assoc group nnfolder-group-alist))
205                (group (car active))
206                (range (cadr active)))
207           (cond
208            ((null active)
209             (nnheader-report 'nnfolder "No such group: %s" group))
210            ((null nnfolder-current-group)
211             (nnheader-report 'nnfolder "Empty group: %s" group))
212            (t
213             (nnheader-report 'nnfolder "Selected group %s" group)
214             (nnheader-insert "211 %d %d %d %s\n"
215                              (1+ (- (cdr range) (car range)))
216                              (car range) (cdr range) group))))))))
217
218 (deffoo nnfolder-request-scan (&optional group server)
219   (nnfolder-possibly-change-group nil server)
220   (when nnfolder-get-new-mail
221     (nnfolder-possibly-change-group group server)
222     (nnmail-get-new-mail
223      'nnfolder
224      (lambda ()
225        (let ((bufs nnfolder-buffer-alist))
226          (save-excursion
227            (while bufs
228              (if (not (gnus-buffer-live-p (nth 1 (car bufs))))
229                  (setq nnfolder-buffer-alist
230                        (delq (car bufs) nnfolder-buffer-alist))
231                (set-buffer (nth 1 (car bufs)))
232                (nnfolder-save-buffer)
233                (kill-buffer (current-buffer)))
234              (setq bufs (cdr bufs))))))
235      nnfolder-directory
236      group)))
237
238 ;; Don't close the buffer if we're not shutting down the server.  This way,
239 ;; we can keep the buffer in the group buffer cache, and not have to grovel
240 ;; over the buffer again unless we add new mail to it or modify it in some
241 ;; way.
242
243 (deffoo nnfolder-close-group (group &optional server force)
244   ;; Make sure we _had_ the group open.
245   (when (or (assoc group nnfolder-buffer-alist)
246             (equal group nnfolder-current-group))
247     (let ((inf (assoc group nnfolder-buffer-alist)))
248       (when inf
249         (when (and nnfolder-current-group
250                    nnfolder-current-buffer)
251           (push (list nnfolder-current-group nnfolder-current-buffer)
252                 nnfolder-buffer-alist))
253         (setq nnfolder-buffer-alist
254               (delq inf nnfolder-buffer-alist))
255         (setq nnfolder-current-buffer (cadr inf)
256               nnfolder-current-group (car inf))))
257     (when (and nnfolder-current-buffer
258                (buffer-name nnfolder-current-buffer))
259       (save-excursion
260         (set-buffer nnfolder-current-buffer)
261         ;; If the buffer was modified, write the file out now.
262         (nnfolder-save-buffer)
263         ;; If we're shutting the server down, we need to kill the
264         ;; buffer and remove it from the open buffer list.  Or, of
265         ;; course, if we're trying to minimize our space impact.
266         (kill-buffer (current-buffer))
267         (setq nnfolder-buffer-alist (delq (assoc group nnfolder-buffer-alist)
268                                           nnfolder-buffer-alist)))))
269   (setq nnfolder-current-group nil
270         nnfolder-current-buffer nil)
271   t)
272
273 (deffoo nnfolder-request-create-group (group &optional server args)
274   (nnfolder-possibly-change-group nil server)
275   (nnmail-activate 'nnfolder)
276   (when group
277     (unless (assoc group nnfolder-group-alist)
278       (push (list group (cons 1 0)) nnfolder-group-alist)
279       (nnmail-save-active nnfolder-group-alist nnfolder-active-file)
280       (nnfolder-read-folder group)))
281   t)
282
283 (deffoo nnfolder-request-list (&optional server)
284   (nnfolder-possibly-change-group nil server)
285   (save-excursion
286     (let ((nnmail-file-coding-system nnmail-active-file-coding-system)
287           (pathname-coding-system 'binary))
288       (nnmail-find-file nnfolder-active-file)
289       (setq nnfolder-group-alist (nnmail-get-active)))
290     t))
291
292 (deffoo nnfolder-request-newgroups (date &optional server)
293   (nnfolder-possibly-change-group nil server)
294   (nnfolder-request-list server))
295
296 (deffoo nnfolder-request-list-newsgroups (&optional server)
297   (nnfolder-possibly-change-group nil server)
298   (save-excursion
299     (nnmail-find-file nnfolder-newsgroups-file)))
300
301 (deffoo nnfolder-request-expire-articles
302   (articles newsgroup &optional server force)
303   (nnfolder-possibly-change-group newsgroup server)
304   (let* ((is-old t)
305          rest)
306     (nnmail-activate 'nnfolder)
307
308     (save-excursion
309       (set-buffer nnfolder-current-buffer)
310       (while (and articles is-old)
311         (goto-char (point-min))
312         (when (search-forward (nnfolder-article-string (car articles)) nil t)
313           (if (setq is-old
314                     (nnmail-expired-article-p
315                      newsgroup
316                      (buffer-substring
317                       (point) (progn (end-of-line) (point)))
318                      force nnfolder-inhibit-expiry))
319               (progn
320                 (nnheader-message 5 "Deleting article %d..."
321                                   (car articles) newsgroup)
322                 (nnfolder-delete-mail))
323             (push (car articles) rest)))
324         (setq articles (cdr articles)))
325       (unless nnfolder-inhibit-expiry
326         (nnheader-message 5 "Deleting articles...done"))
327       (nnfolder-save-buffer)
328       (nnfolder-adjust-min-active newsgroup)
329       (nnmail-save-active nnfolder-group-alist nnfolder-active-file)
330       (nconc rest articles))))
331
332 (deffoo nnfolder-request-move-article (article group server
333                                                accept-form &optional last)
334   (save-excursion
335     (let ((buf (get-buffer-create " *nnfolder move*"))
336           result)
337       (and
338        (nnfolder-request-article article group server)
339        (save-excursion
340          (set-buffer buf)
341          (buffer-disable-undo (current-buffer))
342          (erase-buffer)
343          (insert-buffer-substring nntp-server-buffer)
344          (goto-char (point-min))
345          (while (re-search-forward
346                  (concat "^" nnfolder-article-marker)
347                  (save-excursion (search-forward "\n\n" nil t) (point)) t)
348            (delete-region (progn (beginning-of-line) (point))
349                           (progn (forward-line 1) (point))))
350          (setq result (eval accept-form))
351          (kill-buffer buf)
352          result)
353        (save-excursion
354          (nnfolder-possibly-change-group group server)
355          (set-buffer nnfolder-current-buffer)
356          (goto-char (point-min))
357          (when (search-forward (nnfolder-article-string article) nil t)
358            (nnfolder-delete-mail))
359          (when last
360            (nnfolder-save-buffer)
361            (nnfolder-adjust-min-active group)
362            (nnmail-save-active nnfolder-group-alist nnfolder-active-file))))
363       result)))
364
365 (deffoo nnfolder-request-accept-article (group &optional server last)
366   (save-excursion
367     (nnfolder-possibly-change-group group server)
368     (nnmail-check-syntax)
369     (let ((buf (current-buffer))
370           result art-group)
371       (goto-char (point-min))
372       (when (looking-at "X-From-Line: ")
373         (replace-match "From "))
374       (and
375        (nnfolder-request-list)
376        (save-excursion
377          (set-buffer buf)
378          (goto-char (point-min))
379          (search-forward "\n\n" nil t)
380          (forward-line -1)
381          (while (re-search-backward (concat "^" nnfolder-article-marker) nil t)
382            (delete-region (point) (progn (forward-line 1) (point))))
383          (when nnmail-cache-accepted-message-ids
384            (nnmail-cache-insert (nnmail-fetch-field "message-id")))
385          (setq result (if (stringp group)
386                           (list (cons group (nnfolder-active-number group)))
387                         (setq art-group
388                               (nnmail-article-group 'nnfolder-active-number))))
389          (if (and (null result)
390                   (yes-or-no-p "Moved to `junk' group; delete article? "))
391              (setq result 'junk)
392            (setq result
393                  (car (nnfolder-save-mail result)))))
394        (when last
395          (save-excursion
396            (nnfolder-possibly-change-folder (or (caar art-group) group))
397            (nnfolder-save-buffer)
398            (when nnmail-cache-accepted-message-ids
399              (nnmail-cache-close)))))
400       (nnmail-save-active nnfolder-group-alist nnfolder-active-file)
401       (unless result
402         (nnheader-report 'nnfolder "Couldn't store article"))
403       result)))
404
405 (deffoo nnfolder-request-replace-article (article group buffer)
406   (nnfolder-possibly-change-group group)
407   (save-excursion
408     (set-buffer buffer)
409     (nnfolder-normalize-buffer)
410     (set-buffer nnfolder-current-buffer)
411     (goto-char (point-min))
412     (if (not (search-forward (nnfolder-article-string article) nil t))
413         nil
414       (nnfolder-delete-mail t t)
415       (insert-buffer-substring buffer)
416       (nnfolder-save-buffer)
417       t)))
418
419 (deffoo nnfolder-request-delete-group (group &optional force server)
420   (nnfolder-close-group group server t)
421   ;; Delete all articles in GROUP.
422   (if (not force)
423       ()                                ; Don't delete the articles.
424     ;; Delete the file that holds the group.
425     (ignore-errors
426       (delete-file (nnfolder-group-pathname group))))
427   ;; Remove the group from all structures.
428   (setq nnfolder-group-alist
429         (delq (assoc group nnfolder-group-alist) nnfolder-group-alist)
430         nnfolder-current-group nil
431         nnfolder-current-buffer nil)
432   ;; Save the active file.
433   (nnmail-save-active nnfolder-group-alist nnfolder-active-file)
434   t)
435
436 (deffoo nnfolder-request-rename-group (group new-name &optional server)
437   (nnfolder-possibly-change-group group server)
438   (save-excursion
439     (set-buffer nnfolder-current-buffer)
440     (and (file-writable-p buffer-file-name)
441          (ignore-errors
442            (rename-file
443             buffer-file-name
444             (nnfolder-group-pathname new-name))
445            t)
446          ;; That went ok, so we change the internal structures.
447          (let ((entry (assoc group nnfolder-group-alist)))
448            (and entry (setcar entry new-name))
449            (setq nnfolder-current-buffer nil
450                  nnfolder-current-group nil)
451            ;; Save the new group alist.
452            (nnmail-save-active nnfolder-group-alist nnfolder-active-file)
453            ;; We kill the buffer instead of renaming it and stuff.
454            (kill-buffer (current-buffer))
455            t))))
456
457 (defun nnfolder-request-regenerate (server)
458   (nnfolder-possibly-change-group nil server)
459   (nnfolder-generate-active-file)
460   t)
461
462 \f
463 ;;; Internal functions.
464
465 (defun nnfolder-adjust-min-active (group)
466   ;; Find the lowest active article in this group.
467   (let* ((active (cadr (assoc group nnfolder-group-alist)))
468          (marker (concat "\n" nnfolder-article-marker))
469          (number "[0-9]+")
470          (activemin (cdr active)))
471     (save-excursion
472       (set-buffer nnfolder-current-buffer)
473       (goto-char (point-min))
474       (while (and (search-forward marker nil t)
475                   (re-search-forward number nil t))
476         (setq activemin (min activemin
477                              (string-to-number (buffer-substring
478                                                 (match-beginning 0)
479                                                 (match-end 0))))))
480       (setcar active activemin))))
481
482 (defun nnfolder-article-string (article)
483   (if (numberp article)
484       (concat "\n" nnfolder-article-marker (int-to-string article) " ")
485     (concat "\nMessage-ID: " article)))
486
487 (defun nnfolder-delete-mail (&optional force leave-delim)
488   "Delete the message that point is in."
489   (save-excursion
490     (delete-region
491      (save-excursion
492        (nnmail-search-unix-mail-delim-backward)
493        (if leave-delim (progn (forward-line 1) (point))
494          (point)))
495      (progn
496        (forward-line 1)
497        (if (nnmail-search-unix-mail-delim)
498            (point)
499          (point-max))))))
500
501 (defun nnfolder-possibly-change-group (group &optional server dont-check)
502   ;; Change servers.
503   (when (and server
504              (not (nnfolder-server-opened server)))
505     (nnfolder-open-server server))
506   (unless (gnus-buffer-live-p nnfolder-current-buffer)
507     (setq nnfolder-current-buffer nil
508           nnfolder-current-group nil))
509   ;; Change group.
510   (when (and group
511              (not (equal group nnfolder-current-group)))
512     (let ((pathname-coding-system 'binary))
513       (nnmail-activate 'nnfolder)
514       (when (and (not (assoc group nnfolder-group-alist))
515                  (not (file-exists-p
516                        (nnfolder-group-pathname group))))
517         ;; The group doesn't exist, so we create a new entry for it.
518         (push (list group (cons 1 0)) nnfolder-group-alist)
519         (nnmail-save-active nnfolder-group-alist nnfolder-active-file))
520
521       (if dont-check
522           (setq nnfolder-current-group group
523                 nnfolder-current-buffer nil)
524         (let (inf file)
525           ;; If we have to change groups, see if we don't already have the
526           ;; folder in memory.  If we do, verify the modtime and destroy
527           ;; the folder if needed so we can rescan it.
528           (setq nnfolder-current-buffer
529                 (nth 1 (assoc group nnfolder-buffer-alist)))
530
531           ;; If the buffer is not live, make sure it isn't in the alist.  If it
532           ;; is live, verify that nobody else has touched the file since last
533           ;; time.
534           (when (and nnfolder-current-buffer
535                      (not (gnus-buffer-live-p nnfolder-current-buffer)))
536             (setq nnfolder-buffer-alist (delq inf nnfolder-buffer-alist)
537                   nnfolder-current-buffer nil))
538
539           (setq nnfolder-current-group group)
540
541           (when (or (not nnfolder-current-buffer)
542                     (not (verify-visited-file-modtime
543                           nnfolder-current-buffer)))
544             (save-excursion
545               (setq file (nnfolder-group-pathname group))
546               ;; See whether we need to create the new file.
547               (unless (file-exists-p file)
548                 (gnus-make-directory (file-name-directory file))
549                 (nnmail-write-region 1 1 file t 'nomesg))
550               (when (setq nnfolder-current-buffer (nnfolder-read-folder group))
551                 (set-buffer nnfolder-current-buffer)
552                 (push (list group nnfolder-current-buffer)
553                       nnfolder-buffer-alist)))))))))
554
555 (defun nnfolder-save-mail (group-art-list)
556   "Called narrowed to an article."
557   (let* (save-list group-art)
558     (goto-char (point-min))
559     ;; The From line may have been quoted by movemail.
560     (when (looking-at (concat ">" message-unix-mail-delimiter))
561       (delete-char 1))
562     ;; This might come from somewhere else.
563     (unless (looking-at message-unix-mail-delimiter)
564       (insert "From nobody " (current-time-string) "\n")
565       (goto-char (point-min)))
566     ;; Quote all "From " lines in the article.
567     (forward-line 1)
568     (let (case-fold-search)
569       (while (re-search-forward "^From " nil t)
570         (beginning-of-line)
571         (insert "> ")))
572     (setq save-list group-art-list)
573     (nnmail-insert-lines)
574     (nnmail-insert-xref group-art-list)
575     (run-hooks 'nnmail-prepare-save-mail-hook)
576     (run-hooks 'nnfolder-prepare-save-mail-hook)
577
578     ;; Insert the mail into each of the destination groups.
579     (while (setq group-art (pop group-art-list))
580       ;; Kill any previous newsgroup markers.
581       (goto-char (point-min))
582       (search-forward "\n\n" nil t)
583       (forward-line -1)
584       (while (search-backward (concat "\n" nnfolder-article-marker) nil t)
585         (delete-region (1+ (point)) (progn (forward-line 2) (point))))
586
587       ;; Insert the new newsgroup marker.
588       (nnfolder-insert-newsgroup-line group-art)
589
590       (save-excursion
591         (let ((beg (point-min))
592               (end (point-max))
593               (obuf (current-buffer)))
594           (nnfolder-possibly-change-folder (car group-art))
595           (let ((buffer-read-only nil))
596             (nnfolder-normalize-buffer)
597             (insert-buffer-substring obuf beg end)))))
598
599     ;; Did we save it anywhere?
600     save-list))
601
602 (defun nnfolder-normalize-buffer ()
603   "Make sure there are two newlines at the end of the buffer."
604   (goto-char (point-max))
605   (skip-chars-backward "\n")
606   (delete-region (point) (point-max))
607   (insert "\n\n"))
608
609 (defun nnfolder-insert-newsgroup-line (group-art)
610   (save-excursion
611     (goto-char (point-min))
612     (when (search-forward "\n\n" nil t)
613       (forward-char -1)
614       (insert (format (concat nnfolder-article-marker "%d   %s\n")
615                       (cdr group-art) (current-time-string))))))
616
617 (defun nnfolder-active-number (group)
618   ;; Find the next article number in GROUP.
619   (let ((active (cadr (assoc group nnfolder-group-alist))))
620     (if active
621         (setcdr active (1+ (cdr active)))
622       ;; This group is new, so we create a new entry for it.
623       ;; This might be a bit naughty... creating groups on the drop of
624       ;; a hat, but I don't know...
625       (push (list group (setq active (cons 1 1)))
626             nnfolder-group-alist))
627     (cdr active)))
628
629 (defun nnfolder-possibly-change-folder (group)
630   (let ((inf (assoc group nnfolder-buffer-alist)))
631     (if (and inf
632              (gnus-buffer-live-p (cadr inf)))
633         (set-buffer (cadr inf))
634       (when inf
635         (setq nnfolder-buffer-alist (delq inf nnfolder-buffer-alist)))
636       (when nnfolder-group-alist
637         (nnmail-save-active nnfolder-group-alist nnfolder-active-file))
638       (push (list group (nnfolder-read-folder group))
639             nnfolder-buffer-alist))))
640
641 ;; This method has a problem if you've accidentally let the active list get
642 ;; out of sync with the files.  This could happen, say, if you've
643 ;; accidentally gotten new mail with something other than Gnus (but why
644 ;; would _that_ ever happen? :-).  In that case, we will be in the middle of
645 ;; processing the file, ready to add new X-Gnus article number markers, and
646 ;; we'll run across a message with no ID yet - the active list _may_not_ be
647 ;; ready for us yet.
648
649 ;; To handle this, I'm modifying this routine to maintain the maximum ID seen
650 ;; so far, and when we hit a message with no ID, we will _manually_ scan the
651 ;; rest of the message looking for any more, possibly higher IDs.  We'll
652 ;; assume the maximum that we find is the highest active.  Note that this
653 ;; shouldn't cost us much extra time at all, but will be a lot less
654 ;; vulnerable to glitches between the mbox and the active file.
655
656 (defun nnfolder-read-folder (group)
657   (let* ((file (nnfolder-group-pathname group))
658          (buffer (set-buffer (nnheader-find-file-noselect file))))
659     (if (equal (cadr (assoc group nnfolder-scantime-alist))
660                (nth 5 (file-attributes file)))
661         ;; This looks up-to-date, so we don't do any scanning.
662         (if (file-exists-p file)
663             buffer
664           (push (list group buffer) nnfolder-buffer-alist)
665           (set-buffer-modified-p t)
666           (save-buffer))
667       ;; Parse the damn thing.
668       (save-excursion
669         (nnmail-activate 'nnfolder)
670         ;; Read in the file.
671         (let ((delim (concat "^" message-unix-mail-delimiter))
672               (marker (concat "\n" nnfolder-article-marker))
673               (number "[0-9]+")
674               (active (or (cadr (assoc group nnfolder-group-alist))
675                           (cons 1 0)))
676               (scantime (assoc group nnfolder-scantime-alist))
677               (minid (lsh -1 -1))
678               maxid start end newscantime
679               buffer-read-only)
680           (buffer-disable-undo (current-buffer))
681           (setq maxid (cdr active))
682           (goto-char (point-min))
683
684           ;; Anytime the active number is 1 or 0, it is suspect.  In that
685           ;; case, search the file manually to find the active number.  Or,
686           ;; of course, if we're being paranoid.  (This would also be the
687           ;; place to build other lists from the header markers, such as
688           ;; expunge lists, etc., if we ever desired to abandon the active
689           ;; file entirely for mboxes.)
690           (when (or nnfolder-ignore-active-file
691                     (< maxid 2))
692             (while (and (search-forward marker nil t)
693                         (re-search-forward number nil t))
694               (let ((newnum (string-to-number (match-string 0))))
695                 (setq maxid (max maxid newnum))
696                 (setq minid (min minid newnum))))
697             (setcar active (max 1 (min minid maxid)))
698             (setcdr active (max maxid (cdr active)))
699             (goto-char (point-min)))
700
701           ;; As long as we trust that the user will only insert unmarked mail
702           ;; at the end, go to the end and search backwards for the last
703           ;; marker.  Find the start of that message, and begin to search for
704           ;; unmarked messages from there.
705           (when (not (or nnfolder-distrust-mbox
706                          (< maxid 2)))
707             (goto-char (point-max))
708             (unless (re-search-backward marker nil t)
709               (goto-char (point-min)))
710             (when (nnmail-search-unix-mail-delim)
711               (goto-char (point-min))))
712
713           ;; Keep track of the active number on our own, and insert it back
714           ;; into the active list when we're done.  Also, prime the pump to
715           ;; cut down on the number of searches we do.
716           (unless (nnmail-search-unix-mail-delim)
717             (goto-char (point-max)))
718           (setq end (point-marker))
719           (while (not (= end (point-max)))
720             (setq start (marker-position end))
721             (goto-char end)
722             ;; There may be more than one "From " line, so we skip past
723             ;; them.
724             (while (looking-at delim)
725               (forward-line 1))
726             (set-marker end (if (nnmail-search-unix-mail-delim)
727                                 (point)
728                               (point-max)))
729             (goto-char start)
730             (when (not (search-forward marker end t))
731               (narrow-to-region start end)
732               (nnmail-insert-lines)
733               (nnfolder-insert-newsgroup-line
734                (cons nil (nnfolder-active-number nnfolder-current-group)))
735               (widen)))
736
737           (set-marker end nil)
738           ;; Make absolutely sure that the active list reflects reality!
739           (nnmail-save-active nnfolder-group-alist nnfolder-active-file)
740           ;; Set the scantime for this group.
741           (setq newscantime (visited-file-modtime))
742           (if scantime
743               (setcdr scantime (list newscantime))
744             (push (list nnfolder-current-group newscantime)
745                   nnfolder-scantime-alist))
746           (current-buffer))))))
747
748 ;;;###autoload
749 (defun nnfolder-generate-active-file ()
750   "Look for mbox folders in the nnfolder directory and make them into groups."
751   (interactive)
752   (nnmail-activate 'nnfolder)
753   (let ((files (directory-files nnfolder-directory))
754         file)
755     (while (setq file (pop files))
756       (when (and (not (backup-file-name-p file))
757                  (message-mail-file-mbox-p
758                   (nnheader-concat nnfolder-directory file)))
759         (let ((oldgroup (assoc file nnfolder-group-alist)))
760           (if oldgroup
761               (nnheader-message 5 "Refreshing group %s..." file)
762             (nnheader-message 5 "Adding group %s..." file))
763           (if oldgroup
764               (setq nnfolder-group-alist
765                     (delq oldgroup (copy-sequence nnfolder-group-alist))))
766           (push (list file (cons 1 0)) nnfolder-group-alist)
767           (nnfolder-possibly-change-folder file)
768           (nnfolder-possibly-change-group file)
769           (nnfolder-close-group file))))
770     (message "")))
771
772 (defun nnfolder-group-pathname (group)
773   "Make pathname for GROUP."
774   (setq group (gnus-encode-coding-string group nnmail-pathname-coding-system))
775   (let ((dir (file-name-as-directory (expand-file-name nnfolder-directory))))
776     ;; If this file exists, we use it directly.
777     (if (or nnmail-use-long-file-names
778             (file-exists-p (concat dir group)))
779         (concat dir group)
780       ;; If not, we translate dots into slashes.
781       (concat dir (nnheader-replace-chars-in-string group ?. ?/)))))
782
783 (defun nnfolder-save-buffer ()
784   "Save the buffer."
785   (when (buffer-modified-p)
786     (run-hooks 'nnfolder-save-buffer-hook)
787     (gnus-make-directory (file-name-directory (buffer-file-name)))
788     (save-buffer)))
789
790 (provide 'nnfolder)
791
792 ;;; nnfolder.el ends here