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