Mercurial > hg > xemacs-beta

comparison lisp/gnus/nnml.el @ 0:376386a54a3c r19-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children 0293115a14e9
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
1 ;;; nnml.el --- mail spool access for Gnus
2 ;; Copyright (C) 1995,96 Free Software Foundation, Inc.
3
4 ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
5 ;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
6 ;; Keywords: news, mail
7
8 ;; This file is part of GNU Emacs.
9
10 ;; GNU Emacs is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2, or (at your option)
13 ;; any later version.
14
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
19
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA.
24
25 ;;; Commentary:
26
27 ;; Based on nnspool.el by Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>.
28 ;; For an overview of what the interface functions do, please see the
29 ;; Gnus sources.
30
31 ;;; Code:
32
33 (require 'nnheader)
34 (require 'nnmail)
35 (require 'nnoo)
36 (require 'cl)
37
38 (nnoo-declare nnml)
39
40 (defvoo nnml-directory message-directory
41 "Mail spool directory.")
42
43 (defvoo nnml-active-file
44 (concat (file-name-as-directory nnml-directory) "active")
45 "Mail active file.")
46
47 (defvoo nnml-newsgroups-file
48 (concat (file-name-as-directory nnml-directory) "newsgroups")
49 "Mail newsgroups description file.")
50
51 (defvoo nnml-get-new-mail t
52 "If non-nil, nnml will check the incoming mail file and split the mail.")
53
54 (defvoo nnml-nov-is-evil nil
55 "If non-nil, Gnus will never generate and use nov databases for mail groups.
56 Using nov databases will speed up header fetching considerably.
57 This variable shouldn't be flipped much. If you have, for some reason,
58 set this to t, and want to set it to nil again, you should always run
59 the `nnml-generate-nov-databases' command. The function will go
60 through all nnml directories and generate nov databases for them
61 all. This may very well take some time.")
62
63 (defvoo nnml-prepare-save-mail-hook nil
64 "Hook run narrowed to an article before saving.")
65
66 (defvoo nnml-inhibit-expiry nil
67 "If non-nil, inhibit expiry.")
68
69
70
71
72 (defconst nnml-version "nnml 1.0"
73 "nnml version.")
74
75 (defvoo nnml-nov-file-name ".overview")
76
77 (defvoo nnml-current-directory nil)
78 (defvoo nnml-current-group nil)
79 (defvoo nnml-status-string "")
80 (defvoo nnml-nov-buffer-alist nil)
81 (defvoo nnml-group-alist nil)
82 (defvoo nnml-active-timestamp nil)
83 (defvoo nnml-article-file-alist nil)
84
85 (defvoo nnml-generate-active-function 'nnml-generate-active-info)
86
87
88
89 ;;; Interface functions.
90
91 (nnoo-define-basics nnml)
92
93 (deffoo nnml-retrieve-headers (sequence &optional newsgroup server fetch-old)
94 (save-excursion
95 (set-buffer nntp-server-buffer)
96 (erase-buffer)
97 (let ((file nil)
98 (number (length sequence))
99 (count 0)
100 beg article)
101 (if (stringp (car sequence))
102 'headers
103 (nnml-possibly-change-directory newsgroup server)
104 (unless nnml-article-file-alist
105 (setq nnml-article-file-alist
106 (nnheader-article-to-file-alist nnml-current-directory)))
107 (if (nnml-retrieve-headers-with-nov sequence fetch-old)
108 'nov
109 (while sequence
110 (setq article (car sequence))
111 (setq file
112 (concat nnml-current-directory
113 (or (cdr (assq article nnml-article-file-alist))
114 "")))
115 (if (and (file-exists-p file)
116 (not (file-directory-p file)))
117 (progn
118 (insert (format "221 %d Article retrieved.\n" article))
119 (setq beg (point))
120 (nnheader-insert-head file)
121 (goto-char beg)
122 (if (search-forward "\n\n" nil t)
123 (forward-char -1)
124 (goto-char (point-max))
125 (insert "\n\n"))
126 (insert ".\n")
127 (delete-region (point) (point-max))))
128 (setq sequence (cdr sequence))
129 (setq count (1+ count))
130 (and (numberp nnmail-large-newsgroup)
131 (> number nnmail-large-newsgroup)
132 (zerop (% count 20))
133 (nnheader-message 6 "nnml: Receiving headers... %d%%"
134 (/ (* count 100) number))))
135
136 (and (numberp nnmail-large-newsgroup)
137 (> number nnmail-large-newsgroup)
138 (nnheader-message 6 "nnml: Receiving headers...done"))
139
140 (nnheader-fold-continuation-lines)
141 'headers)))))
142
143 (deffoo nnml-open-server (server &optional defs)
144 (nnoo-change-server 'nnml server defs)
145 (when (not (file-exists-p nnml-directory))
146 (condition-case ()
147 (make-directory nnml-directory t)
148 (error t)))
149 (cond
150 ((not (file-exists-p nnml-directory))
151 (nnml-close-server)
152 (nnheader-report 'nnml "Couldn't create directory: %s" nnml-directory))
153 ((not (file-directory-p (file-truename nnml-directory)))
154 (nnml-close-server)
155 (nnheader-report 'nnml "Not a directory: %s" nnml-directory))
156 (t
157 (nnheader-report 'nnml "Opened server %s using directory %s"
158 server nnml-directory)
159 t)))
160
161 (deffoo nnml-request-article (id &optional newsgroup server buffer)
162 (nnml-possibly-change-directory newsgroup server)
163 (let* ((nntp-server-buffer (or buffer nntp-server-buffer))
164 file path gpath group-num)
165 (if (stringp id)
166 (when (and (setq group-num (nnml-find-group-number id))
167 (setq file (cdr
168 (assq (cdr group-num)
169 (nnheader-article-to-file-alist
170 (setq gpath
171 (nnmail-group-pathname
172 (car group-num)
173 nnml-directory)))))))
174 (setq path (concat gpath (int-to-string (cdr group-num)))))
175 (unless nnml-article-file-alist
176 (setq nnml-article-file-alist
177 (nnheader-article-to-file-alist nnml-current-directory)))
178 (when (setq file (cdr (assq id nnml-article-file-alist)))
179 (setq path (concat nnml-current-directory file))))
180 (cond
181 ((not path)
182 (nnheader-report 'nnml "No such article: %s" id))
183 ((not (file-exists-p path))
184 (nnheader-report 'nnml "No such file: %s" path))
185 ((file-directory-p path)
186 (nnheader-report 'nnml "File is a directory: %s" path))
187 ((not (save-excursion (nnmail-find-file path)))
188 (nnheader-report 'nnml "Couldn't read file: %s" path))
189 (t
190 (nnheader-report 'nnml "Article %s retrieved" id)
191 ;; We return the article number.
192 (cons newsgroup (string-to-int (file-name-nondirectory path)))))))
193
194 (deffoo nnml-request-group (group &optional server dont-check)
195 (cond
196 ((not (nnml-possibly-change-directory group server))
197 (nnheader-report 'nnml "Invalid group (no such directory)"))
198 ((not (file-directory-p nnml-current-directory))
199 (nnheader-report 'nnml "%s is not a directory" nnml-current-directory))
200 (dont-check
201 (nnheader-report 'nnml "Group %s selected" group)
202 t)
203 (t
204 (nnmail-activate 'nnml)
205 (let ((active (nth 1 (assoc group nnml-group-alist))))
206 (if (not active)
207 (nnheader-report 'nnml "No such group: %s" group)
208 (nnheader-report 'nnml "Selected group %s" group)
209 (nnheader-insert "211 %d %d %d %s\n"
210 (max (1+ (- (cdr active) (car active))) 0)
211 (car active) (cdr active) group))))))
212
213 (deffoo nnml-request-scan (&optional group server)
214 (setq nnml-article-file-alist nil)
215 (nnmail-get-new-mail 'nnml 'nnml-save-nov nnml-directory group))
216
217 (deffoo nnml-close-group (group &optional server)
218 (setq nnml-article-file-alist nil)
219 t)
220
221 (deffoo nnml-request-create-group (group &optional server)
222 (nnmail-activate 'nnml)
223 (or (assoc group nnml-group-alist)
224 (let (active)
225 (setq nnml-group-alist (cons (list group (setq active (cons 1 0)))
226 nnml-group-alist))
227 (nnml-possibly-create-directory group)
228 (nnml-possibly-change-directory group server)
229 (let ((articles
230 (nnheader-directory-articles nnml-current-directory )))
231 (and articles
232 (progn
233 (setcar active (apply 'min articles))
234 (setcdr active (apply 'max articles)))))
235 (nnmail-save-active nnml-group-alist nnml-active-file)))
236 t)
237
238 (deffoo nnml-request-list (&optional server)
239 (save-excursion
240 (nnmail-find-file nnml-active-file)
241 (setq nnml-group-alist (nnmail-get-active))))
242
243 (deffoo nnml-request-newgroups (date &optional server)
244 (nnml-request-list server))
245
246 (deffoo nnml-request-list-newsgroups (&optional server)
247 (save-excursion
248 (nnmail-find-file nnml-newsgroups-file)))
249
250 (deffoo nnml-request-expire-articles (articles newsgroup &optional server force)
251 (nnml-possibly-change-directory newsgroup server)
252 (let* ((active-articles
253 (nnheader-directory-articles nnml-current-directory))
254 (is-old t)
255 article rest mod-time number)
256 (nnmail-activate 'nnml)
257
258 (unless nnml-article-file-alist
259 (setq nnml-article-file-alist
260 (nnheader-article-to-file-alist nnml-current-directory)))
261
262 (while (and articles is-old)
263 (setq article (concat nnml-current-directory
264 (int-to-string
265 (setq number (pop articles)))))
266 (when (setq mod-time (nth 5 (file-attributes article)))
267 (if (and (nnml-deletable-article-p newsgroup number)
268 (setq is-old
269 (nnmail-expired-article-p newsgroup mod-time force
270 nnml-inhibit-expiry)))
271 (progn
272 (nnheader-message 5 "Deleting article %s in %s..."
273 article newsgroup)
274 (condition-case ()
275 (funcall nnmail-delete-file-function article)
276 (file-error
277 (push number rest)))
278 (setq active-articles (delq number active-articles))
279 (nnml-nov-delete-article newsgroup number))
280 (push number rest))))
281 (let ((active (nth 1 (assoc newsgroup nnml-group-alist))))
282 (when active
283 (setcar active (or (and active-articles
284 (apply 'min active-articles))
285 (1+ (cdr active)))))
286 (nnmail-save-active nnml-group-alist nnml-active-file))
287 (nnml-save-nov)
288 (message "")
289 (nconc rest articles)))
290
291 (deffoo nnml-request-move-article
292 (article group server accept-form &optional last)
293 (let ((buf (get-buffer-create " *nnml move*"))
294 result)
295 (nnml-possibly-change-directory group server)
296 (unless nnml-article-file-alist
297 (setq nnml-article-file-alist
298 (nnheader-article-to-file-alist nnml-current-directory)))
299 (and
300 (nnml-deletable-article-p group article)
301 (nnml-request-article article group server)
302 (save-excursion
303 (set-buffer buf)
304 (insert-buffer-substring nntp-server-buffer)
305 (setq result (eval accept-form))
306 (kill-buffer (current-buffer))
307 result)
308 (progn
309 (nnml-possibly-change-directory group server)
310 (condition-case ()
311 (funcall nnmail-delete-file-function
312 (concat nnml-current-directory
313 (int-to-string article)))
314 (file-error nil))
315 (nnml-nov-delete-article group article)
316 (and last (nnml-save-nov))))
317 result))
318
319 (deffoo nnml-request-accept-article (group &optional server last)
320 (nnml-possibly-change-directory group server)
321 (nnmail-check-syntax)
322 (let (result)
323 (if (stringp group)
324 (and
325 (nnmail-activate 'nnml)
326 ;; We trick the choosing function into believing that only one
327 ;; group is available.
328 (let ((nnmail-split-methods (list (list group ""))))
329 (setq result (car (nnml-save-mail))))
330 (progn
331 (nnmail-save-active nnml-group-alist nnml-active-file)
332 (and last (nnml-save-nov))))
333 (and
334 (nnmail-activate 'nnml)
335 (setq result (car (nnml-save-mail)))
336 (progn
337 (nnmail-save-active nnml-group-alist nnml-active-file)
338 (and last (nnml-save-nov)))))
339 result))
340
341 (deffoo nnml-request-replace-article (article group buffer)
342 (nnml-possibly-change-directory group)
343 (save-excursion
344 (set-buffer buffer)
345 (nnml-possibly-create-directory group)
346 (let ((chars (nnmail-insert-lines))
347 (art (concat (int-to-string article) "\t"))
348 headers)
349 (when (condition-case ()
350 (progn
351 (write-region
352 (point-min) (point-max)
353 (concat nnml-current-directory (int-to-string article))
354 nil (if (nnheader-be-verbose 5) nil 'nomesg))
355 t)
356 (error nil))
357 (setq headers (nnml-parse-head chars article))
358 ;; Replace the NOV line in the NOV file.
359 (save-excursion
360 (set-buffer (nnml-open-nov group))
361 (goto-char (point-min))
362 (if (or (looking-at art)
363 (search-forward (concat "\n" art) nil t))
364 ;; Delete the old NOV line.
365 (delete-region (progn (beginning-of-line) (point))
366 (progn (forward-line 1) (point)))
367 ;; The line isn't here, so we have to find out where
368 ;; we should insert it. (This situation should never
369 ;; occur, but one likes to make sure...)
370 (while (and (looking-at "[0-9]+\t")
371 (< (string-to-int
372 (buffer-substring
373 (match-beginning 0) (match-end 0)))
374 article)
375 (zerop (forward-line 1)))))
376 (beginning-of-line)
377 (nnheader-insert-nov headers)
378 (nnml-save-nov)
379 t)))))
380
381 (deffoo nnml-request-delete-group (group &optional force server)
382 (nnml-possibly-change-directory group server)
383 (when force
384 ;; Delete all articles in GROUP.
385 (let ((articles
386 (directory-files
387 nnml-current-directory t
388 (concat nnheader-numerical-short-files
389 "\\|" (regexp-quote nnml-nov-file-name) "$")))
390 article)
391 (while articles
392 (setq article (pop articles))
393 (when (file-writable-p article)
394 (nnheader-message 5 "Deleting article %s in %s..." article group)
395 (funcall nnmail-delete-file-function article))))
396 ;; Try to delete the directory itself.
397 (condition-case ()
398 (delete-directory nnml-current-directory)
399 (error nil)))
400 ;; Remove the group from all structures.
401 (setq nnml-group-alist
402 (delq (assoc group nnml-group-alist) nnml-group-alist)
403 nnml-current-group nil
404 nnml-current-directory nil)
405 ;; Save the active file.
406 (nnmail-save-active nnml-group-alist nnml-active-file)
407 t)
408
409 (deffoo nnml-request-rename-group (group new-name &optional server)
410 (nnml-possibly-change-directory group server)
411 ;; Rename directory.
412 (and (file-writable-p nnml-current-directory)
413 (condition-case ()
414 (let ((parent
415 (file-name-directory
416 (directory-file-name
417 (nnmail-group-pathname new-name nnml-directory)))))
418 (unless (file-exists-p parent)
419 (make-directory parent t))
420 (rename-file
421 (directory-file-name nnml-current-directory)
422 (directory-file-name
423 (nnmail-group-pathname new-name nnml-directory)))
424 t)
425 (error nil))
426 ;; That went ok, so we change the internal structures.
427 (let ((entry (assoc group nnml-group-alist)))
428 (and entry (setcar entry new-name))
429 (setq nnml-current-directory nil
430 nnml-current-group nil)
431 ;; Save the new group alist.
432 (nnmail-save-active nnml-group-alist nnml-active-file)
433 t)))
434
435
436 ;;; Internal functions.
437
438 (defun nnml-deletable-article-p (group article)
439 "Say whether ARTICLE in GROUP can be deleted."
440 (let (file path)
441 (when (setq file (cdr (assq article nnml-article-file-alist)))
442 (setq path (concat nnml-current-directory file))
443 (and (file-writable-p path)
444 (or (not nnmail-keep-last-article)
445 (not (eq (cdr (nth 1 (assoc group nnml-group-alist)))
446 article)))))))
447
448 ;; Find an article number in the current group given the Message-ID.
449 (defun nnml-find-group-number (id)
450 (save-excursion
451 (set-buffer (get-buffer-create " *nnml id*"))
452 (buffer-disable-undo (current-buffer))
453 (let ((alist nnml-group-alist)
454 number)
455 ;; We want to look through all .overview files, but we want to
456 ;; start with the one in the current directory. It seems most
457 ;; likely that the article we are looking for is in that group.
458 (if (setq number (nnml-find-id nnml-current-group id))
459 (cons nnml-current-group number)
460 ;; It wasn't there, so we look through the other groups as well.
461 (while (and (not number)
462 alist)
463 (or (string= (caar alist) nnml-current-group)
464 (setq number (nnml-find-id (caar alist) id)))
465 (or number
466 (setq alist (cdr alist))))
467 (and number
468 (cons (caar alist) number))))))
469
470 (defun nnml-find-id (group id)
471 (erase-buffer)
472 (let ((nov (concat (nnmail-group-pathname group nnml-directory)
473 nnml-nov-file-name))
474 number found)
475 (when (file-exists-p nov)
476 (insert-file-contents nov)
477 (while (and (not found)
478 (search-forward id nil t)) ; We find the ID.
479 ;; And the id is in the fourth field.
480 (if (search-backward
481 "\t" (save-excursion (beginning-of-line) (point)) t 4)
482 (progn
483 (beginning-of-line)
484 (setq found t)
485 ;; We return the article number.
486 (setq number
487 (condition-case ()
488 (read (current-buffer))
489 (error nil))))))
490 number)))
491
492 (defun nnml-retrieve-headers-with-nov (articles &optional fetch-old)
493 (if (or gnus-nov-is-evil nnml-nov-is-evil)
494 nil
495 (let ((first (car articles))
496 (last (progn (while (cdr articles) (setq articles (cdr articles)))
497 (car articles)))
498 (nov (concat nnml-current-directory nnml-nov-file-name)))
499 (when (file-exists-p nov)
500 (save-excursion
501 (set-buffer nntp-server-buffer)
502 (erase-buffer)
503 (insert-file-contents nov)
504 (if (and fetch-old
505 (not (numberp fetch-old)))
506 t ; Don't remove anything.
507 (if fetch-old
508 (setq first (max 1 (- first fetch-old))))
509 (goto-char (point-min))
510 (while (and (not (eobp)) (> first (read (current-buffer))))
511 (forward-line 1))
512 (beginning-of-line)
513 (if (not (eobp)) (delete-region 1 (point)))
514 (while (and (not (eobp)) (>= last (read (current-buffer))))
515 (forward-line 1))
516 (beginning-of-line)
517 (if (not (eobp)) (delete-region (point) (point-max)))
518 t))))))
519
520 (defun nnml-possibly-change-directory (group &optional server)
521 (when (and server
522 (not (nnml-server-opened server)))
523 (nnml-open-server server))
524 (when group
525 (let ((pathname (nnmail-group-pathname group nnml-directory)))
526 (when (not (equal pathname nnml-current-directory))
527 (setq nnml-current-directory pathname
528 nnml-current-group group
529 nnml-article-file-alist nil))))
530 t)
531
532 (defun nnml-possibly-create-directory (group)
533 (let (dir dirs)
534 (setq dir (nnmail-group-pathname group nnml-directory))
535 (while (not (file-directory-p dir))
536 (setq dirs (cons dir dirs))
537 (setq dir (file-name-directory (directory-file-name dir))))
538 (while dirs
539 (make-directory (directory-file-name (car dirs)))
540 (nnheader-message 5 "Creating mail directory %s" (car dirs))
541 (setq dirs (cdr dirs)))))
542
543 (defun nnml-save-mail ()
544 "Called narrowed to an article."
545 (let ((group-art (nreverse (nnmail-article-group 'nnml-active-number)))
546 chars headers)
547 (setq chars (nnmail-insert-lines))
548 (nnmail-insert-xref group-art)
549 (run-hooks 'nnmail-prepare-save-mail-hook)
550 (run-hooks 'nnml-prepare-save-mail-hook)
551 (goto-char (point-min))
552 (while (looking-at "From ")
553 (replace-match "X-From-Line: ")
554 (forward-line 1))
555 ;; We save the article in all the newsgroups it belongs in.
556 (let ((ga group-art)
557 first)
558 (while ga
559 (nnml-possibly-create-directory (caar ga))
560 (let ((file (concat (nnmail-group-pathname
561 (caar ga) nnml-directory)
562 (int-to-string (cdar ga)))))
563 (if first
564 ;; It was already saved, so we just make a hard link.
565 (funcall nnmail-crosspost-link-function first file t)
566 ;; Save the article.
567 (write-region (point-min) (point-max) file nil
568 (if (nnheader-be-verbose 5) nil 'nomesg))
569 (setq first file)))
570 (setq ga (cdr ga))))
571 ;; Generate a nov line for this article. We generate the nov
572 ;; line after saving, because nov generation destroys the
573 ;; header.
574 (setq headers (nnml-parse-head chars))
575 ;; Output the nov line to all nov databases that should have it.
576 (let ((ga group-art))
577 (while ga
578 (nnml-add-nov (caar ga) (cdar ga) headers)
579 (setq ga (cdr ga))))
580 group-art))
581
582 (defun nnml-active-number (group)
583 "Compute the next article number in GROUP."
584 (let ((active (cadr (assoc group nnml-group-alist))))
585 ;; The group wasn't known to nnml, so we just create an active
586 ;; entry for it.
587 (unless active
588 ;; Perhaps the active file was corrupt? See whether
589 ;; there are any articles in this group.
590 (nnml-possibly-create-directory group)
591 (nnml-possibly-change-directory group)
592 (unless nnml-article-file-alist
593 (setq nnml-article-file-alist
594 (sort
595 (nnheader-article-to-file-alist nnml-current-directory)
596 (lambda (a1 a2) (< (car a1) (car a2))))))
597 (setq active
598 (if nnml-article-file-alist
599 (cons (caar nnml-article-file-alist)
600 (caar (last nnml-article-file-alist)))
601 (cons 1 0)))
602 (setq nnml-group-alist (cons (list group active) nnml-group-alist)))
603 (setcdr active (1+ (cdr active)))
604 (while (file-exists-p
605 (concat (nnmail-group-pathname group nnml-directory)
606 (int-to-string (cdr active))))
607 (setcdr active (1+ (cdr active))))
608 (cdr active)))
609
610 (defun nnml-add-nov (group article headers)
611 "Add a nov line for the GROUP base."
612 (save-excursion
613 (set-buffer (nnml-open-nov group))
614 (goto-char (point-max))
615 (mail-header-set-number headers article)
616 (nnheader-insert-nov headers)))
617
618 (defsubst nnml-header-value ()
619 (buffer-substring (match-end 0) (progn (end-of-line) (point))))
620
621 (defun nnml-parse-head (chars &optional number)
622 "Parse the head of the current buffer."
623 (save-excursion
624 (save-restriction
625 (goto-char (point-min))
626 (narrow-to-region
627 (point)
628 (1- (or (search-forward "\n\n" nil t) (point-max))))
629 ;; Fold continuation lines.
630 (goto-char (point-min))
631 (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
632 (replace-match " " t t))
633 ;; Remove any tabs; they are too confusing.
634 (subst-char-in-region (point-min) (point-max) ?\t ? )
635 (let ((headers (nnheader-parse-head t)))
636 (mail-header-set-chars headers chars)
637 (mail-header-set-number headers number)
638 headers))))
639
640 (defun nnml-open-nov (group)
641 (or (cdr (assoc group nnml-nov-buffer-alist))
642 (let ((buffer (find-file-noselect
643 (concat (nnmail-group-pathname group nnml-directory)
644 nnml-nov-file-name))))
645 (save-excursion
646 (set-buffer buffer)
647 (buffer-disable-undo (current-buffer)))
648 (setq nnml-nov-buffer-alist
649 (cons (cons group buffer) nnml-nov-buffer-alist))
650 buffer)))
651
652 (defun nnml-save-nov ()
653 (save-excursion
654 (while nnml-nov-buffer-alist
655 (when (buffer-name (cdar nnml-nov-buffer-alist))
656 (set-buffer (cdar nnml-nov-buffer-alist))
657 (and (buffer-modified-p)
658 (write-region
659 1 (point-max) (buffer-file-name) nil 'nomesg))
660 (set-buffer-modified-p nil)
661 (kill-buffer (current-buffer)))
662 (setq nnml-nov-buffer-alist (cdr nnml-nov-buffer-alist)))))
663
664 ;;;###autoload
665 (defun nnml-generate-nov-databases ()
666 "Generate nov databases in all nnml directories."
667 (interactive)
668 ;; Read the active file to make sure we don't re-use articles
669 ;; numbers in empty groups.
670 (nnmail-activate 'nnml)
671 (nnml-open-server (or (nnoo-current-server 'nnml) ""))
672 (setq nnml-directory (expand-file-name nnml-directory))
673 ;; Recurse down the directories.
674 (nnml-generate-nov-databases-1 nnml-directory)
675 ;; Save the active file.
676 (nnmail-save-active nnml-group-alist nnml-active-file))
677
678 (defun nnml-generate-nov-databases-1 (dir)
679 (setq dir (file-name-as-directory dir))
680 ;; We descend recursively
681 (let ((dirs (directory-files dir t nil t))
682 dir)
683 (while dirs
684 (setq dir (pop dirs))
685 (when (and (not (member (file-name-nondirectory dir) '("." "..")))
686 (file-directory-p dir))
687 (nnml-generate-nov-databases-1 dir))))
688 ;; Do this directory.
689 (let ((files (sort
690 (mapcar
691 (lambda (name) (string-to-int name))
692 (directory-files dir nil "^[0-9]+$" t))
693 '<)))
694 (when files
695 (funcall nnml-generate-active-function dir)
696 ;; Generate the nov file.
697 (nnml-generate-nov-file dir files))))
698
699 (defvar files)
700 (defun nnml-generate-active-info (dir)
701 ;; Update the active info for this group.
702 (let ((group (nnheader-file-to-group
703 (directory-file-name dir) nnml-directory)))
704 (setq nnml-group-alist
705 (delq (assoc group nnml-group-alist) nnml-group-alist))
706 (push (list group
707 (cons (car files)
708 (let ((f files))
709 (while (cdr f) (setq f (cdr f)))
710 (car f))))
711 nnml-group-alist)))
712
713 (defun nnml-generate-nov-file (dir files)
714 (let* ((dir (file-name-as-directory dir))
715 (nov (concat dir nnml-nov-file-name))
716 (nov-buffer (get-buffer-create " *nov*"))
717 nov-line chars file headers)
718 (save-excursion
719 ;; Init the nov buffer.
720 (set-buffer nov-buffer)
721 (buffer-disable-undo (current-buffer))
722 (erase-buffer)
723 (set-buffer nntp-server-buffer)
724 ;; Delete the old NOV file.
725 (when (file-exists-p nov)
726 (funcall nnmail-delete-file-function nov))
727 (while files
728 (unless (file-directory-p
729 (setq file (concat dir (int-to-string (car files)))))
730 (erase-buffer)
731 (insert-file-contents file)
732 (narrow-to-region
733 (goto-char (point-min))
734 (progn
735 (search-forward "\n\n" nil t)
736 (setq chars (- (point-max) (point)))
737 (max 1 (1- (point)))))
738 (when (and (not (= 0 chars)) ; none of them empty files...
739 (not (= (point-min) (point-max))))
740 (goto-char (point-min))
741 (setq headers (nnml-parse-head chars (car files)))
742 (save-excursion
743 (set-buffer nov-buffer)
744 (goto-char (point-max))
745 (nnheader-insert-nov headers)))
746 (widen))
747 (setq files (cdr files)))
748 (save-excursion
749 (set-buffer nov-buffer)
750 (write-region 1 (point-max) (expand-file-name nov) nil
751 'nomesg)
752 (kill-buffer (current-buffer))))))
753
754 (defun nnml-nov-delete-article (group article)
755 (save-excursion
756 (set-buffer (nnml-open-nov group))
757 (goto-char (point-min))
758 (if (re-search-forward (concat "^" (int-to-string article) "\t") nil t)
759 (delete-region (match-beginning 0) (progn (forward-line 1) (point))))
760 t))
761
762 (provide 'nnml)
763
764 ;;; nnml.el ends here