Mercurial > hg > xemacs-beta

comparison lisp/gnus/nnfolder.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 8d2a9b52c682
children 0d2f883870bc
comparison
equal deleted inserted replaced
69:804d1389bcd6 70:131b0175ea99
1 ;;; nnfolder.el --- mail folder access for Gnus 1 ;;; nnfolder.el --- mail folder 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: Scott Byer <byer@mv.us.adobe.com> 4 ;; Author: Scott Byer <byer@mv.us.adobe.com>
5 ;; Lars Magne Ingebrigtsen <larsi@ifi.uio.no> 5 ;; Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
6 ;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet> 6 ;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
7 ;; Keywords: mail 7 ;; Keywords: mail
23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, 23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
24 ;; Boston, MA 02111-1307, USA. 24 ;; Boston, MA 02111-1307, USA.
25 25
26 ;;; Commentary: 26 ;;; Commentary:
27 27
28 ;; For an overview of what the interface functions do, please see the
29 ;; Gnus sources.
30
31 ;; Various enhancements by byer@mv.us.adobe.com (Scott Byer).
32
28 ;;; Code: 33 ;;; Code:
29 34
30 (require 'nnheader) 35 (require 'nnheader)
31 (require 'message) 36 (require 'message)
32 (require 'nnmail) 37 (require 'nnmail)
33 (require 'nnoo) 38 (require 'nnoo)
34 (require 'cl) 39 (eval-when-compile (require 'cl))
35 (require 'gnus-util)
36 40
37 (nnoo-declare nnfolder) 41 (nnoo-declare nnfolder)
38 42
39 (defvoo nnfolder-directory (expand-file-name message-directory) 43 (defvoo nnfolder-directory (expand-file-name message-directory)
40 "The name of the nnfolder directory.") 44 "The name of the nnfolder directory.")
41 45
42 (defvoo nnfolder-active-file 46 (defvoo nnfolder-active-file
43 (nnheader-concat nnfolder-directory "active") 47 (nnheader-concat nnfolder-directory "active")
44 "The name of the active file.") 48 "The name of the active file.")
45 49
46 ;; I renamed this variable to something more in keeping with the general GNU 50 ;; I renamed this variable to something more in keeping with the general GNU
47 ;; style. -SLB 51 ;; style. -SLB
48 52
49 (defvoo nnfolder-ignore-active-file nil 53 (defvoo nnfolder-ignore-active-file nil
50 "If non-nil, causes nnfolder to do some extra work in order to determine 54 "If non-nil, causes nnfolder to do some extra work in order to determine
51 the true active ranges of an mbox file. Note that the active file is still 55 the true active ranges of an mbox file. Note that the active file is still
52 saved, but it's values are not used. This costs some extra time when 56 saved, but it's values are not used. This costs some extra time when
53 scanning an mbox when opening it.") 57 scanning an mbox when opening it.")
54 58
55 (defvoo nnfolder-distrust-mbox nil 59 (defvoo nnfolder-distrust-mbox nil
56 "If non-nil, causes nnfolder to not trust the user with respect to 60 "If non-nil, causes nnfolder to not trust the user with respect to
57 inserting unaccounted for mail in the middle of an mbox file. This can greatly 61 inserting unaccounted for mail in the middle of an mbox file. This can greatly
58 slow down scans, which now must scan the entire file for unmarked messages. 62 slow down scans, which now must scan the entire file for unmarked messages.
59 When nil, scans occur forward from the last marked message, a huge 63 When nil, scans occur forward from the last marked message, a huge
60 time saver for large mailboxes.") 64 time saver for large mailboxes.")
61 65
62 (defvoo nnfolder-newsgroups-file 66 (defvoo nnfolder-newsgroups-file
63 (concat (file-name-as-directory nnfolder-directory) "newsgroups") 67 (concat (file-name-as-directory nnfolder-directory) "newsgroups")
64 "Mail newsgroups description file.") 68 "Mail newsgroups description file.")
65 69
66 (defvoo nnfolder-get-new-mail t 70 (defvoo nnfolder-get-new-mail t
67 "If non-nil, nnfolder will check the incoming mail file and split the mail.") 71 "If non-nil, nnfolder will check the incoming mail file and split the mail.")
87 (defvoo nnfolder-current-buffer nil) 91 (defvoo nnfolder-current-buffer nil)
88 (defvoo nnfolder-status-string "") 92 (defvoo nnfolder-status-string "")
89 (defvoo nnfolder-group-alist nil) 93 (defvoo nnfolder-group-alist nil)
90 (defvoo nnfolder-buffer-alist nil) 94 (defvoo nnfolder-buffer-alist nil)
91 (defvoo nnfolder-scantime-alist nil) 95 (defvoo nnfolder-scantime-alist nil)
92 (defvoo nnfolder-active-timestamp nil)
93 96
94 97
95 98
96 ;;; Interface functions 99 ;;; Interface functions
97 100
99 102
100 (deffoo nnfolder-retrieve-headers (articles &optional group server fetch-old) 103 (deffoo nnfolder-retrieve-headers (articles &optional group server fetch-old)
101 (save-excursion 104 (save-excursion
102 (set-buffer nntp-server-buffer) 105 (set-buffer nntp-server-buffer)
103 (erase-buffer) 106 (erase-buffer)
104 (let (article art-string start stop) 107 (let ((delim-string (concat "^" message-unix-mail-delimiter))
108 article art-string start stop)
105 (nnfolder-possibly-change-group group server) 109 (nnfolder-possibly-change-group group server)
106 (when nnfolder-current-buffer 110 (when nnfolder-current-buffer
107 (set-buffer nnfolder-current-buffer) 111 (set-buffer nnfolder-current-buffer)
108 (goto-char (point-min)) 112 (goto-char (point-min))
109 (if (stringp (car articles)) 113 (if (stringp (car articles))
110 'headers 114 'headers
111 (while articles 115 (while articles
112 (setq article (car articles)) 116 (setq article (car articles))
113 (setq art-string (nnfolder-article-string article)) 117 (setq art-string (nnfolder-article-string article))
114 (set-buffer nnfolder-current-buffer) 118 (set-buffer nnfolder-current-buffer)
115 (when (or (search-forward art-string nil t) 119 (if (or (search-forward art-string nil t)
116 ;; Don't search the whole file twice! Also, articles 120 ;; Don't search the whole file twice! Also, articles
117 ;; probably have some locality by number, so searching 121 ;; probably have some locality by number, so searching
118 ;; backwards will be faster. Especially if we're at the 122 ;; backwards will be faster. Especially if we're at the
119 ;; beginning of the buffer :-). -SLB 123 ;; beginning of the buffer :-). -SLB
120 (search-backward art-string nil t)) 124 (search-backward art-string nil t))
121 (nnmail-search-unix-mail-delim-backward) 125 (progn
122 (setq start (point)) 126 (setq start (or (re-search-backward delim-string nil t)
123 (search-forward "\n\n" nil t) 127 (point)))
124 (setq stop (1- (point))) 128 (search-forward "\n\n" nil t)
125 (set-buffer nntp-server-buffer) 129 (setq stop (1- (point)))
126 (insert (format "221 %d Article retrieved.\n" article)) 130 (set-buffer nntp-server-buffer)
127 (insert-buffer-substring nnfolder-current-buffer start stop) 131 (insert (format "221 %d Article retrieved.\n" article))
128 (goto-char (point-max)) 132 (insert-buffer-substring nnfolder-current-buffer start stop)
129 (insert ".\n")) 133 (goto-char (point-max))
134 (insert ".\n")))
130 (setq articles (cdr articles))) 135 (setq articles (cdr articles)))
131 136
132 (set-buffer nntp-server-buffer) 137 (set-buffer nntp-server-buffer)
133 (nnheader-fold-continuation-lines) 138 (nnheader-fold-continuation-lines)
134 'headers))))) 139 'headers)))))
135 140
136 (deffoo nnfolder-open-server (server &optional defs) 141 (deffoo nnfolder-open-server (server &optional defs)
137 (nnoo-change-server 'nnfolder server defs) 142 (nnoo-change-server 'nnfolder server defs)
138 (nnmail-activate 'nnfolder t) 143 (when (not (file-exists-p nnfolder-directory))
139 (gnus-make-directory nnfolder-directory) 144 (condition-case ()
140 (cond 145 (make-directory nnfolder-directory t)
146 (error t)))
147 (cond
141 ((not (file-exists-p nnfolder-directory)) 148 ((not (file-exists-p nnfolder-directory))
142 (nnfolder-close-server) 149 (nnfolder-close-server)
143 (nnheader-report 'nnfolder "Couldn't create directory: %s" 150 (nnheader-report 'nnfolder "Couldn't create directory: %s"
144 nnfolder-directory)) 151 nnfolder-directory))
145 ((not (file-directory-p (file-truename nnfolder-directory))) 152 ((not (file-directory-p (file-truename nnfolder-directory)))
146 (nnfolder-close-server) 153 (nnfolder-close-server)
147 (nnheader-report 'nnfolder "Not a directory: %s" nnfolder-directory)) 154 (nnheader-report 'nnfolder "Not a directory: %s" nnfolder-directory))
148 (t 155 (t
149 (nnmail-activate 'nnfolder)
150 (nnheader-report 'nnfolder "Opened server %s using directory %s" 156 (nnheader-report 'nnfolder "Opened server %s using directory %s"
151 server nnfolder-directory) 157 server nnfolder-directory)
152 t))) 158 t)))
153 159
154 (deffoo nnfolder-request-close () 160 (deffoo nnfolder-request-close ()
163 (deffoo nnfolder-request-article (article &optional group server buffer) 169 (deffoo nnfolder-request-article (article &optional group server buffer)
164 (nnfolder-possibly-change-group group server) 170 (nnfolder-possibly-change-group group server)
165 (save-excursion 171 (save-excursion
166 (set-buffer nnfolder-current-buffer) 172 (set-buffer nnfolder-current-buffer)
167 (goto-char (point-min)) 173 (goto-char (point-min))
168 (when (search-forward (nnfolder-article-string article) nil t) 174 (if (search-forward (nnfolder-article-string article) nil t)
169 (let (start stop) 175 (let (start stop)
170 (nnmail-search-unix-mail-delim-backward) 176 (re-search-backward (concat "^" message-unix-mail-delimiter) nil t)
171 (setq start (point)) 177 (setq start (point))
172 (forward-line 1) 178 (forward-line 1)
173 (unless (and (nnmail-search-unix-mail-delim) 179 (or (and (re-search-forward
174 (forward-line -1)) 180 (concat "^" message-unix-mail-delimiter) nil t)
175 (goto-char (point-max))) 181 (forward-line -1))
176 (setq stop (point)) 182 (goto-char (point-max)))
177 (let ((nntp-server-buffer (or buffer nntp-server-buffer))) 183 (setq stop (point))
178 (set-buffer nntp-server-buffer) 184 (let ((nntp-server-buffer (or buffer nntp-server-buffer)))
179 (erase-buffer) 185 (set-buffer nntp-server-buffer)
180 (insert-buffer-substring nnfolder-current-buffer start stop) 186 (erase-buffer)
181 (goto-char (point-min)) 187 (insert-buffer-substring nnfolder-current-buffer start stop)
182 (while (looking-at "From ")
183 (delete-char 5)
184 (insert "X-From-Line: ")
185 (forward-line 1))
186 (if (numberp article)
187 (cons nnfolder-current-group article)
188 (goto-char (point-min)) 188 (goto-char (point-min))
189 (search-forward (concat "\n" nnfolder-article-marker)) 189 (while (looking-at "From ")
190 (cons nnfolder-current-group 190 (delete-char 5)
191 (string-to-int 191 (insert "X-From-Line: ")
192 (buffer-substring 192 (forward-line 1))
193 (point) (progn (end-of-line) (point))))))))))) 193 (if (numberp article)
194 (cons nnfolder-current-group article)
195 (goto-char (point-min))
196 (search-forward (concat "\n" nnfolder-article-marker))
197 (cons nnfolder-current-group
198 (string-to-int
199 (buffer-substring
200 (point) (progn (end-of-line) (point)))))))))))
194 201
195 (deffoo nnfolder-request-group (group &optional server dont-check) 202 (deffoo nnfolder-request-group (group &optional server dont-check)
196 (nnfolder-possibly-change-group group server t) 203 (save-excursion
197 (save-excursion 204 (nnmail-activate 'nnfolder)
198 (if (not (assoc group nnfolder-group-alist)) 205 (if (not (assoc group nnfolder-group-alist))
199 (nnheader-report 'nnfolder "No such group: %s" group) 206 (nnheader-report 'nnfolder "No such group: %s" group)
207 (nnfolder-possibly-change-group group server)
200 (if dont-check 208 (if dont-check
201 (progn 209 (progn
202 (nnheader-report 'nnfolder "Selected group %s" group) 210 (nnheader-report 'nnfolder "Selected group %s" group)
203 t) 211 t)
204 (let* ((active (assoc group nnfolder-group-alist)) 212 (let* ((active (assoc group nnfolder-group-alist))
205 (group (car active)) 213 (group (car active))
206 (range (cadr active))) 214 (range (cadr active)))
207 (cond 215 (cond
208 ((null active) 216 ((null active)
209 (nnheader-report 'nnfolder "No such group: %s" group)) 217 (nnheader-report 'nnfolder "No such group: %s" group))
210 ((null nnfolder-current-group) 218 ((null nnfolder-current-group)
211 (nnheader-report 'nnfolder "Empty group: %s" group)) 219 (nnheader-report 'nnfolder "Empty group: %s" group))
212 (t 220 (t
213 (nnheader-report 'nnfolder "Selected group %s" group) 221 (nnheader-report 'nnfolder "Selected group %s" group)
214 (nnheader-insert "211 %d %d %d %s\n" 222 (nnheader-insert "211 %d %d %d %s\n"
215 (1+ (- (cdr range) (car range))) 223 (1+ (- (cdr range) (car range)))
216 (car range) (cdr range) group)))))))) 224 (car range) (cdr range) group))))))))
217 225
218 (deffoo nnfolder-request-scan (&optional group server) 226 (deffoo nnfolder-request-scan (&optional group server)
219 (nnfolder-possibly-change-group nil server) 227 (nnfolder-possibly-change-group group server t)
220 (when nnfolder-get-new-mail 228 (nnmail-get-new-mail
221 (nnfolder-possibly-change-group group server) 229 'nnfolder
222 (nnmail-get-new-mail 230 (lambda ()
223 'nnfolder 231 (let ((bufs nnfolder-buffer-alist))
224 (lambda () 232 (save-excursion
225 (let ((bufs nnfolder-buffer-alist)) 233 (while bufs
226 (save-excursion 234 (if (not (buffer-name (nth 1 (car bufs))))
227 (while bufs 235 (setq nnfolder-buffer-alist
228 (if (not (gnus-buffer-live-p (nth 1 (car bufs)))) 236 (delq (car bufs) nnfolder-buffer-alist))
229 (setq nnfolder-buffer-alist 237 (set-buffer (nth 1 (car bufs)))
230 (delq (car bufs) nnfolder-buffer-alist)) 238 (nnfolder-save-buffer)
231 (set-buffer (nth 1 (car bufs))) 239 (kill-buffer (current-buffer)))
232 (nnfolder-save-buffer) 240 (setq bufs (cdr bufs))))))
233 (kill-buffer (current-buffer))) 241 nnfolder-directory
234 (setq bufs (cdr bufs)))))) 242 group))
235 nnfolder-directory
236 group)))
237 243
238 ;; Don't close the buffer if we're not shutting down the server. This way, 244 ;; Don't close the buffer if we're not shutting down the server. This way,
239 ;; we can keep the buffer in the group buffer cache, and not have to grovel 245 ;; we can keep the buffer in the group buffer cache, and not have to grovel
240 ;; over the buffer again unless we add new mail to it or modify it in some 246 ;; over the buffer again unless we add new mail to it or modify it in some
241 ;; way. 247 ;; way.
244 ;; Make sure we _had_ the group open. 250 ;; Make sure we _had_ the group open.
245 (when (or (assoc group nnfolder-buffer-alist) 251 (when (or (assoc group nnfolder-buffer-alist)
246 (equal group nnfolder-current-group)) 252 (equal group nnfolder-current-group))
247 (let ((inf (assoc group nnfolder-buffer-alist))) 253 (let ((inf (assoc group nnfolder-buffer-alist)))
248 (when inf 254 (when inf
249 (when (and nnfolder-current-group 255 (when nnfolder-current-group
250 nnfolder-current-buffer)
251 (push (list nnfolder-current-group nnfolder-current-buffer) 256 (push (list nnfolder-current-group nnfolder-current-buffer)
252 nnfolder-buffer-alist)) 257 nnfolder-buffer-alist))
253 (setq nnfolder-buffer-alist 258 (setq nnfolder-buffer-alist
254 (delq inf nnfolder-buffer-alist)) 259 (delq inf nnfolder-buffer-alist))
255 (setq nnfolder-current-buffer (cadr inf) 260 (setq nnfolder-current-buffer (cadr inf)
268 nnfolder-buffer-alist))))) 273 nnfolder-buffer-alist)))))
269 (setq nnfolder-current-group nil 274 (setq nnfolder-current-group nil
270 nnfolder-current-buffer nil) 275 nnfolder-current-buffer nil)
271 t) 276 t)
272 277
273 (deffoo nnfolder-request-create-group (group &optional server args) 278 (deffoo nnfolder-request-create-group (group &optional server)
274 (nnfolder-possibly-change-group nil server) 279 (nnfolder-possibly-change-group nil server)
275 (nnmail-activate 'nnfolder) 280 (nnmail-activate 'nnfolder)
276 (when group 281 (when group
277 (unless (assoc group nnfolder-group-alist) 282 (unless (assoc group nnfolder-group-alist)
278 (push (list group (cons 1 0)) nnfolder-group-alist) 283 (push (list group (cons 1 0)) nnfolder-group-alist)
279 (nnmail-save-active nnfolder-group-alist nnfolder-active-file))) 284 (nnmail-save-active nnfolder-group-alist nnfolder-active-file)))
280 t) 285 t)
281 286
282 (deffoo nnfolder-request-list (&optional server) 287 (deffoo nnfolder-request-list (&optional server)
283 (nnfolder-possibly-change-group nil server) 288 (nnfolder-possibly-change-group nil server)
284 (save-excursion 289 (save-excursion
285 (nnmail-find-file nnfolder-active-file) 290 (nnmail-find-file nnfolder-active-file)
286 (setq nnfolder-group-alist (nnmail-get-active)) 291 (setq nnfolder-group-alist (nnmail-get-active))))
287 t))
288 292
289 (deffoo nnfolder-request-newgroups (date &optional server) 293 (deffoo nnfolder-request-newgroups (date &optional server)
290 (nnfolder-possibly-change-group nil server) 294 (nnfolder-possibly-change-group nil server)
291 (nnfolder-request-list server)) 295 (nnfolder-request-list server))
292 296
293 (deffoo nnfolder-request-list-newsgroups (&optional server) 297 (deffoo nnfolder-request-list-newsgroups (&optional server)
294 (nnfolder-possibly-change-group nil server) 298 (nnfolder-possibly-change-group nil server)
295 (save-excursion 299 (save-excursion
296 (nnmail-find-file nnfolder-newsgroups-file))) 300 (nnmail-find-file nnfolder-newsgroups-file)))
297 301
298 (deffoo nnfolder-request-expire-articles 302 (deffoo nnfolder-request-expire-articles
299 (articles newsgroup &optional server force) 303 (articles newsgroup &optional server force)
300 (nnfolder-possibly-change-group newsgroup server) 304 (nnfolder-possibly-change-group newsgroup server)
301 (let* ((is-old t) 305 (let* ((is-old t)
302 rest) 306 rest)
303 (nnmail-activate 'nnfolder) 307 (nnmail-activate 'nnfolder)
304 308
305 (save-excursion 309 (save-excursion
306 (set-buffer nnfolder-current-buffer) 310 (set-buffer nnfolder-current-buffer)
307 (while (and articles is-old) 311 (while (and articles is-old)
308 (goto-char (point-min)) 312 (goto-char (point-min))
309 (when (search-forward (nnfolder-article-string (car articles)) nil t) 313 (if (search-forward (nnfolder-article-string (car articles)) nil t)
310 (if (setq is-old 314 (if (setq is-old
311 (nnmail-expired-article-p 315 (nnmail-expired-article-p
312 newsgroup 316 newsgroup
313 (buffer-substring 317 (buffer-substring
314 (point) (progn (end-of-line) (point))) 318 (point) (progn (end-of-line) (point)))
315 force nnfolder-inhibit-expiry)) 319 force nnfolder-inhibit-expiry))
316 (progn 320 (progn
317 (nnheader-message 5 "Deleting article %d..." 321 (nnheader-message 5 "Deleting article %d..."
318 (car articles) newsgroup) 322 (car articles) newsgroup)
319 (nnfolder-delete-mail)) 323 (nnfolder-delete-mail))
320 (push (car articles) rest))) 324 (setq rest (cons (car articles) rest))))
321 (setq articles (cdr articles))) 325 (setq articles (cdr articles)))
322 (unless nnfolder-inhibit-expiry
323 (nnheader-message 5 "Deleting articles...done"))
324 (nnfolder-save-buffer) 326 (nnfolder-save-buffer)
325 (nnfolder-adjust-min-active newsgroup) 327 ;; Find the lowest active article in this group.
328 (let* ((active (cadr (assoc newsgroup nnfolder-group-alist)))
329 (marker (concat "\n" nnfolder-article-marker))
330 (number "[0-9]+")
331 (activemin (cdr active)))
332 (goto-char (point-min))
333 (while (and (search-forward marker nil t)
334 (re-search-forward number nil t))
335 (setq activemin (min activemin
336 (string-to-number (buffer-substring
337 (match-beginning 0)
338 (match-end 0))))))
339 (setcar active activemin))
326 (nnmail-save-active nnfolder-group-alist nnfolder-active-file) 340 (nnmail-save-active nnfolder-group-alist nnfolder-active-file)
327 (nconc rest articles)))) 341 (nconc rest articles))))
328 342
329 (deffoo nnfolder-request-move-article 343 (deffoo nnfolder-request-move-article
330 (article group server accept-form &optional last) 344 (article group server accept-form &optional last)
345 (nnfolder-possibly-change-group group server)
331 (let ((buf (get-buffer-create " *nnfolder move*")) 346 (let ((buf (get-buffer-create " *nnfolder move*"))
332 result) 347 result)
333 (and 348 (and
334 (nnfolder-request-article article group server) 349 (nnfolder-request-article article group server)
335 (save-excursion 350 (save-excursion
336 (set-buffer buf) 351 (set-buffer buf)
337 (buffer-disable-undo (current-buffer)) 352 (buffer-disable-undo (current-buffer))
338 (erase-buffer) 353 (erase-buffer)
339 (insert-buffer-substring nntp-server-buffer) 354 (insert-buffer-substring nntp-server-buffer)
340 (goto-char (point-min)) 355 (goto-char (point-min))
341 (while (re-search-forward 356 (while (re-search-forward
342 (concat "^" nnfolder-article-marker) 357 (concat "^" nnfolder-article-marker)
343 (save-excursion (search-forward "\n\n" nil t) (point)) t) 358 (save-excursion (search-forward "\n\n" nil t) (point)) t)
344 (delete-region (progn (beginning-of-line) (point)) 359 (delete-region (progn (beginning-of-line) (point))
345 (progn (forward-line 1) (point)))) 360 (progn (forward-line 1) (point))))
346 (setq result (eval accept-form)) 361 (setq result (eval accept-form))
348 result) 363 result)
349 (save-excursion 364 (save-excursion
350 (nnfolder-possibly-change-group group server) 365 (nnfolder-possibly-change-group group server)
351 (set-buffer nnfolder-current-buffer) 366 (set-buffer nnfolder-current-buffer)
352 (goto-char (point-min)) 367 (goto-char (point-min))
353 (when (search-forward (nnfolder-article-string article) nil t) 368 (if (search-forward (nnfolder-article-string article) nil t)
354 (nnfolder-delete-mail)) 369 (nnfolder-delete-mail))
355 (when last 370 (and last (nnfolder-save-buffer))))
356 (nnfolder-save-buffer)
357 (nnfolder-adjust-min-active group)
358 (nnmail-save-active nnfolder-group-alist nnfolder-active-file))))
359 result)) 371 result))
360 372
361 (deffoo nnfolder-request-accept-article (group &optional server last) 373 (deffoo nnfolder-request-accept-article (group &optional server last)
362 (nnfolder-possibly-change-group group server) 374 (nnfolder-possibly-change-group group server)
363 (nnmail-check-syntax) 375 (nnmail-check-syntax)
376 (and (stringp group) (nnfolder-possibly-change-group group))
364 (let ((buf (current-buffer)) 377 (let ((buf (current-buffer))
365 result art-group) 378 result)
366 (goto-char (point-min)) 379 (goto-char (point-min))
367 (when (looking-at "X-From-Line: ") 380 (when (looking-at "X-From-Line: ")
368 (replace-match "From ")) 381 (replace-match "From "))
369 (and 382 (and
370 (nnfolder-request-list) 383 (nnfolder-request-list)
371 (save-excursion 384 (save-excursion
372 (set-buffer buf) 385 (set-buffer buf)
373 (goto-char (point-min)) 386 (goto-char (point-min))
374 (search-forward "\n\n" nil t) 387 (search-forward "\n\n" nil t)
375 (forward-line -1) 388 (forward-line -1)
376 (while (re-search-backward (concat "^" nnfolder-article-marker) nil t) 389 (while (re-search-backward (concat "^" nnfolder-article-marker) nil t)
377 (delete-region (point) (progn (forward-line 1) (point)))) 390 (delete-region (point) (progn (forward-line 1) (point))))
378 (when nnmail-cache-accepted-message-ids 391 (setq result (car (nnfolder-save-mail (and (stringp group) group)))))
379 (nnmail-cache-insert (nnmail-fetch-field "message-id"))) 392 (save-excursion
380 (setq result (if (stringp group) 393 (set-buffer nnfolder-current-buffer)
381 (list (cons group (nnfolder-active-number group))) 394 (and last (nnfolder-save-buffer))))
382 (setq art-group
383 (nnmail-article-group 'nnfolder-active-number))))
384 (if (null result)
385 (setq result 'junk)
386 (setq result
387 (car (nnfolder-save-mail result)))))
388 (when last
389 (save-excursion
390 (nnfolder-possibly-change-folder (or (caar art-group) group))
391 (nnfolder-save-buffer)
392 (when nnmail-cache-accepted-message-ids
393 (nnmail-cache-close)))))
394 (nnmail-save-active nnfolder-group-alist nnfolder-active-file) 395 (nnmail-save-active nnfolder-group-alist nnfolder-active-file)
395 (unless result 396 (unless result
396 (nnheader-report 'nnfolder "Couldn't store article")) 397 (nnheader-report 'nnfolder "Couldn't store article"))
397 result)) 398 result))
398 399
412 (nnfolder-close-group group server t) 413 (nnfolder-close-group group server t)
413 ;; Delete all articles in GROUP. 414 ;; Delete all articles in GROUP.
414 (if (not force) 415 (if (not force)
415 () ; Don't delete the articles. 416 () ; Don't delete the articles.
416 ;; Delete the file that holds the group. 417 ;; Delete the file that holds the group.
417 (ignore-errors 418 (condition-case nil
418 (delete-file (nnfolder-group-pathname group)))) 419 (delete-file (nnfolder-group-pathname group))
420 (error nil)))
419 ;; Remove the group from all structures. 421 ;; Remove the group from all structures.
420 (setq nnfolder-group-alist 422 (setq nnfolder-group-alist
421 (delq (assoc group nnfolder-group-alist) nnfolder-group-alist) 423 (delq (assoc group nnfolder-group-alist) nnfolder-group-alist)
422 nnfolder-current-group nil 424 nnfolder-current-group nil
423 nnfolder-current-buffer nil) 425 nnfolder-current-buffer nil)
424 ;; Save the active file. 426 ;; Save the active file.
425 (nnmail-save-active nnfolder-group-alist nnfolder-active-file) 427 (nnmail-save-active nnfolder-group-alist nnfolder-active-file)
428 (deffoo nnfolder-request-rename-group (group new-name &optional server) 430 (deffoo nnfolder-request-rename-group (group new-name &optional server)
429 (nnfolder-possibly-change-group group server) 431 (nnfolder-possibly-change-group group server)
430 (save-excursion 432 (save-excursion
431 (set-buffer nnfolder-current-buffer) 433 (set-buffer nnfolder-current-buffer)
432 (and (file-writable-p buffer-file-name) 434 (and (file-writable-p buffer-file-name)
433 (ignore-errors 435 (condition-case ()
434 (rename-file 436 (progn
435 buffer-file-name 437 (rename-file
436 (nnfolder-group-pathname new-name)) 438 buffer-file-name
437 t) 439 (nnfolder-group-pathname new-name))
440 t)
441 (error nil))
438 ;; That went ok, so we change the internal structures. 442 ;; That went ok, so we change the internal structures.
439 (let ((entry (assoc group nnfolder-group-alist))) 443 (let ((entry (assoc group nnfolder-group-alist)))
440 (and entry (setcar entry new-name)) 444 (and entry (setcar entry new-name))
441 (setq nnfolder-current-buffer nil 445 (setq nnfolder-current-buffer nil
442 nnfolder-current-group nil) 446 nnfolder-current-group nil)
447 t)))) 451 t))))
448 452
449 453
450 ;;; Internal functions. 454 ;;; Internal functions.
451 455
452 (defun nnfolder-adjust-min-active (group)
453 ;; Find the lowest active article in this group.
454 (let* ((active (cadr (assoc group nnfolder-group-alist)))
455 (marker (concat "\n" nnfolder-article-marker))
456 (number "[0-9]+")
457 (activemin (cdr active)))
458 (save-excursion
459 (set-buffer nnfolder-current-buffer)
460 (goto-char (point-min))
461 (while (and (search-forward marker nil t)
462 (re-search-forward number nil t))
463 (setq activemin (min activemin
464 (string-to-number (buffer-substring
465 (match-beginning 0)
466 (match-end 0))))))
467 (setcar active activemin))))
468
469 (defun nnfolder-article-string (article) 456 (defun nnfolder-article-string (article)
470 (if (numberp article) 457 (if (numberp article)
471 (concat "\n" nnfolder-article-marker (int-to-string article) " ") 458 (concat "\n" nnfolder-article-marker (int-to-string article) " ")
472 (concat "\nMessage-ID: " article))) 459 (concat "\nMessage-ID: " article)))
473 460
474 (defun nnfolder-delete-mail (&optional force leave-delim) 461 (defun nnfolder-delete-mail (&optional force leave-delim)
475 "Delete the message that point is in." 462 "Delete the message that point is in."
476 (save-excursion 463 (save-excursion
477 (delete-region 464 (delete-region
478 (save-excursion 465 (save-excursion
479 (nnmail-search-unix-mail-delim-backward) 466 (re-search-backward (concat "^" message-unix-mail-delimiter) nil t)
480 (if leave-delim (progn (forward-line 1) (point)) 467 (if leave-delim (progn (forward-line 1) (point))
481 (point))) 468 (match-beginning 0)))
482 (progn 469 (progn
483 (forward-line 1) 470 (forward-line 1)
484 (if (nnmail-search-unix-mail-delim) 471 (if (re-search-forward (concat "^" message-unix-mail-delimiter) nil t)
485 (if (and (not (bobp)) leave-delim) 472 (if (and (not (bobp)) leave-delim)
486 (progn (forward-line -2) (point)) 473 (progn (forward-line -2) (point))
487 (point)) 474 (match-beginning 0))
488 (point-max)))))) 475 (point-max))))))
489 476
490 (defun nnfolder-possibly-change-group (group &optional server dont-check) 477 ;; When scanning, we're not looking t immediately switch into the group - if
491 ;; Change servers. 478 ;; we know our information is up to date, don't even bother reading the file.
479 (defun nnfolder-possibly-change-group (group &optional server scanning)
492 (when (and server 480 (when (and server
493 (not (nnfolder-server-opened server))) 481 (not (nnfolder-server-opened server)))
494 (nnfolder-open-server server)) 482 (nnfolder-open-server server))
495 (unless (gnus-buffer-live-p nnfolder-current-buffer) 483 (when (and group (or nnfolder-current-buffer
496 (setq nnfolder-current-buffer nil 484 (not (equal group nnfolder-current-group))))
497 nnfolder-current-group nil)) 485 (unless (file-exists-p nnfolder-directory)
498 ;; Change group. 486 (make-directory (directory-file-name nnfolder-directory) t))
499 (when (and group 487 (nnfolder-possibly-activate-groups nil)
500 (not (equal group nnfolder-current-group))) 488 (or (assoc group nnfolder-group-alist)
501 (nnmail-activate 'nnfolder) 489 (not (file-exists-p
502 (when (and (not (assoc group nnfolder-group-alist)) 490 (nnfolder-group-pathname group)))
503 (not (file-exists-p 491 (progn
504 (nnfolder-group-pathname group)))) 492 (setq nnfolder-group-alist
505 ;; The group doesn't exist, so we create a new entry for it. 493 (cons (list group (cons 1 0)) nnfolder-group-alist))
506 (push (list group (cons 1 0)) nnfolder-group-alist) 494 (nnmail-save-active nnfolder-group-alist nnfolder-active-file)))
507 (nnmail-save-active nnfolder-group-alist nnfolder-active-file)) 495 (let (inf file)
508 496 (if (and (equal group nnfolder-current-group)
509 (if dont-check 497 nnfolder-current-buffer
498 (buffer-name nnfolder-current-buffer))
499 ()
510 (setq nnfolder-current-group group) 500 (setq nnfolder-current-group group)
511 (let (inf file) 501
512 ;; If we have to change groups, see if we don't already have the 502 ;; If we have to change groups, see if we don't already have the mbox
513 ;; folder in memory. If we do, verify the modtime and destroy 503 ;; in memory. If we do, verify the modtime and destroy the mbox if
514 ;; the folder if needed so we can rescan it. 504 ;; needed so we can rescan it.
515 (when (setq inf (assoc group nnfolder-buffer-alist)) 505 (if (setq inf (assoc group nnfolder-buffer-alist))
516 (setq nnfolder-current-buffer (nth 1 inf))) 506 (setq nnfolder-current-buffer (nth 1 inf)))
517 507
518 ;; If the buffer is not live, make sure it isn't in the alist. If it 508 ;; If the buffer is not live, make sure it isn't in the alist. If it
519 ;; is live, verify that nobody else has touched the file since last 509 ;; is live, verify that nobody else has touched the file since last
520 ;; time. 510 ;; time.
521 (when (and nnfolder-current-buffer 511 (if (or (not (and nnfolder-current-buffer
522 (not (gnus-buffer-live-p nnfolder-current-buffer))) 512 (buffer-name nnfolder-current-buffer)))
523 (setq nnfolder-buffer-alist (delq inf nnfolder-buffer-alist) 513 (not (and (bufferp nnfolder-current-buffer)
524 nnfolder-current-buffer nil)) 514 (verify-visited-file-modtime
525 515 nnfolder-current-buffer))))
526 (setq nnfolder-current-group group) 516 (progn
527 517 (if (and nnfolder-current-buffer
528 (when (or (not nnfolder-current-buffer) 518 (buffer-name nnfolder-current-buffer)
529 (not (verify-visited-file-modtime nnfolder-current-buffer))) 519 (bufferp nnfolder-current-buffer))
520 (kill-buffer nnfolder-current-buffer))
521 (setq nnfolder-buffer-alist (delq inf nnfolder-buffer-alist))
522 (setq inf nil)))
523
524 (if inf
525 ()
530 (save-excursion 526 (save-excursion
531 (setq file (nnfolder-group-pathname group)) 527 (setq file (nnfolder-group-pathname group))
532 ;; See whether we need to create the new file. 528 (if (file-directory-p (file-truename file))
533 (unless (file-exists-p file) 529 ()
534 (gnus-make-directory (file-name-directory file)) 530 (unless (file-exists-p file)
535 (nnmail-write-region 1 1 file t 'nomesg)) 531 (unless (file-exists-p (file-name-directory file))
536 (when (setq nnfolder-current-buffer (nnfolder-read-folder group)) 532 (make-directory (file-name-directory file) t))
537 (set-buffer nnfolder-current-buffer) 533 (write-region 1 1 file t 'nomesg))
538 (push (list group nnfolder-current-buffer) 534 (setq nnfolder-current-buffer
539 nnfolder-buffer-alist)))))))) 535 (nnfolder-read-folder file scanning))
540 536 (if nnfolder-current-buffer
541 (defun nnfolder-save-mail (group-art-list) 537 (progn
538 (set-buffer nnfolder-current-buffer)
539 (setq nnfolder-buffer-alist
540 (cons (list group nnfolder-current-buffer)
541 nnfolder-buffer-alist)))))))))
542 (setq nnfolder-current-group group)))
543
544 (defun nnfolder-save-mail (&optional group)
542 "Called narrowed to an article." 545 "Called narrowed to an article."
543 (let* (save-list group-art) 546 (let* ((nnmail-split-methods
547 (if group (list (list group "")) nnmail-split-methods))
548 (group-art-list
549 (nreverse (nnmail-article-group 'nnfolder-active-number)))
550 (delim (concat "^" message-unix-mail-delimiter))
551 save-list group-art)
544 (goto-char (point-min)) 552 (goto-char (point-min))
545 ;; The From line may have been quoted by movemail. 553 ;; The From line may have been quoted by movemail.
546 (when (looking-at (concat ">" message-unix-mail-delimiter)) 554 (when (looking-at (concat ">" message-unix-mail-delimiter))
547 (delete-char 1)) 555 (delete-char 1))
548 ;; This might come from somewhere else. 556 ;; This might come from somewhere else.
549 (unless (looking-at message-unix-mail-delimiter) 557 (unless (looking-at delim)
550 (insert "From nobody " (current-time-string) "\n") 558 (insert "From nobody " (current-time-string) "\n")
551 (goto-char (point-min))) 559 (goto-char (point-min)))
552 ;; Quote all "From " lines in the article. 560 ;; Quote all "From " lines in the article.
553 (forward-line 1) 561 (forward-line 1)
554 (let (case-fold-search) 562 (while (re-search-forward delim nil t)
555 (while (re-search-forward "^From " nil t) 563 (beginning-of-line)
556 (beginning-of-line) 564 (insert "> "))
557 (insert "> ")))
558 (setq save-list group-art-list) 565 (setq save-list group-art-list)
559 (nnmail-insert-lines) 566 (nnmail-insert-lines)
560 (nnmail-insert-xref group-art-list) 567 (nnmail-insert-xref group-art-list)
561 (run-hooks 'nnmail-prepare-save-mail-hook) 568 (run-hooks 'nnmail-prepare-save-mail-hook)
562 (run-hooks 'nnfolder-prepare-save-mail-hook) 569 (run-hooks 'nnfolder-prepare-save-mail-hook)
563 570
564 ;; Insert the mail into each of the destination groups. 571 ;; Insert the mail into each of the destination groups.
565 (while (setq group-art (pop group-art-list)) 572 (while group-art-list
566 ;; Kill any previous newsgroup markers. 573 (setq group-art (car group-art-list)
574 group-art-list (cdr group-art-list))
575
576 ;; Kill the previous newsgroup markers.
567 (goto-char (point-min)) 577 (goto-char (point-min))
568 (search-forward "\n\n" nil t) 578 (search-forward "\n\n" nil t)
569 (forward-line -1) 579 (forward-line -1)
570 (while (search-backward (concat "\n" nnfolder-article-marker) nil t) 580 (while (search-backward (concat "\n" nnfolder-article-marker) nil t)
571 (delete-region (1+ (point)) (progn (forward-line 2) (point)))) 581 (delete-region (1+ (point)) (progn (forward-line 2) (point))))
572 582
583 (nnfolder-possibly-change-group (car group-art))
573 ;; Insert the new newsgroup marker. 584 ;; Insert the new newsgroup marker.
574 (nnfolder-insert-newsgroup-line group-art) 585 (nnfolder-insert-newsgroup-line group-art)
575 586 (unless nnfolder-current-buffer
576 (save-excursion 587 (nnfolder-close-group (car group-art))
577 (let ((beg (point-min)) 588 (nnfolder-request-create-group (car group-art))
578 (end (point-max)) 589 (nnfolder-possibly-change-group (car group-art)))
579 (obuf (current-buffer))) 590 (let ((beg (point-min))
580 (nnfolder-possibly-change-folder (car group-art)) 591 (end (point-max))
581 (goto-char (point-max)) 592 (obuf (current-buffer)))
582 (unless (eolp) 593 (set-buffer nnfolder-current-buffer)
583 (insert "\n")) 594 (goto-char (point-max))
584 (unless (bobp) 595 (unless (eolp)
585 (insert "\n")) 596 (insert "\n"))
586 (insert-buffer-substring obuf beg end)))) 597 (insert "\n")
598 (insert-buffer-substring obuf beg end)
599 (set-buffer obuf)))
587 600
588 ;; Did we save it anywhere? 601 ;; Did we save it anywhere?
589 save-list)) 602 save-list))
590 603
591 (defun nnfolder-insert-newsgroup-line (group-art) 604 (defun nnfolder-insert-newsgroup-line (group-art)
592 (save-excursion 605 (save-excursion
593 (goto-char (point-min)) 606 (goto-char (point-min))
594 (when (search-forward "\n\n" nil t) 607 (if (search-forward "\n\n" nil t)
595 (forward-char -1) 608 (progn
596 (insert (format (concat nnfolder-article-marker "%d %s\n") 609 (forward-char -1)
597 (cdr group-art) (current-time-string)))))) 610 (insert (format (concat nnfolder-article-marker "%d %s\n")
611 (cdr group-art) (current-time-string)))))))
612
613 (defun nnfolder-possibly-activate-groups (&optional group)
614 (save-excursion
615 ;; If we're looking for the activation of a specific group, find out
616 ;; its real name and switch to it.
617 (if group (nnfolder-possibly-change-group group))
618 ;; If the group alist isn't active, activate it now.
619 (nnmail-activate 'nnfolder)))
598 620
599 (defun nnfolder-active-number (group) 621 (defun nnfolder-active-number (group)
600 ;; Find the next article number in GROUP. 622 (when group
601 (let ((active (cadr (assoc group nnfolder-group-alist)))) 623 (save-excursion
602 (if active 624 ;; Find the next article number in GROUP.
603 (setcdr active (1+ (cdr active))) 625 (prog1
604 ;; This group is new, so we create a new entry for it. 626 (let ((active (cadr (assoc group nnfolder-group-alist))))
605 ;; This might be a bit naughty... creating groups on the drop of 627 (if active
606 ;; a hat, but I don't know... 628 (setcdr active (1+ (cdr active)))
607 (push (list group (setq active (cons 1 1))) 629 ;; This group is new, so we create a new entry for it.
608 nnfolder-group-alist)) 630 ;; This might be a bit naughty... creating groups on the drop of
609 (cdr active))) 631 ;; a hat, but I don't know...
610 632 (setq nnfolder-group-alist
611 (defun nnfolder-possibly-change-folder (group) 633 (cons (list group (setq active (cons 1 1)))
612 (let ((inf (assoc group nnfolder-buffer-alist))) 634 nnfolder-group-alist)))
613 (if (and inf 635 (cdr active))
614 (gnus-buffer-live-p (cadr inf))) 636 (nnmail-save-active nnfolder-group-alist nnfolder-active-file)
615 (set-buffer (cadr inf)) 637 (nnfolder-possibly-activate-groups group)))))
616 (when inf 638
617 (setq nnfolder-buffer-alist (delq inf nnfolder-buffer-alist)))
618 (when nnfolder-group-alist
619 (nnmail-save-active nnfolder-group-alist nnfolder-active-file))
620 (push (list group (nnfolder-read-folder group))
621 nnfolder-buffer-alist))))
622 639
623 ;; This method has a problem if you've accidentally let the active list get 640 ;; This method has a problem if you've accidentally let the active list get
624 ;; out of sync with the files. This could happen, say, if you've 641 ;; out of sync with the files. This could happen, say, if you've
625 ;; accidentally gotten new mail with something other than Gnus (but why 642 ;; accidentally gotten new mail with something other than Gnus (but why
626 ;; would _that_ ever happen? :-). In that case, we will be in the middle of 643 ;; would _that_ ever happen? :-). In that case, we will be in the middle of
633 ;; rest of the message looking for any more, possibly higher IDs. We'll 650 ;; rest of the message looking for any more, possibly higher IDs. We'll
634 ;; assume the maximum that we find is the highest active. Note that this 651 ;; assume the maximum that we find is the highest active. Note that this
635 ;; shouldn't cost us much extra time at all, but will be a lot less 652 ;; shouldn't cost us much extra time at all, but will be a lot less
636 ;; vulnerable to glitches between the mbox and the active file. 653 ;; vulnerable to glitches between the mbox and the active file.
637 654
638 (defun nnfolder-read-folder (group) 655 (defun nnfolder-read-folder (file &optional scanning)
639 (let* ((file (nnfolder-group-pathname group)) 656 ;; This is an attempt at a serious shortcut - don't even read in the file
640 (buffer (set-buffer (nnheader-find-file-noselect file)))) 657 ;; if we know we've seen it since the last time it was touched.
641 (if (equal (cadr (assoc group nnfolder-scantime-alist)) 658 (let ((scantime (cadr (assoc nnfolder-current-group
642 (nth 5 (file-attributes file))) 659 nnfolder-scantime-alist)))
643 ;; This looks up-to-date, so we don't do any scanning. 660 (modtime (nth 5 (or (file-attributes file) '(nil nil nil nil nil)))))
644 buffer 661 (if (and scanning scantime
645 ;; Parse the damn thing. 662 (eq (car scantime) (car modtime))
663 (eq (cdr scantime) (cadr modtime)))
664 nil
646 (save-excursion 665 (save-excursion
647 (nnmail-activate 'nnfolder) 666 (nnfolder-possibly-activate-groups nil)
648 ;; Read in the file. 667 ;; Read in the file.
668 (set-buffer (setq nnfolder-current-buffer
669 (nnheader-find-file-noselect file nil 'raw)))
670 (buffer-disable-undo (current-buffer))
671 ;; If the file hasn't been touched since the last time we scanned it,
672 ;; don't bother doing anything with it.
649 (let ((delim (concat "^" message-unix-mail-delimiter)) 673 (let ((delim (concat "^" message-unix-mail-delimiter))
650 (marker (concat "\n" nnfolder-article-marker)) 674 (marker (concat "\n" nnfolder-article-marker))
651 (number "[0-9]+") 675 (number "[0-9]+")
652 (active (or (cadr (assoc group nnfolder-group-alist)) 676 (active (or (cadr (assoc nnfolder-current-group
677 nnfolder-group-alist))
653 (cons 1 0))) 678 (cons 1 0)))
654 (scantime (assoc group nnfolder-scantime-alist)) 679 (scantime (assoc nnfolder-current-group nnfolder-scantime-alist))
655 (minid (lsh -1 -1)) 680 (minid (lsh -1 -1))
656 maxid start end newscantime 681 maxid start end newscantime)
657 buffer-read-only) 682
658 (buffer-disable-undo (current-buffer)) 683 (setq maxid (or (cdr active) 0))
659 (setq maxid (cdr active))
660 (goto-char (point-min)) 684 (goto-char (point-min))
661 685
662 ;; Anytime the active number is 1 or 0, it is suspect. In that 686 ;; Anytime the active number is 1 or 0, it is suspect. In that
663 ;; case, search the file manually to find the active number. Or, 687 ;; case, search the file manually to find the active number. Or,
664 ;; of course, if we're being paranoid. (This would also be the 688 ;; of course, if we're being paranoid. (This would also be the
665 ;; place to build other lists from the header markers, such as 689 ;; place to build other lists from the header markers, such as
666 ;; expunge lists, etc., if we ever desired to abandon the active 690 ;; expunge lists, etc., if we ever desired to abandon the active
667 ;; file entirely for mboxes.) 691 ;; file entirely for mboxes.)
668 (when (or nnfolder-ignore-active-file 692 (when (or nnfolder-ignore-active-file
669 (< maxid 2)) 693 (< maxid 2))
670 (while (and (search-forward marker nil t) 694 (while (and (search-forward marker nil t)
671 (re-search-forward number nil t)) 695 (re-search-forward number nil t))
672 (let ((newnum (string-to-number (match-string 0)))) 696 (let ((newnum (string-to-number (match-string 0))))
673 (setq maxid (max maxid newnum)) 697 (setq maxid (max maxid newnum))
674 (setq minid (min minid newnum)))) 698 (setq minid (min minid newnum))))
675 (setcar active (max 1 (min minid maxid))) 699 (setcar active (max 1 (min minid maxid)))
676 (setcdr active (max maxid (cdr active))) 700 (setcdr active (max maxid (cdr active)))
677 (goto-char (point-min))) 701 (goto-char (point-min)))
678 702
679 ;; As long as we trust that the user will only insert unmarked mail 703 ;; As long as we trust that the user will only insert unmarked mail
680 ;; at the end, go to the end and search backwards for the last 704 ;; at the end, go to the end and search backwards for the last
681 ;; marker. Find the start of that message, and begin to search for 705 ;; marker. Find the start of that message, and begin to search for
682 ;; unmarked messages from there. 706 ;; unmarked messages from there.
683 (when (not (or nnfolder-distrust-mbox 707 (if (not (or nnfolder-distrust-mbox
684 (< maxid 2))) 708 (< maxid 2)))
685 (goto-char (point-max)) 709 (progn
686 (unless (re-search-backward marker nil t) 710 (goto-char (point-max))
687 (goto-char (point-min))) 711 (if (not (re-search-backward marker nil t))
688 (when (nnmail-search-unix-mail-delim) 712 (goto-char (point-min))
689 (goto-char (point-min)))) 713 (if (not (re-search-backward delim nil t))
714 (goto-char (point-min))))))
690 715
691 ;; Keep track of the active number on our own, and insert it back 716 ;; Keep track of the active number on our own, and insert it back
692 ;; into the active list when we're done. Also, prime the pump to 717 ;; into the active list when we're done. Also, prime the pump to
693 ;; cut down on the number of searches we do. 718 ;; cut down on the number of searches we do.
694 (unless (nnmail-search-unix-mail-delim)
695 (goto-char (point-max)))
696 (setq end (point-marker)) 719 (setq end (point-marker))
720 (set-marker end (or (and (re-search-forward delim nil t)
721 (match-beginning 0))
722 (point-max)))
697 (while (not (= end (point-max))) 723 (while (not (= end (point-max)))
698 (setq start (marker-position end)) 724 (setq start (marker-position end))
699 (goto-char end) 725 (goto-char end)
700 ;; There may be more than one "From " line, so we skip past 726 ;; There may be more than one "From " line, so we skip past
701 ;; them. 727 ;; them.
702 (while (looking-at delim) 728 (while (looking-at delim)
703 (forward-line 1)) 729 (forward-line 1))
704 (set-marker end (if (nnmail-search-unix-mail-delim) 730 (set-marker end (or (and (re-search-forward delim nil t)
705 (point) 731 (match-beginning 0))
706 (point-max))) 732 (point-max)))
707 (goto-char start) 733 (goto-char start)
708 (when (not (search-forward marker end t)) 734 (if (not (search-forward marker end t))
709 (narrow-to-region start end) 735 (progn
710 (nnmail-insert-lines) 736 (narrow-to-region start end)
711 (nnfolder-insert-newsgroup-line 737 (nnmail-insert-lines)
712 (cons nil (nnfolder-active-number nnfolder-current-group))) 738 (nnfolder-insert-newsgroup-line
713 (widen))) 739 (cons nil (nnfolder-active-number nnfolder-current-group)))
714 740 (widen))))
715 (set-marker end nil) 741
716 ;; Make absolutely sure that the active list reflects reality! 742 ;; Make absolutely sure that the active list reflects reality!
717 (nnmail-save-active nnfolder-group-alist nnfolder-active-file) 743 (nnmail-save-active nnfolder-group-alist nnfolder-active-file)
718 ;; Set the scantime for this group. 744 ;; Set the scantime for this group.
719 (setq newscantime (visited-file-modtime)) 745 (setq newscantime (visited-file-modtime))
720 (if scantime 746 (if scantime
721 (setcdr scantime (list newscantime)) 747 (setcdr scantime (list newscantime))
722 (push (list nnfolder-current-group newscantime) 748 (push (list nnfolder-current-group newscantime)
723 nnfolder-scantime-alist)) 749 nnfolder-scantime-alist))
724 (current-buffer)))))) 750 (current-buffer))))))
725 751
726 ;;;###autoload 752 ;;;###autoload
727 (defun nnfolder-generate-active-file () 753 (defun nnfolder-generate-active-file ()
728 "Look for mbox folders in the nnfolder directory and make them into groups." 754 "Look for mbox folders in the nnfolder directory and make them into groups."
729 (interactive) 755 (interactive)
730 (nnmail-activate 'nnfolder) 756 (nnmail-activate 'nnfolder)
731 (let ((files (directory-files nnfolder-directory)) 757 (let ((files (directory-files nnfolder-directory))
732 file) 758 file)
733 (while (setq file (pop files)) 759 (while (setq file (pop files))
734 (when (and (not (backup-file-name-p file)) 760 (when (and (not (backup-file-name-p file))
735 (message-mail-file-mbox-p 761 (nnheader-mail-file-mbox-p file))
736 (nnheader-concat nnfolder-directory file))) 762 (nnheader-message 5 "Adding group %s..." file)
737 (let ((oldgroup (assoc file nnfolder-group-alist))) 763 (push (list file (cons 1 0)) nnfolder-group-alist)
738 (if oldgroup 764 (nnfolder-possibly-change-group file)
739 (nnheader-message 5 "Refreshing group %s..." file) 765 ;; (nnfolder-read-folder file)
740 (nnheader-message 5 "Adding group %s..." file)) 766 (nnfolder-close-group file))
741 (setq nnfolder-group-alist (remove oldgroup nnfolder-group-alist)) 767 (message ""))))
742 (push (list file (cons 1 0)) nnfolder-group-alist)
743 (nnfolder-possibly-change-folder file)
744 (nnfolder-possibly-change-group file)
745 (nnfolder-close-group file))))
746 (message "")))
747 768
748 (defun nnfolder-group-pathname (group) 769 (defun nnfolder-group-pathname (group)
749 "Make pathname for GROUP." 770 "Make pathname for GROUP."
750 (let ((dir (file-name-as-directory (expand-file-name nnfolder-directory)))) 771 (let ((dir (file-name-as-directory (expand-file-name nnfolder-directory))))
751 ;; If this file exists, we use it directly. 772 ;; If this file exists, we use it directly.
752 (if (or nnmail-use-long-file-names 773 (if (or nnmail-use-long-file-names
753 (file-exists-p (concat dir group))) 774 (file-exists-p (concat dir group)))
754 (concat dir group) 775 (concat dir group)
755 ;; If not, we translate dots into slashes. 776 ;; If not, we translate dots into slashes.
756 (concat dir (nnheader-replace-chars-in-string group ?. ?/))))) 777 (concat dir (nnheader-replace-chars-in-string group ?. ?/)))))
757 778