17493
|
1 ;;; nnml.el --- mail spool access for Gnus
|
64754
|
2
|
|
3 ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
|
68633
1077b8039c32
Update copyright notices of all files in the gnus directory.
Romain Francoise <romain@orebokech.com>
diff
changeset
|
4 ;; 2004, 2005, 2006 Free Software Foundation, Inc.
|
17493
|
5
|
56927
|
6 ;; Author: Simon Josefsson <simon@josefsson.org> (adding MARKS)
|
|
7 ;; Lars Magne Ingebrigtsen <larsi@gnus.org>
|
|
8 ;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
|
17493
|
9 ;; Keywords: news, mail
|
|
10
|
|
11 ;; This file is part of GNU Emacs.
|
|
12
|
|
13 ;; GNU Emacs is free software; you can redistribute it and/or modify
|
|
14 ;; it under the terms of the GNU General Public License as published by
|
|
15 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
16 ;; any later version.
|
|
17
|
|
18 ;; GNU Emacs is distributed in the hope that it will be useful,
|
|
19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
21 ;; GNU General Public License for more details.
|
|
22
|
|
23 ;; You should have received a copy of the GNU General Public License
|
|
24 ;; along with GNU Emacs; see the file COPYING. If not, write to the
|
64085
|
25 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
|
|
26 ;; Boston, MA 02110-1301, USA.
|
17493
|
27
|
|
28 ;;; Commentary:
|
|
29
|
|
30 ;; Based on nnspool.el by Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>.
|
|
31 ;; For an overview of what the interface functions do, please see the
|
|
32 ;; Gnus sources.
|
|
33
|
|
34 ;;; Code:
|
|
35
|
56927
|
36 (require 'gnus)
|
17493
|
37 (require 'nnheader)
|
|
38 (require 'nnmail)
|
|
39 (require 'nnoo)
|
19494
|
40 (eval-when-compile (require 'cl))
|
56927
|
41
|
33302
|
42 (eval-and-compile
|
56927
|
43 (autoload 'gnus-article-unpropagatable-p "gnus-sum"))
|
17493
|
44
|
|
45 (nnoo-declare nnml)
|
|
46
|
|
47 (defvoo nnml-directory message-directory
|
19969
|
48 "Spool directory for the nnml mail backend.")
|
17493
|
49
|
|
50 (defvoo nnml-active-file
|
31716
|
51 (expand-file-name "active" nnml-directory)
|
17493
|
52 "Mail active file.")
|
|
53
|
|
54 (defvoo nnml-newsgroups-file
|
31716
|
55 (expand-file-name "newsgroups" nnml-directory)
|
17493
|
56 "Mail newsgroups description file.")
|
|
57
|
|
58 (defvoo nnml-get-new-mail t
|
|
59 "If non-nil, nnml will check the incoming mail file and split the mail.")
|
|
60
|
|
61 (defvoo nnml-nov-is-evil nil
|
56927
|
62 "If non-nil, Gnus will never generate and use nov databases for mail spools.
|
17493
|
63 Using nov databases will speed up header fetching considerably.
|
|
64 This variable shouldn't be flipped much. If you have, for some reason,
|
|
65 set this to t, and want to set it to nil again, you should always run
|
|
66 the `nnml-generate-nov-databases' command. The function will go
|
|
67 through all nnml directories and generate nov databases for them
|
|
68 all. This may very well take some time.")
|
|
69
|
56927
|
70 (defvoo nnml-marks-is-evil nil
|
|
71 "If non-nil, Gnus will never generate and use marks file for mail spools.
|
|
72 Using marks files makes it possible to backup and restore mail groups
|
|
73 separately from `.newsrc.eld'. If you have, for some reason, set this
|
|
74 to t, and want to set it to nil again, you should always remove the
|
|
75 corresponding marks file (usually named `.marks' in the nnml group
|
|
76 directory, but see `nnml-marks-file-name') for the group. Then the
|
|
77 marks file will be regenerated properly by Gnus.")
|
|
78
|
17493
|
79 (defvoo nnml-prepare-save-mail-hook nil
|
|
80 "Hook run narrowed to an article before saving.")
|
|
81
|
|
82 (defvoo nnml-inhibit-expiry nil
|
|
83 "If non-nil, inhibit expiry.")
|
|
84
|
56927
|
85 (defvoo nnml-use-compressed-files nil
|
|
86 "If non-nil, allow using compressed message files.")
|
17493
|
87
|
|
88
|
|
89
|
|
90 (defconst nnml-version "nnml 1.0"
|
|
91 "nnml version.")
|
|
92
|
|
93 (defvoo nnml-nov-file-name ".overview")
|
56927
|
94 (defvoo nnml-marks-file-name ".marks")
|
17493
|
95
|
|
96 (defvoo nnml-current-directory nil)
|
|
97 (defvoo nnml-current-group nil)
|
|
98 (defvoo nnml-status-string "")
|
|
99 (defvoo nnml-nov-buffer-alist nil)
|
|
100 (defvoo nnml-group-alist nil)
|
|
101 (defvoo nnml-active-timestamp nil)
|
|
102 (defvoo nnml-article-file-alist nil)
|
|
103
|
|
104 (defvoo nnml-generate-active-function 'nnml-generate-active-info)
|
|
105
|
24357
|
106 (defvar nnml-nov-buffer-file-name nil)
|
|
107
|
31716
|
108 (defvoo nnml-file-coding-system nnmail-file-coding-system)
|
|
109
|
56927
|
110 (defvoo nnml-marks nil)
|
|
111
|
|
112 (defvar nnml-marks-modtime (gnus-make-hashtable))
|
|
113
|
17493
|
114
|
|
115 ;;; Interface functions.
|
|
116
|
|
117 (nnoo-define-basics nnml)
|
|
118
|
|
119 (deffoo nnml-retrieve-headers (sequence &optional group server fetch-old)
|
|
120 (when (nnml-possibly-change-directory group server)
|
|
121 (save-excursion
|
|
122 (set-buffer nntp-server-buffer)
|
|
123 (erase-buffer)
|
56927
|
124 (let* ((file nil)
|
|
125 (number (length sequence))
|
|
126 (count 0)
|
|
127 (file-name-coding-system nnmail-pathname-coding-system)
|
|
128 beg article)
|
17493
|
129 (if (stringp (car sequence))
|
|
130 'headers
|
|
131 (if (nnml-retrieve-headers-with-nov sequence fetch-old)
|
|
132 'nov
|
|
133 (while sequence
|
|
134 (setq article (car sequence))
|
|
135 (setq file (nnml-article-to-file article))
|
|
136 (when (and file
|
|
137 (file-exists-p file)
|
|
138 (not (file-directory-p file)))
|
|
139 (insert (format "221 %d Article retrieved.\n" article))
|
|
140 (setq beg (point))
|
|
141 (nnheader-insert-head file)
|
|
142 (goto-char beg)
|
56927
|
143 (if (re-search-forward "\n\r?\n" nil t)
|
17493
|
144 (forward-char -1)
|
|
145 (goto-char (point-max))
|
|
146 (insert "\n\n"))
|
|
147 (insert ".\n")
|
|
148 (delete-region (point) (point-max)))
|
|
149 (setq sequence (cdr sequence))
|
|
150 (setq count (1+ count))
|
|
151 (and (numberp nnmail-large-newsgroup)
|
|
152 (> number nnmail-large-newsgroup)
|
|
153 (zerop (% count 20))
|
|
154 (nnheader-message 6 "nnml: Receiving headers... %d%%"
|
|
155 (/ (* count 100) number))))
|
|
156
|
|
157 (and (numberp nnmail-large-newsgroup)
|
|
158 (> number nnmail-large-newsgroup)
|
|
159 (nnheader-message 6 "nnml: Receiving headers...done"))
|
|
160
|
|
161 (nnheader-fold-continuation-lines)
|
|
162 'headers))))))
|
|
163
|
|
164 (deffoo nnml-open-server (server &optional defs)
|
|
165 (nnoo-change-server 'nnml server defs)
|
|
166 (when (not (file-exists-p nnml-directory))
|
31716
|
167 (ignore-errors (make-directory nnml-directory t)))
|
17493
|
168 (cond
|
|
169 ((not (file-exists-p nnml-directory))
|
|
170 (nnml-close-server)
|
|
171 (nnheader-report 'nnml "Couldn't create directory: %s" nnml-directory))
|
|
172 ((not (file-directory-p (file-truename nnml-directory)))
|
|
173 (nnml-close-server)
|
|
174 (nnheader-report 'nnml "Not a directory: %s" nnml-directory))
|
|
175 (t
|
|
176 (nnheader-report 'nnml "Opened server %s using directory %s"
|
|
177 server nnml-directory)
|
|
178 t)))
|
|
179
|
56927
|
180 (deffoo nnml-request-regenerate (server)
|
17493
|
181 (nnml-possibly-change-directory nil server)
|
56927
|
182 (nnml-generate-nov-databases server)
|
17493
|
183 t)
|
|
184
|
|
185 (deffoo nnml-request-article (id &optional group server buffer)
|
|
186 (nnml-possibly-change-directory group server)
|
|
187 (let* ((nntp-server-buffer (or buffer nntp-server-buffer))
|
31716
|
188 (file-name-coding-system nnmail-pathname-coding-system)
|
17493
|
189 path gpath group-num)
|
|
190 (if (stringp id)
|
|
191 (when (and (setq group-num (nnml-find-group-number id))
|
|
192 (cdr
|
|
193 (assq (cdr group-num)
|
|
194 (nnheader-article-to-file-alist
|
|
195 (setq gpath
|
|
196 (nnmail-group-pathname
|
|
197 (car group-num)
|
|
198 nnml-directory))))))
|
|
199 (setq path (concat gpath (int-to-string (cdr group-num)))))
|
|
200 (setq path (nnml-article-to-file id)))
|
|
201 (cond
|
|
202 ((not path)
|
|
203 (nnheader-report 'nnml "No such article: %s" id))
|
|
204 ((not (file-exists-p path))
|
|
205 (nnheader-report 'nnml "No such file: %s" path))
|
|
206 ((file-directory-p path)
|
|
207 (nnheader-report 'nnml "File is a directory: %s" path))
|
31716
|
208 ((not (save-excursion (let ((nnmail-file-coding-system
|
|
209 nnml-file-coding-system))
|
|
210 (nnmail-find-file path))))
|
17493
|
211 (nnheader-report 'nnml "Couldn't read file: %s" path))
|
|
212 (t
|
|
213 (nnheader-report 'nnml "Article %s retrieved" id)
|
|
214 ;; We return the article number.
|
|
215 (cons (if group-num (car group-num) group)
|
62907
|
216 (string-to-number (file-name-nondirectory path)))))))
|
17493
|
217
|
|
218 (deffoo nnml-request-group (group &optional server dont-check)
|
31716
|
219 (let ((file-name-coding-system nnmail-pathname-coding-system))
|
19601
|
220 (cond
|
|
221 ((not (nnml-possibly-change-directory group server))
|
|
222 (nnheader-report 'nnml "Invalid group (no such directory)"))
|
|
223 ((not (file-exists-p nnml-current-directory))
|
|
224 (nnheader-report 'nnml "Directory %s does not exist"
|
|
225 nnml-current-directory))
|
|
226 ((not (file-directory-p nnml-current-directory))
|
|
227 (nnheader-report 'nnml "%s is not a directory" nnml-current-directory))
|
|
228 (dont-check
|
|
229 (nnheader-report 'nnml "Group %s selected" group)
|
|
230 t)
|
|
231 (t
|
|
232 (nnheader-re-read-dir nnml-current-directory)
|
|
233 (nnmail-activate 'nnml)
|
|
234 (let ((active (nth 1 (assoc group nnml-group-alist))))
|
|
235 (if (not active)
|
|
236 (nnheader-report 'nnml "No such group: %s" group)
|
|
237 (nnheader-report 'nnml "Selected group %s" group)
|
|
238 (nnheader-insert "211 %d %d %d %s\n"
|
|
239 (max (1+ (- (cdr active) (car active))) 0)
|
|
240 (car active) (cdr active) group)))))))
|
17493
|
241
|
|
242 (deffoo nnml-request-scan (&optional group server)
|
|
243 (setq nnml-article-file-alist nil)
|
|
244 (nnml-possibly-change-directory group server)
|
|
245 (nnmail-get-new-mail 'nnml 'nnml-save-nov nnml-directory group))
|
|
246
|
|
247 (deffoo nnml-close-group (group &optional server)
|
|
248 (setq nnml-article-file-alist nil)
|
|
249 t)
|
|
250
|
|
251 (deffoo nnml-request-create-group (group &optional server args)
|
31716
|
252 (nnml-possibly-change-directory nil server)
|
17493
|
253 (nnmail-activate 'nnml)
|
24357
|
254 (cond
|
|
255 ((assoc group nnml-group-alist)
|
|
256 t)
|
|
257 ((and (file-exists-p (nnmail-group-pathname group nnml-directory))
|
|
258 (not (file-directory-p (nnmail-group-pathname group nnml-directory))))
|
|
259 (nnheader-report 'nnml "%s is a file"
|
|
260 (nnmail-group-pathname group nnml-directory)))
|
|
261 (t
|
17493
|
262 (let (active)
|
|
263 (push (list group (setq active (cons 1 0)))
|
|
264 nnml-group-alist)
|
|
265 (nnml-possibly-create-directory group)
|
|
266 (nnml-possibly-change-directory group server)
|
56927
|
267 (let ((articles (nnml-directory-articles nnml-current-directory)))
|
17493
|
268 (when articles
|
|
269 (setcar active (apply 'min articles))
|
|
270 (setcdr active (apply 'max articles))))
|
24357
|
271 (nnmail-save-active nnml-group-alist nnml-active-file)
|
|
272 t))))
|
17493
|
273
|
|
274 (deffoo nnml-request-list (&optional server)
|
|
275 (save-excursion
|
19601
|
276 (let ((nnmail-file-coding-system nnmail-active-file-coding-system)
|
31716
|
277 (file-name-coding-system nnmail-pathname-coding-system))
|
|
278 (nnmail-find-file nnml-active-file))
|
17493
|
279 (setq nnml-group-alist (nnmail-get-active))
|
|
280 t))
|
|
281
|
|
282 (deffoo nnml-request-newgroups (date &optional server)
|
|
283 (nnml-request-list server))
|
|
284
|
|
285 (deffoo nnml-request-list-newsgroups (&optional server)
|
|
286 (save-excursion
|
|
287 (nnmail-find-file nnml-newsgroups-file)))
|
|
288
|
31716
|
289 (deffoo nnml-request-expire-articles (articles group &optional server force)
|
17493
|
290 (nnml-possibly-change-directory group server)
|
24357
|
291 (let ((active-articles
|
56927
|
292 (nnml-directory-articles nnml-current-directory))
|
24357
|
293 (is-old t)
|
|
294 article rest mod-time number)
|
17493
|
295 (nnmail-activate 'nnml)
|
|
296
|
24357
|
297 (setq active-articles (sort active-articles '<))
|
|
298 ;; Articles not listed in active-articles are already gone,
|
|
299 ;; so don't try to expire them.
|
|
300 (setq articles (gnus-sorted-intersection articles active-articles))
|
|
301
|
17493
|
302 (while (and articles is-old)
|
56927
|
303 (if (and (setq article (nnml-article-to-file
|
|
304 (setq number (pop articles))))
|
|
305 (setq mod-time (nth 5 (file-attributes article)))
|
|
306 (nnml-deletable-article-p group number)
|
|
307 (setq is-old (nnmail-expired-article-p group mod-time force
|
|
308 nnml-inhibit-expiry)))
|
|
309 (progn
|
|
310 ;; Allow a special target group.
|
|
311 (unless (eq nnmail-expiry-target 'delete)
|
|
312 (with-temp-buffer
|
|
313 (nnml-request-article number group server (current-buffer))
|
|
314 (let (nnml-current-directory
|
|
315 nnml-current-group
|
|
316 nnml-article-file-alist)
|
|
317 (nnmail-expiry-target-group nnmail-expiry-target group)))
|
|
318 ;; Maybe directory is changed during nnmail-expiry-target-group.
|
|
319 (nnml-possibly-change-directory group server))
|
|
320 (nnheader-message 5 "Deleting article %s in %s"
|
|
321 number group)
|
|
322 (condition-case ()
|
|
323 (funcall nnmail-delete-file-function article)
|
|
324 (file-error
|
|
325 (push number rest)))
|
|
326 (setq active-articles (delq number active-articles))
|
|
327 (nnml-nov-delete-article group number))
|
|
328 (push number rest)))
|
17493
|
329 (let ((active (nth 1 (assoc group nnml-group-alist))))
|
|
330 (when active
|
|
331 (setcar active (or (and active-articles
|
|
332 (apply 'min active-articles))
|
|
333 (1+ (cdr active)))))
|
|
334 (nnmail-save-active nnml-group-alist nnml-active-file))
|
|
335 (nnml-save-nov)
|
|
336 (nconc rest articles)))
|
|
337
|
|
338 (deffoo nnml-request-move-article
|
31716
|
339 (article group server accept-form &optional last)
|
17493
|
340 (let ((buf (get-buffer-create " *nnml move*"))
|
|
341 result)
|
|
342 (nnml-possibly-change-directory group server)
|
|
343 (nnml-update-file-alist)
|
|
344 (and
|
|
345 (nnml-deletable-article-p group article)
|
|
346 (nnml-request-article article group server)
|
49598
|
347 (let (nnml-current-directory
|
|
348 nnml-current-group
|
31716
|
349 nnml-article-file-alist)
|
|
350 (save-excursion
|
|
351 (set-buffer buf)
|
|
352 (insert-buffer-substring nntp-server-buffer)
|
|
353 (setq result (eval accept-form))
|
|
354 (kill-buffer (current-buffer))
|
|
355 result))
|
17493
|
356 (progn
|
|
357 (nnml-possibly-change-directory group server)
|
|
358 (condition-case ()
|
|
359 (funcall nnmail-delete-file-function
|
|
360 (nnml-article-to-file article))
|
|
361 (file-error nil))
|
|
362 (nnml-nov-delete-article group article)
|
|
363 (when last
|
|
364 (nnml-save-nov)
|
|
365 (nnmail-save-active nnml-group-alist nnml-active-file))))
|
|
366 result))
|
|
367
|
|
368 (deffoo nnml-request-accept-article (group &optional server last)
|
|
369 (nnml-possibly-change-directory group server)
|
|
370 (nnmail-check-syntax)
|
|
371 (let (result)
|
|
372 (when nnmail-cache-accepted-message-ids
|
56927
|
373 (nnmail-cache-insert (nnmail-fetch-field "message-id")
|
|
374 group
|
|
375 (nnmail-fetch-field "subject")
|
|
376 (nnmail-fetch-field "from")))
|
17493
|
377 (if (stringp group)
|
|
378 (and
|
|
379 (nnmail-activate 'nnml)
|
|
380 (setq result (car (nnml-save-mail
|
|
381 (list (cons group (nnml-active-number group))))))
|
|
382 (progn
|
|
383 (nnmail-save-active nnml-group-alist nnml-active-file)
|
|
384 (and last (nnml-save-nov))))
|
|
385 (and
|
|
386 (nnmail-activate 'nnml)
|
|
387 (if (and (not (setq result (nnmail-article-group 'nnml-active-number)))
|
|
388 (yes-or-no-p "Moved to `junk' group; delete article? "))
|
|
389 (setq result 'junk)
|
|
390 (setq result (car (nnml-save-mail result))))
|
|
391 (when last
|
|
392 (nnmail-save-active nnml-group-alist nnml-active-file)
|
|
393 (when nnmail-cache-accepted-message-ids
|
|
394 (nnmail-cache-close))
|
|
395 (nnml-save-nov))))
|
|
396 result))
|
|
397
|
56927
|
398 (deffoo nnml-request-post (&optional server)
|
|
399 (nnmail-do-request-post 'nnml-request-accept-article server))
|
|
400
|
17493
|
401 (deffoo nnml-request-replace-article (article group buffer)
|
|
402 (nnml-possibly-change-directory group)
|
|
403 (save-excursion
|
|
404 (set-buffer buffer)
|
|
405 (nnml-possibly-create-directory group)
|
|
406 (let ((chars (nnmail-insert-lines))
|
|
407 (art (concat (int-to-string article) "\t"))
|
|
408 headers)
|
31716
|
409 (when (ignore-errors
|
|
410 (nnmail-write-region
|
|
411 (point-min) (point-max)
|
|
412 (or (nnml-article-to-file article)
|
|
413 (expand-file-name (int-to-string article)
|
|
414 nnml-current-directory))
|
|
415 nil (if (nnheader-be-verbose 5) nil 'nomesg))
|
|
416 t)
|
17493
|
417 (setq headers (nnml-parse-head chars article))
|
|
418 ;; Replace the NOV line in the NOV file.
|
|
419 (save-excursion
|
|
420 (set-buffer (nnml-open-nov group))
|
|
421 (goto-char (point-min))
|
|
422 (if (or (looking-at art)
|
|
423 (search-forward (concat "\n" art) nil t))
|
|
424 ;; Delete the old NOV line.
|
56927
|
425 (gnus-delete-line)
|
17493
|
426 ;; The line isn't here, so we have to find out where
|
|
427 ;; we should insert it. (This situation should never
|
|
428 ;; occur, but one likes to make sure...)
|
|
429 (while (and (looking-at "[0-9]+\t")
|
62907
|
430 (< (string-to-number
|
17493
|
431 (buffer-substring
|
|
432 (match-beginning 0) (match-end 0)))
|
|
433 article)
|
|
434 (zerop (forward-line 1)))))
|
|
435 (beginning-of-line)
|
|
436 (nnheader-insert-nov headers)
|
|
437 (nnml-save-nov)
|
|
438 t)))))
|
|
439
|
|
440 (deffoo nnml-request-delete-group (group &optional force server)
|
|
441 (nnml-possibly-change-directory group server)
|
|
442 (when force
|
|
443 ;; Delete all articles in GROUP.
|
|
444 (let ((articles
|
|
445 (directory-files
|
|
446 nnml-current-directory t
|
|
447 (concat nnheader-numerical-short-files
|
56927
|
448 "\\|" (regexp-quote nnml-nov-file-name) "$"
|
|
449 "\\|" (regexp-quote nnml-marks-file-name) "$")))
|
17493
|
450 article)
|
|
451 (while articles
|
|
452 (setq article (pop articles))
|
|
453 (when (file-writable-p article)
|
|
454 (nnheader-message 5 "Deleting article %s in %s..." article group)
|
|
455 (funcall nnmail-delete-file-function article))))
|
|
456 ;; Try to delete the directory itself.
|
31716
|
457 (ignore-errors (delete-directory nnml-current-directory)))
|
17493
|
458 ;; Remove the group from all structures.
|
|
459 (setq nnml-group-alist
|
|
460 (delq (assoc group nnml-group-alist) nnml-group-alist)
|
|
461 nnml-current-group nil
|
|
462 nnml-current-directory nil)
|
|
463 ;; Save the active file.
|
|
464 (nnmail-save-active nnml-group-alist nnml-active-file)
|
|
465 t)
|
|
466
|
|
467 (deffoo nnml-request-rename-group (group new-name &optional server)
|
|
468 (nnml-possibly-change-directory group server)
|
|
469 (let ((new-dir (nnmail-group-pathname new-name nnml-directory))
|
|
470 (old-dir (nnmail-group-pathname group nnml-directory)))
|
31716
|
471 (when (ignore-errors
|
|
472 (make-directory new-dir t)
|
|
473 t)
|
17493
|
474 ;; We move the articles file by file instead of renaming
|
|
475 ;; the directory -- there may be subgroups in this group.
|
|
476 ;; One might be more clever, I guess.
|
|
477 (let ((files (nnheader-article-to-file-alist old-dir)))
|
|
478 (while files
|
|
479 (rename-file
|
|
480 (concat old-dir (cdar files))
|
|
481 (concat new-dir (cdar files)))
|
|
482 (pop files)))
|
|
483 ;; Move .overview file.
|
|
484 (let ((overview (concat old-dir nnml-nov-file-name)))
|
|
485 (when (file-exists-p overview)
|
|
486 (rename-file overview (concat new-dir nnml-nov-file-name))))
|
56927
|
487 ;; Move .marks file.
|
|
488 (let ((marks (concat old-dir nnml-marks-file-name)))
|
|
489 (when (file-exists-p marks)
|
|
490 (rename-file marks (concat new-dir nnml-marks-file-name))))
|
17493
|
491 (when (<= (length (directory-files old-dir)) 2)
|
31716
|
492 (ignore-errors (delete-directory old-dir)))
|
17493
|
493 ;; That went ok, so we change the internal structures.
|
|
494 (let ((entry (assoc group nnml-group-alist)))
|
|
495 (when entry
|
|
496 (setcar entry new-name))
|
|
497 (setq nnml-current-directory nil
|
|
498 nnml-current-group nil)
|
|
499 ;; Save the new group alist.
|
|
500 (nnmail-save-active nnml-group-alist nnml-active-file)
|
|
501 t))))
|
|
502
|
|
503 (deffoo nnml-set-status (article name value &optional group server)
|
|
504 (nnml-possibly-change-directory group server)
|
|
505 (let ((file (nnml-article-to-file article)))
|
|
506 (cond
|
|
507 ((not (file-exists-p file))
|
|
508 (nnheader-report 'nnml "File %s does not exist" file))
|
|
509 (t
|
31716
|
510 (with-temp-file file
|
17493
|
511 (nnheader-insert-file-contents file)
|
|
512 (nnmail-replace-status name value))
|
|
513 t))))
|
|
514
|
|
515
|
|
516 ;;; Internal functions.
|
|
517
|
|
518 (defun nnml-article-to-file (article)
|
|
519 (nnml-update-file-alist)
|
|
520 (let (file)
|
56927
|
521 (if (setq file
|
|
522 (if nnml-use-compressed-files
|
|
523 (cdr (assq article nnml-article-file-alist))
|
|
524 (number-to-string article)))
|
31716
|
525 (expand-file-name file nnml-current-directory)
|
56927
|
526 (when (not nnheader-directory-files-is-safe)
|
|
527 ;; Just to make sure nothing went wrong when reading over NFS --
|
|
528 ;; check once more.
|
|
529 (when (file-exists-p
|
|
530 (setq file (expand-file-name (number-to-string article)
|
|
531 nnml-current-directory)))
|
|
532 (nnml-update-file-alist t)
|
|
533 file)))))
|
17493
|
534
|
|
535 (defun nnml-deletable-article-p (group article)
|
|
536 "Say whether ARTICLE in GROUP can be deleted."
|
|
537 (let (path)
|
|
538 (when (setq path (nnml-article-to-file article))
|
|
539 (when (file-writable-p path)
|
|
540 (or (not nnmail-keep-last-article)
|
|
541 (not (eq (cdr (nth 1 (assoc group nnml-group-alist)))
|
|
542 article)))))))
|
|
543
|
|
544 ;; Find an article number in the current group given the Message-ID.
|
|
545 (defun nnml-find-group-number (id)
|
|
546 (save-excursion
|
|
547 (set-buffer (get-buffer-create " *nnml id*"))
|
|
548 (let ((alist nnml-group-alist)
|
|
549 number)
|
|
550 ;; We want to look through all .overview files, but we want to
|
|
551 ;; start with the one in the current directory. It seems most
|
|
552 ;; likely that the article we are looking for is in that group.
|
|
553 (if (setq number (nnml-find-id nnml-current-group id))
|
|
554 (cons nnml-current-group number)
|
56927
|
555 ;; It wasn't there, so we look through the other groups as well.
|
17493
|
556 (while (and (not number)
|
|
557 alist)
|
|
558 (or (string= (caar alist) nnml-current-group)
|
|
559 (setq number (nnml-find-id (caar alist) id)))
|
|
560 (or number
|
|
561 (setq alist (cdr alist))))
|
|
562 (and number
|
|
563 (cons (caar alist) number))))))
|
|
564
|
|
565 (defun nnml-find-id (group id)
|
|
566 (erase-buffer)
|
31716
|
567 (let ((nov (expand-file-name nnml-nov-file-name
|
|
568 (nnmail-group-pathname group nnml-directory)))
|
17493
|
569 number found)
|
|
570 (when (file-exists-p nov)
|
|
571 (nnheader-insert-file-contents nov)
|
|
572 (while (and (not found)
|
|
573 (search-forward id nil t)) ; We find the ID.
|
|
574 ;; And the id is in the fourth field.
|
|
575 (if (not (and (search-backward "\t" nil t 4)
|
|
576 (not (search-backward"\t" (gnus-point-at-bol) t))))
|
|
577 (forward-line 1)
|
|
578 (beginning-of-line)
|
|
579 (setq found t)
|
|
580 ;; We return the article number.
|
|
581 (setq number
|
31716
|
582 (ignore-errors (read (current-buffer))))))
|
17493
|
583 number)))
|
|
584
|
|
585 (defun nnml-retrieve-headers-with-nov (articles &optional fetch-old)
|
|
586 (if (or gnus-nov-is-evil nnml-nov-is-evil)
|
|
587 nil
|
31716
|
588 (let ((nov (expand-file-name nnml-nov-file-name nnml-current-directory)))
|
17493
|
589 (when (file-exists-p nov)
|
|
590 (save-excursion
|
|
591 (set-buffer nntp-server-buffer)
|
|
592 (erase-buffer)
|
|
593 (nnheader-insert-file-contents nov)
|
|
594 (if (and fetch-old
|
|
595 (not (numberp fetch-old)))
|
|
596 t ; Don't remove anything.
|
|
597 (nnheader-nov-delete-outside-range
|
|
598 (if fetch-old (max 1 (- (car articles) fetch-old))
|
|
599 (car articles))
|
|
600 (car (last articles)))
|
|
601 t))))))
|
|
602
|
|
603 (defun nnml-possibly-change-directory (group &optional server)
|
|
604 (when (and server
|
|
605 (not (nnml-server-opened server)))
|
|
606 (nnml-open-server server))
|
|
607 (if (not group)
|
|
608 t
|
19601
|
609 (let ((pathname (nnmail-group-pathname group nnml-directory))
|
31716
|
610 (file-name-coding-system nnmail-pathname-coding-system))
|
17493
|
611 (when (not (equal pathname nnml-current-directory))
|
|
612 (setq nnml-current-directory pathname
|
|
613 nnml-current-group group
|
|
614 nnml-article-file-alist nil))
|
|
615 (file-exists-p nnml-current-directory))))
|
|
616
|
|
617 (defun nnml-possibly-create-directory (group)
|
31716
|
618 (let ((dir (nnmail-group-pathname group nnml-directory)))
|
|
619 (unless (file-exists-p dir)
|
|
620 (make-directory (directory-file-name dir) t)
|
|
621 (nnheader-message 5 "Creating mail directory %s" dir))))
|
17493
|
622
|
|
623 (defun nnml-save-mail (group-art)
|
|
624 "Called narrowed to an article."
|
56927
|
625 (let (chars headers extension)
|
17493
|
626 (setq chars (nnmail-insert-lines))
|
56927
|
627 (setq extension
|
|
628 (and nnml-use-compressed-files
|
|
629 (> chars 1000)
|
|
630 ".gz"))
|
17493
|
631 (nnmail-insert-xref group-art)
|
|
632 (run-hooks 'nnmail-prepare-save-mail-hook)
|
|
633 (run-hooks 'nnml-prepare-save-mail-hook)
|
|
634 (goto-char (point-min))
|
|
635 (while (looking-at "From ")
|
|
636 (replace-match "X-From-Line: ")
|
|
637 (forward-line 1))
|
|
638 ;; We save the article in all the groups it belongs in.
|
|
639 (let ((ga group-art)
|
|
640 first)
|
|
641 (while ga
|
|
642 (nnml-possibly-create-directory (caar ga))
|
|
643 (let ((file (concat (nnmail-group-pathname
|
|
644 (caar ga) nnml-directory)
|
56927
|
645 (int-to-string (cdar ga))
|
|
646 extension)))
|
17493
|
647 (if first
|
|
648 ;; It was already saved, so we just make a hard link.
|
|
649 (funcall nnmail-crosspost-link-function first file t)
|
|
650 ;; Save the article.
|
|
651 (nnmail-write-region (point-min) (point-max) file nil
|
|
652 (if (nnheader-be-verbose 5) nil 'nomesg))
|
|
653 (setq first file)))
|
|
654 (setq ga (cdr ga))))
|
|
655 ;; Generate a nov line for this article. We generate the nov
|
|
656 ;; line after saving, because nov generation destroys the
|
|
657 ;; header.
|
|
658 (setq headers (nnml-parse-head chars))
|
|
659 ;; Output the nov line to all nov databases that should have it.
|
|
660 (let ((ga group-art))
|
|
661 (while ga
|
|
662 (nnml-add-nov (caar ga) (cdar ga) headers)
|
|
663 (setq ga (cdr ga))))
|
|
664 group-art))
|
|
665
|
|
666 (defun nnml-active-number (group)
|
|
667 "Compute the next article number in GROUP."
|
|
668 (let ((active (cadr (assoc group nnml-group-alist))))
|
|
669 ;; The group wasn't known to nnml, so we just create an active
|
|
670 ;; entry for it.
|
|
671 (unless active
|
|
672 ;; Perhaps the active file was corrupt? See whether
|
|
673 ;; there are any articles in this group.
|
|
674 (nnml-possibly-create-directory group)
|
|
675 (nnml-possibly-change-directory group)
|
|
676 (unless nnml-article-file-alist
|
|
677 (setq nnml-article-file-alist
|
|
678 (sort
|
56927
|
679 (nnml-current-group-article-to-file-alist)
|
24357
|
680 'car-less-than-car)))
|
17493
|
681 (setq active
|
|
682 (if nnml-article-file-alist
|
|
683 (cons (caar nnml-article-file-alist)
|
|
684 (caar (last nnml-article-file-alist)))
|
|
685 (cons 1 0)))
|
|
686 (push (list group active) nnml-group-alist))
|
|
687 (setcdr active (1+ (cdr active)))
|
|
688 (while (file-exists-p
|
31716
|
689 (expand-file-name (int-to-string (cdr active))
|
|
690 (nnmail-group-pathname group nnml-directory)))
|
17493
|
691 (setcdr active (1+ (cdr active))))
|
|
692 (cdr active)))
|
|
693
|
|
694 (defun nnml-add-nov (group article headers)
|
|
695 "Add a nov line for the GROUP base."
|
|
696 (save-excursion
|
|
697 (set-buffer (nnml-open-nov group))
|
|
698 (goto-char (point-max))
|
|
699 (mail-header-set-number headers article)
|
|
700 (nnheader-insert-nov headers)))
|
|
701
|
|
702 (defsubst nnml-header-value ()
|
56927
|
703 (buffer-substring (match-end 0) (gnus-point-at-eol)))
|
17493
|
704
|
|
705 (defun nnml-parse-head (chars &optional number)
|
|
706 "Parse the head of the current buffer."
|
|
707 (save-excursion
|
|
708 (save-restriction
|
24357
|
709 (unless (zerop (buffer-size))
|
|
710 (narrow-to-region
|
|
711 (goto-char (point-min))
|
56927
|
712 (if (re-search-forward "\n\r?\n" nil t)
|
|
713 (1- (point))
|
|
714 (point-max))))
|
|
715 (let ((headers (nnheader-parse-naked-head)))
|
17493
|
716 (mail-header-set-chars headers chars)
|
|
717 (mail-header-set-number headers number)
|
|
718 headers))))
|
|
719
|
56927
|
720 (defun nnml-get-nov-buffer (group)
|
|
721 (let ((buffer (get-buffer-create (format " *nnml overview %s*" group))))
|
|
722 (save-excursion
|
|
723 (set-buffer buffer)
|
|
724 (set (make-local-variable 'nnml-nov-buffer-file-name)
|
|
725 (expand-file-name
|
|
726 nnml-nov-file-name
|
|
727 (nnmail-group-pathname group nnml-directory)))
|
|
728 (erase-buffer)
|
|
729 (when (file-exists-p nnml-nov-buffer-file-name)
|
|
730 (nnheader-insert-file-contents nnml-nov-buffer-file-name)))
|
|
731 buffer))
|
|
732
|
17493
|
733 (defun nnml-open-nov (group)
|
|
734 (or (cdr (assoc group nnml-nov-buffer-alist))
|
56927
|
735 (let ((buffer (nnml-get-nov-buffer group)))
|
17493
|
736 (push (cons group buffer) nnml-nov-buffer-alist)
|
|
737 buffer)))
|
|
738
|
|
739 (defun nnml-save-nov ()
|
|
740 (save-excursion
|
|
741 (while nnml-nov-buffer-alist
|
|
742 (when (buffer-name (cdar nnml-nov-buffer-alist))
|
|
743 (set-buffer (cdar nnml-nov-buffer-alist))
|
|
744 (when (buffer-modified-p)
|
44453
b62714db7e04
(nnml-save-nov, nnml-generate-nov-file): Don't hardcode point-min == 1.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
745 (nnmail-write-region (point-min) (point-max)
|
b62714db7e04
(nnml-save-nov, nnml-generate-nov-file): Don't hardcode point-min == 1.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
746 nnml-nov-buffer-file-name nil 'nomesg))
|
17493
|
747 (set-buffer-modified-p nil)
|
|
748 (kill-buffer (current-buffer)))
|
|
749 (setq nnml-nov-buffer-alist (cdr nnml-nov-buffer-alist)))))
|
|
750
|
|
751 ;;;###autoload
|
56927
|
752 (defun nnml-generate-nov-databases (&optional server)
|
17493
|
753 "Generate NOV databases in all nnml directories."
|
56927
|
754 (interactive (list (or (nnoo-current-server 'nnml) "")))
|
17493
|
755 ;; Read the active file to make sure we don't re-use articles
|
|
756 ;; numbers in empty groups.
|
|
757 (nnmail-activate 'nnml)
|
56927
|
758 (unless (nnml-server-opened server)
|
|
759 (nnml-open-server server))
|
17493
|
760 (setq nnml-directory (expand-file-name nnml-directory))
|
|
761 ;; Recurse down the directories.
|
|
762 (nnml-generate-nov-databases-1 nnml-directory nil t)
|
|
763 ;; Save the active file.
|
|
764 (nnmail-save-active nnml-group-alist nnml-active-file))
|
|
765
|
|
766 (defun nnml-generate-nov-databases-1 (dir &optional seen no-active)
|
|
767 "Regenerate the NOV database in DIR."
|
|
768 (interactive "DRegenerate NOV in: ")
|
|
769 (setq dir (file-name-as-directory dir))
|
|
770 ;; Only scan this sub-tree if we haven't been here yet.
|
|
771 (unless (member (file-truename dir) seen)
|
|
772 (push (file-truename dir) seen)
|
|
773 ;; We descend recursively
|
|
774 (let ((dirs (directory-files dir t nil t))
|
|
775 dir)
|
|
776 (while (setq dir (pop dirs))
|
31716
|
777 (when (and (not (string-match "^\\." (file-name-nondirectory dir)))
|
17493
|
778 (file-directory-p dir))
|
|
779 (nnml-generate-nov-databases-1 dir seen))))
|
|
780 ;; Do this directory.
|
|
781 (let ((files (sort (nnheader-article-to-file-alist dir)
|
24357
|
782 'car-less-than-car)))
|
|
783 (if (not files)
|
|
784 (let* ((group (nnheader-file-to-group
|
|
785 (directory-file-name dir) nnml-directory))
|
|
786 (info (cadr (assoc group nnml-group-alist))))
|
|
787 (when info
|
|
788 (setcar info (1+ (cdr info)))))
|
17493
|
789 (funcall nnml-generate-active-function dir)
|
|
790 ;; Generate the nov file.
|
|
791 (nnml-generate-nov-file dir files)
|
|
792 (unless no-active
|
|
793 (nnmail-save-active nnml-group-alist nnml-active-file))))))
|
|
794
|
33302
|
795 (eval-when-compile (defvar files))
|
17493
|
796 (defun nnml-generate-active-info (dir)
|
|
797 ;; Update the active info for this group.
|
56927
|
798 (let* ((group (nnheader-file-to-group
|
|
799 (directory-file-name dir) nnml-directory))
|
|
800 (entry (assoc group nnml-group-alist))
|
|
801 (last (or (caadr entry) 0)))
|
|
802 (setq nnml-group-alist (delq entry nnml-group-alist))
|
17493
|
803 (push (list group
|
56927
|
804 (cons (or (caar files) (1+ last))
|
|
805 (max last
|
|
806 (or (let ((f files))
|
|
807 (while (cdr f) (setq f (cdr f)))
|
|
808 (caar f))
|
|
809 0))))
|
17493
|
810 nnml-group-alist)))
|
|
811
|
|
812 (defun nnml-generate-nov-file (dir files)
|
|
813 (let* ((dir (file-name-as-directory dir))
|
|
814 (nov (concat dir nnml-nov-file-name))
|
|
815 (nov-buffer (get-buffer-create " *nov*"))
|
|
816 chars file headers)
|
|
817 (save-excursion
|
|
818 ;; Init the nov buffer.
|
|
819 (set-buffer nov-buffer)
|
31716
|
820 (buffer-disable-undo)
|
17493
|
821 (erase-buffer)
|
|
822 (set-buffer nntp-server-buffer)
|
|
823 ;; Delete the old NOV file.
|
|
824 (when (file-exists-p nov)
|
|
825 (funcall nnmail-delete-file-function nov))
|
|
826 (while files
|
|
827 (unless (file-directory-p (setq file (concat dir (cdar files))))
|
|
828 (erase-buffer)
|
|
829 (nnheader-insert-file-contents file)
|
|
830 (narrow-to-region
|
|
831 (goto-char (point-min))
|
|
832 (progn
|
56927
|
833 (re-search-forward "\n\r?\n" nil t)
|
17493
|
834 (setq chars (- (point-max) (point)))
|
44453
b62714db7e04
(nnml-save-nov, nnml-generate-nov-file): Don't hardcode point-min == 1.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
835 (max (point-min) (1- (point)))))
|
19969
|
836 (unless (zerop (buffer-size))
|
17493
|
837 (goto-char (point-min))
|
|
838 (setq headers (nnml-parse-head chars (caar files)))
|
|
839 (save-excursion
|
|
840 (set-buffer nov-buffer)
|
|
841 (goto-char (point-max))
|
|
842 (nnheader-insert-nov headers)))
|
|
843 (widen))
|
|
844 (setq files (cdr files)))
|
|
845 (save-excursion
|
|
846 (set-buffer nov-buffer)
|
44453
b62714db7e04
(nnml-save-nov, nnml-generate-nov-file): Don't hardcode point-min == 1.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
847 (nnmail-write-region (point-min) (point-max) nov nil 'nomesg)
|
17493
|
848 (kill-buffer (current-buffer))))))
|
|
849
|
|
850 (defun nnml-nov-delete-article (group article)
|
|
851 (save-excursion
|
|
852 (set-buffer (nnml-open-nov group))
|
|
853 (when (nnheader-find-nov-line article)
|
|
854 (delete-region (point) (progn (forward-line 1) (point)))
|
|
855 (when (bobp)
|
|
856 (let ((active (cadr (assoc group nnml-group-alist)))
|
|
857 num)
|
|
858 (when active
|
|
859 (if (eobp)
|
|
860 (setf (car active) (1+ (cdr active)))
|
|
861 (when (and (setq num (ignore-errors (read (current-buffer))))
|
|
862 (numberp num))
|
|
863 (setf (car active) num)))))))
|
|
864 t))
|
|
865
|
19969
|
866 (defun nnml-update-file-alist (&optional force)
|
56927
|
867 (when nnml-use-compressed-files
|
|
868 (when (or (not nnml-article-file-alist)
|
|
869 force)
|
|
870 (setq nnml-article-file-alist
|
|
871 (nnml-current-group-article-to-file-alist)))))
|
|
872
|
|
873 (defun nnml-directory-articles (dir)
|
|
874 "Return a list of all article files in a directory.
|
|
875 Use the nov database for that directory if available."
|
|
876 (if (or gnus-nov-is-evil nnml-nov-is-evil
|
|
877 (not (file-exists-p
|
|
878 (expand-file-name nnml-nov-file-name dir))))
|
|
879 (nnheader-directory-articles dir)
|
|
880 ;; build list from .overview if available
|
|
881 ;; We would use nnml-open-nov, except that nnml-nov-buffer-alist is
|
|
882 ;; defvoo'd, and we might get called when it hasn't been swapped in.
|
|
883 (save-excursion
|
|
884 (let ((list nil)
|
|
885 art
|
|
886 (buffer (nnml-get-nov-buffer nnml-current-group)))
|
|
887 (set-buffer buffer)
|
|
888 (goto-char (point-min))
|
|
889 (while (not (eobp))
|
|
890 (setq art (read (current-buffer)))
|
|
891 (push art list)
|
|
892 (forward-line 1))
|
|
893 list))))
|
|
894
|
|
895 (defun nnml-current-group-article-to-file-alist ()
|
|
896 "Return an alist of article/file pairs in the current group.
|
|
897 Use the nov database for the current group if available."
|
|
898 (if (or nnml-use-compressed-files
|
|
899 gnus-nov-is-evil
|
|
900 nnml-nov-is-evil
|
|
901 (not (file-exists-p
|
|
902 (expand-file-name nnml-nov-file-name
|
|
903 nnml-current-directory))))
|
|
904 (nnheader-article-to-file-alist nnml-current-directory)
|
|
905 ;; build list from .overview if available
|
|
906 (save-excursion
|
|
907 (let ((alist nil)
|
|
908 (buffer (nnml-get-nov-buffer nnml-current-group))
|
|
909 art)
|
|
910 (set-buffer buffer)
|
|
911 (goto-char (point-min))
|
|
912 (while (not (eobp))
|
|
913 (setq art (read (current-buffer)))
|
|
914 ;; assume file name is unadorned (ie. not compressed etc)
|
|
915 (push (cons art (int-to-string art)) alist)
|
|
916 (forward-line 1))
|
|
917 alist))))
|
|
918
|
|
919 (deffoo nnml-request-set-mark (group actions &optional server)
|
|
920 (nnml-possibly-change-directory group server)
|
|
921 (unless nnml-marks-is-evil
|
|
922 (nnml-open-marks group server)
|
|
923 (dolist (action actions)
|
|
924 (let ((range (nth 0 action))
|
|
925 (what (nth 1 action))
|
|
926 (marks (nth 2 action)))
|
57265
|
927 (assert (or (eq what 'add) (eq what 'del)) nil
|
56927
|
928 "Unknown request-set-mark action: %s" what)
|
|
929 (dolist (mark marks)
|
|
930 (setq nnml-marks (gnus-update-alist-soft
|
|
931 mark
|
|
932 (funcall (if (eq what 'add) 'gnus-range-add
|
|
933 'gnus-remove-from-range)
|
|
934 (cdr (assoc mark nnml-marks)) range)
|
|
935 nnml-marks)))))
|
|
936 (nnml-save-marks group server))
|
|
937 nil)
|
|
938
|
|
939 (deffoo nnml-request-update-info (group info &optional server)
|
|
940 (nnml-possibly-change-directory group server)
|
|
941 (when (and (not nnml-marks-is-evil) (nnml-marks-changed-p group))
|
|
942 (nnheader-message 8 "Updating marks for %s..." group)
|
|
943 (nnml-open-marks group server)
|
|
944 ;; Update info using `nnml-marks'.
|
|
945 (mapcar (lambda (pred)
|
|
946 (unless (memq (cdr pred) gnus-article-unpropagated-mark-lists)
|
|
947 (gnus-info-set-marks
|
|
948 info
|
|
949 (gnus-update-alist-soft
|
|
950 (cdr pred)
|
|
951 (cdr (assq (cdr pred) nnml-marks))
|
|
952 (gnus-info-marks info))
|
|
953 t)))
|
|
954 gnus-article-mark-lists)
|
|
955 (let ((seen (cdr (assq 'read nnml-marks))))
|
|
956 (gnus-info-set-read info
|
|
957 (if (and (integerp (car seen))
|
|
958 (null (cdr seen)))
|
|
959 (list (cons (car seen) (car seen)))
|
|
960 seen)))
|
|
961 (nnheader-message 8 "Updating marks for %s...done" group))
|
|
962 info)
|
|
963
|
|
964 (defun nnml-marks-changed-p (group)
|
|
965 (let ((file (expand-file-name nnml-marks-file-name
|
|
966 (nnmail-group-pathname group nnml-directory))))
|
|
967 (if (null (gnus-gethash file nnml-marks-modtime))
|
|
968 t ;; never looked at marks file, assume it has changed
|
|
969 (not (equal (gnus-gethash file nnml-marks-modtime)
|
|
970 (nth 5 (file-attributes file)))))))
|
|
971
|
|
972 (defun nnml-save-marks (group server)
|
|
973 (let ((file-name-coding-system nnmail-pathname-coding-system)
|
|
974 (file (expand-file-name nnml-marks-file-name
|
|
975 (nnmail-group-pathname group nnml-directory))))
|
|
976 (condition-case err
|
|
977 (progn
|
|
978 (nnml-possibly-create-directory group)
|
|
979 (with-temp-file file
|
|
980 (erase-buffer)
|
|
981 (gnus-prin1 nnml-marks)
|
|
982 (insert "\n"))
|
|
983 (gnus-sethash file
|
|
984 (nth 5 (file-attributes file))
|
|
985 nnml-marks-modtime))
|
|
986 (error (or (gnus-yes-or-no-p
|
|
987 (format "Could not write to %s (%s). Continue? " file err))
|
58222
dd462aabc959
(nnml-save-marks): Add missing format field in call to `error'.
Luc Teirlinck <teirllm@auburn.edu>
diff
changeset
|
988 (error "Cannot write to %s (%s)" file err))))))
|
56927
|
989
|
|
990 (defun nnml-open-marks (group server)
|
|
991 (let ((file (expand-file-name
|
|
992 nnml-marks-file-name
|
|
993 (nnmail-group-pathname group nnml-directory))))
|
|
994 (if (file-exists-p file)
|
|
995 (condition-case err
|
|
996 (with-temp-buffer
|
|
997 (gnus-sethash file (nth 5 (file-attributes file))
|
|
998 nnml-marks-modtime)
|
|
999 (nnheader-insert-file-contents file)
|
|
1000 (setq nnml-marks (read (current-buffer)))
|
|
1001 (dolist (el gnus-article-unpropagated-mark-lists)
|
|
1002 (setq nnml-marks (gnus-remassoc el nnml-marks))))
|
|
1003 (error (or (gnus-yes-or-no-p
|
|
1004 (format "Error reading nnml marks file %s (%s). Continuing will use marks from .newsrc.eld. Continue? " file err))
|
|
1005 (error "Cannot read nnml marks file %s (%s)" file err))))
|
|
1006 ;; User didn't have a .marks file. Probably first time
|
|
1007 ;; user of the .marks stuff. Bootstrap it from .newsrc.eld.
|
|
1008 (let ((info (gnus-get-info
|
|
1009 (gnus-group-prefixed-name
|
|
1010 group
|
|
1011 (gnus-server-to-method (format "nnml:%s" server))))))
|
|
1012 (nnheader-message 7 "Bootstrapping marks for %s..." group)
|
|
1013 (setq nnml-marks (gnus-info-marks info))
|
|
1014 (push (cons 'read (gnus-info-read info)) nnml-marks)
|
|
1015 (dolist (el gnus-article-unpropagated-mark-lists)
|
|
1016 (setq nnml-marks (gnus-remassoc el nnml-marks)))
|
|
1017 (nnml-save-marks group server)
|
|
1018 (nnheader-message 7 "Bootstrapping marks for %s...done" group)))))
|
17493
|
1019
|
|
1020 (provide 'nnml)
|
|
1021
|
52401
|
1022 ;;; arch-tag: 52c97dc3-9735-45de-b439-9e4d23b52004
|
17493
|
1023 ;;; nnml.el ends here
|