Mercurial > hg > xemacs-beta

comparison lisp/gnus/nnml.el @ 70:131b0175ea99 r20-0b30

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