Commit | Line | Data |
---|---|---|
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. |
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 | ||
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 |