(replace_buffer_in_all_windows):
[bpt/emacs.git] / lisp / nnml.el
CommitLineData
41487370 1;;; nnml.el --- mail spool access for Gnus
231f989b 2;; Copyright (C) 1995,96 Free Software Foundation, Inc.
41487370
LMI
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
b578f267
EN
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.
41487370
LMI
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)
231f989b
LMI
35(require 'nnoo)
36(require 'cl)
37
38(nnoo-declare nnml)
41487370 39
231f989b 40(defvoo nnml-directory message-directory
41487370
LMI
41 "Mail spool directory.")
42
231f989b
LMI
43(defvoo nnml-active-file
44 (concat (file-name-as-directory nnml-directory) "active")
41487370
LMI
45 "Mail active file.")
46
231f989b
LMI
47(defvoo nnml-newsgroups-file
48 (concat (file-name-as-directory nnml-directory) "newsgroups")
41487370
LMI
49 "Mail newsgroups description file.")
50
231f989b 51(defvoo nnml-get-new-mail t
41487370
LMI
52 "If non-nil, nnml will check the incoming mail file and split the mail.")
53
231f989b 54(defvoo nnml-nov-is-evil nil
41487370
LMI
55 "If non-nil, Gnus will never generate and use nov databases for mail groups.
56Using nov databases will speed up header fetching considerably.
57This variable shouldn't be flipped much. If you have, for some reason,
58set this to t, and want to set it to nil again, you should always run
59the `nnml-generate-nov-databases' command. The function will go
60through all nnml directories and generate nov databases for them
61all. This may very well take some time.")
62
231f989b 63(defvoo nnml-prepare-save-mail-hook nil
41487370
LMI
64 "Hook run narrowed to an article before saving.")
65
231f989b
LMI
66(defvoo nnml-inhibit-expiry nil
67 "If non-nil, inhibit expiry.")
68
69
41487370
LMI
70\f
71
72(defconst nnml-version "nnml 1.0"
73 "nnml version.")
74
231f989b 75(defvoo nnml-nov-file-name ".overview")
41487370 76
231f989b
LMI
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)
41487370 84
231f989b 85(defvoo nnml-generate-active-function 'nnml-generate-active-info)
41487370
LMI
86
87\f
88
89;;; Interface functions.
90
231f989b
LMI
91(nnoo-define-basics nnml)
92
93(deffoo nnml-retrieve-headers (sequence &optional newsgroup server fetch-old)
41487370
LMI
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
231f989b
LMI
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)
41487370
LMI
108 'nov
109 (while sequence
110 (setq article (car sequence))
231f989b
LMI
111 (setq file
112 (concat nnml-current-directory
113 (or (cdr (assq article nnml-article-file-alist))
114 "")))
41487370
LMI
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))
231f989b
LMI
133 (nnheader-message 6 "nnml: Receiving headers... %d%%"
134 (/ (* count 100) number))))
41487370
LMI
135
136 (and (numberp nnmail-large-newsgroup)
137 (> number nnmail-large-newsgroup)
231f989b 138 (nnheader-message 6 "nnml: Receiving headers...done"))
41487370 139
231f989b 140 (nnheader-fold-continuation-lines)
41487370
LMI
141 'headers)))))
142
231f989b
LMI
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)
41487370
LMI
219 t)
220
231f989b 221(deffoo nnml-request-create-group (group &optional server)
41487370
LMI
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)
231f989b
LMI
228 (nnml-possibly-change-directory group server)
229 (let ((articles
230 (nnheader-directory-articles nnml-current-directory )))
41487370
LMI
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
231f989b 238(deffoo nnml-request-list (&optional server)
41487370
LMI
239 (save-excursion
240 (nnmail-find-file nnml-active-file)
241 (setq nnml-group-alist (nnmail-get-active))))
242
231f989b 243(deffoo nnml-request-newgroups (date &optional server)
41487370
LMI
244 (nnml-request-list server))
245
231f989b 246(deffoo nnml-request-list-newsgroups (&optional server)
41487370
LMI
247 (save-excursion
248 (nnmail-find-file nnml-newsgroups-file)))
249
231f989b
LMI
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))
41487370 254 (is-old t)
231f989b 255 article rest mod-time number)
41487370
LMI
256 (nnmail-activate 'nnml)
257
231f989b
LMI
258 (unless nnml-article-file-alist
259 (setq nnml-article-file-alist
260 (nnheader-article-to-file-alist nnml-current-directory)))
261
41487370
LMI
262 (while (and articles is-old)
263 (setq article (concat nnml-current-directory
231f989b
LMI
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))))
41487370 281 (let ((active (nth 1 (assoc newsgroup nnml-group-alist))))
231f989b
LMI
282 (when active
283 (setcar active (or (and active-articles
284 (apply 'min active-articles))
285 (1+ (cdr active)))))
41487370
LMI
286 (nnmail-save-active nnml-group-alist nnml-active-file))
287 (nnml-save-nov)
288 (message "")
289 (nconc rest articles)))
290
231f989b 291(deffoo nnml-request-move-article
41487370
LMI
292 (article group server accept-form &optional last)
293 (let ((buf (get-buffer-create " *nnml move*"))
294 result)
231f989b
LMI
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)))
41487370 299 (and
231f989b 300 (nnml-deletable-article-p group article)
41487370
LMI
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
231f989b 309 (nnml-possibly-change-directory group server)
41487370 310 (condition-case ()
231f989b
LMI
311 (funcall nnmail-delete-file-function
312 (concat nnml-current-directory
313 (int-to-string article)))
41487370
LMI
314 (file-error nil))
315 (nnml-nov-delete-article group article)
316 (and last (nnml-save-nov))))
317 result))
318
231f989b
LMI
319(deffoo nnml-request-accept-article (group &optional server last)
320 (nnml-possibly-change-directory group server)
321 (nnmail-check-syntax)
41487370
LMI
322 (let (result)
323 (if (stringp group)
324 (and
325 (nnmail-activate 'nnml)
326 ;; We trick the choosing function into believing that only one
a7acbbe4 327 ;; group is available.
41487370
LMI
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
231f989b 341(deffoo nnml-request-replace-article (article group buffer)
41487370
LMI
342 (nnml-possibly-change-directory group)
343 (save-excursion
344 (set-buffer buffer)
345 (nnml-possibly-create-directory group)
231f989b
LMI
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))
41487370
LMI
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)
231f989b 377 (nnheader-insert-nov headers)
41487370
LMI
378 (nnml-save-nov)
379 t)))))
380
231f989b
LMI
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)
41487370 408
231f989b
LMI
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)))
41487370 434
231f989b
LMI
435\f
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)
41487370
LMI
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)))
231f989b
LMI
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))))
41487370 509 (goto-char (point-min))
231f989b 510 (while (and (not (eobp)) (> first (read (current-buffer))))
41487370
LMI
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)))
231f989b 518 t))))))
41487370 519
231f989b
LMI
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)
41487370
LMI
531
532(defun nnml-possibly-create-directory (group)
533 (let (dir dirs)
231f989b 534 (setq dir (nnmail-group-pathname group nnml-directory))
41487370
LMI
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)))
231f989b 540 (nnheader-message 5 "Creating mail directory %s" (car dirs))
41487370
LMI
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)))
231f989b 546 chars headers)
41487370
LMI
547 (setq chars (nnmail-insert-lines))
548 (nnmail-insert-xref group-art)
231f989b 549 (run-hooks 'nnmail-prepare-save-mail-hook)
41487370
LMI
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
231f989b
LMI
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)))))
41487370
LMI
563 (if first
564 ;; It was already saved, so we just make a hard link.
231f989b 565 (funcall nnmail-crosspost-link-function first file t)
41487370
LMI
566 ;; Save the article.
567 (write-region (point-min) (point-max) file nil
231f989b 568 (if (nnheader-be-verbose 5) nil 'nomesg))
41487370
LMI
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.
231f989b 574 (setq headers (nnml-parse-head chars))
41487370
LMI
575 ;; Output the nov line to all nov databases that should have it.
576 (let ((ga group-art))
577 (while ga
231f989b 578 (nnml-add-nov (caar ga) (cdar ga) headers)
41487370
LMI
579 (setq ga (cdr ga))))
580 group-art))
581
582(defun nnml-active-number (group)
583 "Compute the next article number in GROUP."
231f989b 584 (let ((active (cadr (assoc group nnml-group-alist))))
41487370
LMI
585 ;; The group wasn't known to nnml, so we just create an active
586 ;; entry for it.
231f989b
LMI
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)))
41487370
LMI
603 (setcdr active (1+ (cdr active)))
604 (while (file-exists-p
231f989b 605 (concat (nnmail-group-pathname group nnml-directory)
41487370
LMI
606 (int-to-string (cdr active))))
607 (setcdr active (1+ (cdr active))))
608 (cdr active)))
609
231f989b 610(defun nnml-add-nov (group article headers)
41487370
LMI
611 "Add a nov line for the GROUP base."
612 (save-excursion
613 (set-buffer (nnml-open-nov group))
614 (goto-char (point-max))
231f989b
LMI
615 (mail-header-set-number headers article)
616 (nnheader-insert-nov headers)))
41487370
LMI
617
618(defsubst nnml-header-value ()
231f989b 619 (buffer-substring (match-end 0) (progn (end-of-line) (point))))
41487370 620
231f989b
LMI
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))))
41487370
LMI
639
640(defun nnml-open-nov (group)
641 (or (cdr (assoc group nnml-nov-buffer-alist))
642 (let ((buffer (find-file-noselect
231f989b
LMI
643 (concat (nnmail-group-pathname group nnml-directory)
644 nnml-nov-file-name))))
41487370
LMI
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
231f989b
LMI
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)))
41487370
LMI
662 (setq nnml-nov-buffer-alist (cdr nnml-nov-buffer-alist)))))
663
664;;;###autoload
231f989b
LMI
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)
41487370 683 (while dirs
231f989b
LMI
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.
41487370
LMI
689 (let ((files (sort
690 (mapcar
231f989b 691 (lambda (name) (string-to-int name))
41487370 692 (directory-files dir nil "^[0-9]+$" t))
231f989b
LMI
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))))
41487370 740 (goto-char (point-min))
231f989b
LMI
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))))))
41487370
LMI
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