Mercurial > hg > xemacs-beta

comparison lisp/gnus/nnfolder.el @ 98:0d2f883870bc r20-1b1

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-1b1
author cvs
date Mon, 13 Aug 2007 09:13:56 +0200
parents 131b0175ea99
children cf808b4c4290
comparison
equal deleted inserted replaced
97:498bf5da1c90 98:0d2f883870bc
1 ;;; nnfolder.el --- mail folder access for Gnus 1 ;;; nnfolder.el --- mail folder access for Gnus
2 ;; Copyright (C) 1995,96 Free Software Foundation, Inc. 2 ;; Copyright (C) 1995,96,97 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
33 ;;; Code: 28 ;;; Code:
34 29
35 (require 'nnheader) 30 (require 'nnheader)
36 (require 'message) 31 (require 'message)
37 (require 'nnmail) 32 (require 'nnmail)
38 (require 'nnoo) 33 (require 'nnoo)
39 (eval-when-compile (require 'cl)) 34 (require 'cl)
35 (require 'gnus-util)
40 36
41 (nnoo-declare nnfolder) 37 (nnoo-declare nnfolder)
42 38
43 (defvoo nnfolder-directory (expand-file-name message-directory) 39 (defvoo nnfolder-directory (expand-file-name message-directory)
44 "The name of the nnfolder directory.") 40 "The name of the nnfolder directory.")
102 98
103 (deffoo nnfolder-retrieve-headers (articles &optional group server fetch-old) 99 (deffoo nnfolder-retrieve-headers (articles &optional group server fetch-old)
104 (save-excursion 100 (save-excursion
105 (set-buffer nntp-server-buffer) 101 (set-buffer nntp-server-buffer)
106 (erase-buffer) 102 (erase-buffer)
107 (let ((delim-string (concat "^" message-unix-mail-delimiter)) 103 (let (article art-string start stop)
108 article art-string start stop)
109 (nnfolder-possibly-change-group group server) 104 (nnfolder-possibly-change-group group server)
110 (when nnfolder-current-buffer 105 (when nnfolder-current-buffer
111 (set-buffer nnfolder-current-buffer) 106 (set-buffer nnfolder-current-buffer)
112 (goto-char (point-min)) 107 (goto-char (point-min))
113 (if (stringp (car articles)) 108 (if (stringp (car articles))
114 'headers 109 'headers
115 (while articles 110 (while articles
116 (setq article (car articles)) 111 (setq article (car articles))
117 (setq art-string (nnfolder-article-string article)) 112 (setq art-string (nnfolder-article-string article))
118 (set-buffer nnfolder-current-buffer) 113 (set-buffer nnfolder-current-buffer)
119 (if (or (search-forward art-string nil t) 114 (when (or (search-forward art-string nil t)
120 ;; Don't search the whole file twice! Also, articles 115 ;; Don't search the whole file twice! Also, articles
121 ;; probably have some locality by number, so searching 116 ;; probably have some locality by number, so searching
122 ;; backwards will be faster. Especially if we're at the 117 ;; backwards will be faster. Especially if we're at the
123 ;; beginning of the buffer :-). -SLB 118 ;; beginning of the buffer :-). -SLB
124 (search-backward art-string nil t)) 119 (search-backward art-string nil t))
125 (progn 120 (nnmail-search-unix-mail-delim-backward)
126 (setq start (or (re-search-backward delim-string nil t) 121 (setq start (point))
127 (point))) 122 (search-forward "\n\n" nil t)
128 (search-forward "\n\n" nil t) 123 (setq stop (1- (point)))
129 (setq stop (1- (point))) 124 (set-buffer nntp-server-buffer)
130 (set-buffer nntp-server-buffer) 125 (insert (format "221 %d Article retrieved.\n" article))
131 (insert (format "221 %d Article retrieved.\n" article)) 126 (insert-buffer-substring nnfolder-current-buffer start stop)
132 (insert-buffer-substring nnfolder-current-buffer start stop) 127 (goto-char (point-max))
133 (goto-char (point-max)) 128 (insert ".\n"))
134 (insert ".\n")))
135 (setq articles (cdr articles))) 129 (setq articles (cdr articles)))
136 130
137 (set-buffer nntp-server-buffer) 131 (set-buffer nntp-server-buffer)
138 (nnheader-fold-continuation-lines) 132 (nnheader-fold-continuation-lines)
139 'headers))))) 133 'headers)))))
140 134
141 (deffoo nnfolder-open-server (server &optional defs) 135 (deffoo nnfolder-open-server (server &optional defs)
142 (nnoo-change-server 'nnfolder server defs) 136 (nnoo-change-server 'nnfolder server defs)
143 (when (not (file-exists-p nnfolder-directory)) 137 (when (not (file-exists-p nnfolder-directory))
144 (condition-case () 138 (gnus-make-directory nnfolder-directory))
145 (make-directory nnfolder-directory t)
146 (error t)))
147 (cond 139 (cond
148 ((not (file-exists-p nnfolder-directory)) 140 ((not (file-exists-p nnfolder-directory))
149 (nnfolder-close-server) 141 (nnfolder-close-server)
150 (nnheader-report 'nnfolder "Couldn't create directory: %s" 142 (nnheader-report 'nnfolder "Couldn't create directory: %s"
151 nnfolder-directory)) 143 nnfolder-directory))
169 (deffoo nnfolder-request-article (article &optional group server buffer) 161 (deffoo nnfolder-request-article (article &optional group server buffer)
170 (nnfolder-possibly-change-group group server) 162 (nnfolder-possibly-change-group group server)
171 (save-excursion 163 (save-excursion
172 (set-buffer nnfolder-current-buffer) 164 (set-buffer nnfolder-current-buffer)
173 (goto-char (point-min)) 165 (goto-char (point-min))
174 (if (search-forward (nnfolder-article-string article) nil t) 166 (when (search-forward (nnfolder-article-string article) nil t)
175 (let (start stop) 167 (let (start stop)
176 (re-search-backward (concat "^" message-unix-mail-delimiter) nil t) 168 (nnmail-search-unix-mail-delim-backward)
177 (setq start (point)) 169 (setq start (point))
178 (forward-line 1) 170 (forward-line 1)
179 (or (and (re-search-forward 171 (unless (and (nnmail-search-unix-mail-delim)
180 (concat "^" message-unix-mail-delimiter) nil t) 172 (forward-line -1))
181 (forward-line -1)) 173 (goto-char (point-max)))
182 (goto-char (point-max))) 174 (setq stop (point))
183 (setq stop (point)) 175 (let ((nntp-server-buffer (or buffer nntp-server-buffer)))
184 (let ((nntp-server-buffer (or buffer nntp-server-buffer))) 176 (set-buffer nntp-server-buffer)
185 (set-buffer nntp-server-buffer) 177 (erase-buffer)
186 (erase-buffer) 178 (insert-buffer-substring nnfolder-current-buffer start stop)
187 (insert-buffer-substring nnfolder-current-buffer start stop) 179 (goto-char (point-min))
180 (while (looking-at "From ")
181 (delete-char 5)
182 (insert "X-From-Line: ")
183 (forward-line 1))
184 (if (numberp article)
185 (cons nnfolder-current-group article)
188 (goto-char (point-min)) 186 (goto-char (point-min))
189 (while (looking-at "From ") 187 (search-forward (concat "\n" nnfolder-article-marker))
190 (delete-char 5) 188 (cons nnfolder-current-group
191 (insert "X-From-Line: ") 189 (string-to-int
192 (forward-line 1)) 190 (buffer-substring
193 (if (numberp article) 191 (point) (progn (end-of-line) (point)))))))))))
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)))))))))))
201 192
202 (deffoo nnfolder-request-group (group &optional server dont-check) 193 (deffoo nnfolder-request-group (group &optional server dont-check)
203 (save-excursion 194 (save-excursion
204 (nnmail-activate 'nnfolder) 195 (nnmail-activate 'nnfolder)
205 (if (not (assoc group nnfolder-group-alist)) 196 (if (not (assoc group nnfolder-group-alist))
273 nnfolder-buffer-alist))))) 264 nnfolder-buffer-alist)))))
274 (setq nnfolder-current-group nil 265 (setq nnfolder-current-group nil
275 nnfolder-current-buffer nil) 266 nnfolder-current-buffer nil)
276 t) 267 t)
277 268
278 (deffoo nnfolder-request-create-group (group &optional server) 269 (deffoo nnfolder-request-create-group (group &optional server args)
279 (nnfolder-possibly-change-group nil server) 270 (nnfolder-possibly-change-group nil server)
280 (nnmail-activate 'nnfolder) 271 (nnmail-activate 'nnfolder)
281 (when group 272 (when group
282 (unless (assoc group nnfolder-group-alist) 273 (unless (assoc group nnfolder-group-alist)
283 (push (list group (cons 1 0)) nnfolder-group-alist) 274 (push (list group (cons 1 0)) nnfolder-group-alist)
286 277
287 (deffoo nnfolder-request-list (&optional server) 278 (deffoo nnfolder-request-list (&optional server)
288 (nnfolder-possibly-change-group nil server) 279 (nnfolder-possibly-change-group nil server)
289 (save-excursion 280 (save-excursion
290 (nnmail-find-file nnfolder-active-file) 281 (nnmail-find-file nnfolder-active-file)
291 (setq nnfolder-group-alist (nnmail-get-active)))) 282 (setq nnfolder-group-alist (nnmail-get-active))
283 t))
292 284
293 (deffoo nnfolder-request-newgroups (date &optional server) 285 (deffoo nnfolder-request-newgroups (date &optional server)
294 (nnfolder-possibly-change-group nil server) 286 (nnfolder-possibly-change-group nil server)
295 (nnfolder-request-list server)) 287 (nnfolder-request-list server))
296 288
308 300
309 (save-excursion 301 (save-excursion
310 (set-buffer nnfolder-current-buffer) 302 (set-buffer nnfolder-current-buffer)
311 (while (and articles is-old) 303 (while (and articles is-old)
312 (goto-char (point-min)) 304 (goto-char (point-min))
313 (if (search-forward (nnfolder-article-string (car articles)) nil t) 305 (when (search-forward (nnfolder-article-string (car articles)) nil t)
314 (if (setq is-old 306 (if (setq is-old
315 (nnmail-expired-article-p 307 (nnmail-expired-article-p
316 newsgroup 308 newsgroup
317 (buffer-substring 309 (buffer-substring
318 (point) (progn (end-of-line) (point))) 310 (point) (progn (end-of-line) (point)))
319 force nnfolder-inhibit-expiry)) 311 force nnfolder-inhibit-expiry))
320 (progn 312 (progn
321 (nnheader-message 5 "Deleting article %d..." 313 (nnheader-message 5 "Deleting article %d..."
322 (car articles) newsgroup) 314 (car articles) newsgroup)
323 (nnfolder-delete-mail)) 315 (nnfolder-delete-mail))
324 (setq rest (cons (car articles) rest)))) 316 (push (car articles) rest)))
325 (setq articles (cdr articles))) 317 (setq articles (cdr articles)))
318 (unless nnfolder-inhibit-expiry
319 (nnheader-message 5 "Deleting articles...done"))
326 (nnfolder-save-buffer) 320 (nnfolder-save-buffer)
327 ;; Find the lowest active article in this group. 321 ;; Find the lowest active article in this group.
328 (let* ((active (cadr (assoc newsgroup nnfolder-group-alist))) 322 (let* ((active (cadr (assoc newsgroup nnfolder-group-alist)))
329 (marker (concat "\n" nnfolder-article-marker)) 323 (marker (concat "\n" nnfolder-article-marker))
330 (number "[0-9]+") 324 (number "[0-9]+")
340 (nnmail-save-active nnfolder-group-alist nnfolder-active-file) 334 (nnmail-save-active nnfolder-group-alist nnfolder-active-file)
341 (nconc rest articles)))) 335 (nconc rest articles))))
342 336
343 (deffoo nnfolder-request-move-article 337 (deffoo nnfolder-request-move-article
344 (article group server accept-form &optional last) 338 (article group server accept-form &optional last)
345 (nnfolder-possibly-change-group group server)
346 (let ((buf (get-buffer-create " *nnfolder move*")) 339 (let ((buf (get-buffer-create " *nnfolder move*"))
347 result) 340 result)
348 (and 341 (and
349 (nnfolder-request-article article group server) 342 (nnfolder-request-article article group server)
350 (save-excursion 343 (save-excursion
363 result) 356 result)
364 (save-excursion 357 (save-excursion
365 (nnfolder-possibly-change-group group server) 358 (nnfolder-possibly-change-group group server)
366 (set-buffer nnfolder-current-buffer) 359 (set-buffer nnfolder-current-buffer)
367 (goto-char (point-min)) 360 (goto-char (point-min))
368 (if (search-forward (nnfolder-article-string article) nil t) 361 (when (search-forward (nnfolder-article-string article) nil t)
369 (nnfolder-delete-mail)) 362 (nnfolder-delete-mail))
370 (and last (nnfolder-save-buffer)))) 363 (and last (nnfolder-save-buffer))))
371 result)) 364 result))
372 365
373 (deffoo nnfolder-request-accept-article (group &optional server last) 366 (deffoo nnfolder-request-accept-article (group &optional server last)
374 (nnfolder-possibly-change-group group server) 367 (nnfolder-possibly-change-group group server)
375 (nnmail-check-syntax) 368 (nnmail-check-syntax)
376 (and (stringp group) (nnfolder-possibly-change-group group))
377 (let ((buf (current-buffer)) 369 (let ((buf (current-buffer))
378 result) 370 result)
379 (goto-char (point-min)) 371 (goto-char (point-min))
380 (when (looking-at "X-From-Line: ") 372 (when (looking-at "X-From-Line: ")
381 (replace-match "From ")) 373 (replace-match "From "))
386 (goto-char (point-min)) 378 (goto-char (point-min))
387 (search-forward "\n\n" nil t) 379 (search-forward "\n\n" nil t)
388 (forward-line -1) 380 (forward-line -1)
389 (while (re-search-backward (concat "^" nnfolder-article-marker) nil t) 381 (while (re-search-backward (concat "^" nnfolder-article-marker) nil t)
390 (delete-region (point) (progn (forward-line 1) (point)))) 382 (delete-region (point) (progn (forward-line 1) (point))))
391 (setq result (car (nnfolder-save-mail (and (stringp group) group))))) 383 (setq result
384 (car (nnfolder-save-mail
385 (if (stringp group)
386 (list (cons group (nnfolder-active-number group)))
387 (nnmail-article-group 'nnfolder-active-number))))))
392 (save-excursion 388 (save-excursion
393 (set-buffer nnfolder-current-buffer) 389 (set-buffer nnfolder-current-buffer)
394 (and last (nnfolder-save-buffer)))) 390 (and last (nnfolder-save-buffer))))
395 (nnmail-save-active nnfolder-group-alist nnfolder-active-file) 391 (nnmail-save-active nnfolder-group-alist nnfolder-active-file)
396 (unless result 392 (unless result
413 (nnfolder-close-group group server t) 409 (nnfolder-close-group group server t)
414 ;; Delete all articles in GROUP. 410 ;; Delete all articles in GROUP.
415 (if (not force) 411 (if (not force)
416 () ; Don't delete the articles. 412 () ; Don't delete the articles.
417 ;; Delete the file that holds the group. 413 ;; Delete the file that holds the group.
418 (condition-case nil 414 (ignore-errors
419 (delete-file (nnfolder-group-pathname group)) 415 (delete-file (nnfolder-group-pathname group))))
420 (error nil)))
421 ;; Remove the group from all structures. 416 ;; Remove the group from all structures.
422 (setq nnfolder-group-alist 417 (setq nnfolder-group-alist
423 (delq (assoc group nnfolder-group-alist) nnfolder-group-alist) 418 (delq (assoc group nnfolder-group-alist) nnfolder-group-alist)
424 nnfolder-current-group nil 419 nnfolder-current-group nil
425 nnfolder-current-buffer nil) 420 nnfolder-current-buffer nil)
430 (deffoo nnfolder-request-rename-group (group new-name &optional server) 425 (deffoo nnfolder-request-rename-group (group new-name &optional server)
431 (nnfolder-possibly-change-group group server) 426 (nnfolder-possibly-change-group group server)
432 (save-excursion 427 (save-excursion
433 (set-buffer nnfolder-current-buffer) 428 (set-buffer nnfolder-current-buffer)
434 (and (file-writable-p buffer-file-name) 429 (and (file-writable-p buffer-file-name)
435 (condition-case () 430 (ignore-errors
436 (progn 431 (rename-file
437 (rename-file 432 buffer-file-name
438 buffer-file-name 433 (nnfolder-group-pathname new-name))
439 (nnfolder-group-pathname new-name)) 434 t)
440 t)
441 (error nil))
442 ;; That went ok, so we change the internal structures. 435 ;; That went ok, so we change the internal structures.
443 (let ((entry (assoc group nnfolder-group-alist))) 436 (let ((entry (assoc group nnfolder-group-alist)))
444 (and entry (setcar entry new-name)) 437 (and entry (setcar entry new-name))
445 (setq nnfolder-current-buffer nil 438 (setq nnfolder-current-buffer nil
446 nnfolder-current-group nil) 439 nnfolder-current-group nil)
461 (defun nnfolder-delete-mail (&optional force leave-delim) 454 (defun nnfolder-delete-mail (&optional force leave-delim)
462 "Delete the message that point is in." 455 "Delete the message that point is in."
463 (save-excursion 456 (save-excursion
464 (delete-region 457 (delete-region
465 (save-excursion 458 (save-excursion
466 (re-search-backward (concat "^" message-unix-mail-delimiter) nil t) 459 (nnmail-search-unix-mail-delim-backward)
467 (if leave-delim (progn (forward-line 1) (point)) 460 (if leave-delim (progn (forward-line 1) (point))
468 (match-beginning 0))) 461 (point)))
469 (progn 462 (progn
470 (forward-line 1) 463 (forward-line 1)
471 (if (re-search-forward (concat "^" message-unix-mail-delimiter) nil t) 464 (if (nnmail-search-unix-mail-delim)
472 (if (and (not (bobp)) leave-delim) 465 (if (and (not (bobp)) leave-delim)
473 (progn (forward-line -2) (point)) 466 (progn (forward-line -2) (point))
474 (match-beginning 0)) 467 (point))
475 (point-max)))))) 468 (point-max))))))
476 469
477 ;; When scanning, we're not looking t immediately switch into the group - if 470 ;; When scanning, we're not looking t immediately switch into the group - if
478 ;; we know our information is up to date, don't even bother reading the file. 471 ;; 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) 472 (defun nnfolder-possibly-change-group (group &optional server scanning)
480 (when (and server 473 (when (and server
481 (not (nnfolder-server-opened server))) 474 (not (nnfolder-server-opened server)))
482 (nnfolder-open-server server)) 475 (nnfolder-open-server server))
483 (when (and group (or nnfolder-current-buffer 476 (when (and group (or nnfolder-current-buffer
484 (not (equal group nnfolder-current-group)))) 477 (not (equal group nnfolder-current-group))))
485 (unless (file-exists-p nnfolder-directory) 478 (gnus-make-directory (directory-file-name nnfolder-directory))
486 (make-directory (directory-file-name nnfolder-directory) t))
487 (nnfolder-possibly-activate-groups nil) 479 (nnfolder-possibly-activate-groups nil)
488 (or (assoc group nnfolder-group-alist) 480 (or (assoc group nnfolder-group-alist)
489 (not (file-exists-p 481 (not (file-exists-p
490 (nnfolder-group-pathname group))) 482 (nnfolder-group-pathname group)))
491 (progn 483 (progn
492 (setq nnfolder-group-alist 484 (push (list group (cons 1 0)) nnfolder-group-alist)
493 (cons (list group (cons 1 0)) nnfolder-group-alist))
494 (nnmail-save-active nnfolder-group-alist nnfolder-active-file))) 485 (nnmail-save-active nnfolder-group-alist nnfolder-active-file)))
495 (let (inf file) 486 (let (inf file)
496 (if (and (equal group nnfolder-current-group) 487 (if (and (equal group nnfolder-current-group)
497 nnfolder-current-buffer 488 nnfolder-current-buffer
498 (buffer-name nnfolder-current-buffer)) 489 (buffer-name nnfolder-current-buffer))
500 (setq nnfolder-current-group group) 491 (setq nnfolder-current-group group)
501 492
502 ;; If we have to change groups, see if we don't already have the mbox 493 ;; If we have to change groups, see if we don't already have the mbox
503 ;; in memory. If we do, verify the modtime and destroy the mbox if 494 ;; in memory. If we do, verify the modtime and destroy the mbox if
504 ;; needed so we can rescan it. 495 ;; needed so we can rescan it.
505 (if (setq inf (assoc group nnfolder-buffer-alist)) 496 (when (setq inf (assoc group nnfolder-buffer-alist))
506 (setq nnfolder-current-buffer (nth 1 inf))) 497 (setq nnfolder-current-buffer (nth 1 inf)))
507 498
508 ;; If the buffer is not live, make sure it isn't in the alist. If it 499 ;; If the buffer is not live, make sure it isn't in the alist. If it
509 ;; is live, verify that nobody else has touched the file since last 500 ;; is live, verify that nobody else has touched the file since last
510 ;; time. 501 ;; time.
511 (if (or (not (and nnfolder-current-buffer 502 (when (or (not (and nnfolder-current-buffer
512 (buffer-name nnfolder-current-buffer))) 503 (buffer-name nnfolder-current-buffer)))
513 (not (and (bufferp nnfolder-current-buffer) 504 (not (and (bufferp nnfolder-current-buffer)
514 (verify-visited-file-modtime 505 (verify-visited-file-modtime
515 nnfolder-current-buffer)))) 506 nnfolder-current-buffer))))
516 (progn 507 (when (and nnfolder-current-buffer
517 (if (and nnfolder-current-buffer 508 (buffer-name nnfolder-current-buffer)
518 (buffer-name nnfolder-current-buffer) 509 (bufferp nnfolder-current-buffer))
519 (bufferp nnfolder-current-buffer)) 510 (kill-buffer nnfolder-current-buffer))
520 (kill-buffer nnfolder-current-buffer)) 511 (setq nnfolder-buffer-alist (delq inf nnfolder-buffer-alist))
521 (setq nnfolder-buffer-alist (delq inf nnfolder-buffer-alist)) 512 (setq inf nil))
522 (setq inf nil)))
523 513
524 (if inf 514 (unless inf
525 ()
526 (save-excursion 515 (save-excursion
527 (setq file (nnfolder-group-pathname group)) 516 (setq file (nnfolder-group-pathname group))
528 (if (file-directory-p (file-truename file)) 517 (unless (file-directory-p (file-truename file))
529 ()
530 (unless (file-exists-p file) 518 (unless (file-exists-p file)
531 (unless (file-exists-p (file-name-directory file)) 519 (gnus-make-directory (file-name-directory file))
532 (make-directory (file-name-directory file) t)) 520 (nnmail-write-region 1 1 file t 'nomesg))
533 (write-region 1 1 file t 'nomesg)) 521 (setq nnfolder-current-group group)
534 (setq nnfolder-current-buffer 522 (setq nnfolder-current-buffer
535 (nnfolder-read-folder file scanning)) 523 (nnfolder-read-folder file scanning))
536 (if nnfolder-current-buffer 524 (when nnfolder-current-buffer
537 (progn 525 (set-buffer nnfolder-current-buffer)
538 (set-buffer nnfolder-current-buffer) 526 (push (list group nnfolder-current-buffer)
539 (setq nnfolder-buffer-alist 527 nnfolder-buffer-alist)))))))
540 (cons (list group nnfolder-current-buffer)
541 nnfolder-buffer-alist)))))))))
542 (setq nnfolder-current-group group))) 528 (setq nnfolder-current-group group)))
543 529
544 (defun nnfolder-save-mail (&optional group) 530 (defun nnfolder-save-mail (group-art-list)
545 "Called narrowed to an article." 531 "Called narrowed to an article."
546 (let* ((nnmail-split-methods 532 (let* (save-list group-art)
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)
552 (goto-char (point-min)) 533 (goto-char (point-min))
553 ;; The From line may have been quoted by movemail. 534 ;; The From line may have been quoted by movemail.
554 (when (looking-at (concat ">" message-unix-mail-delimiter)) 535 (when (looking-at (concat ">" message-unix-mail-delimiter))
555 (delete-char 1)) 536 (delete-char 1))
556 ;; This might come from somewhere else. 537 ;; This might come from somewhere else.
557 (unless (looking-at delim) 538 (unless (looking-at message-unix-mail-delimiter)
558 (insert "From nobody " (current-time-string) "\n") 539 (insert "From nobody " (current-time-string) "\n")
559 (goto-char (point-min))) 540 (goto-char (point-min)))
560 ;; Quote all "From " lines in the article. 541 ;; Quote all "From " lines in the article.
561 (forward-line 1) 542 (forward-line 1)
562 (while (re-search-forward delim nil t) 543 (while (re-search-forward "^From " nil t)
563 (beginning-of-line) 544 (beginning-of-line)
564 (insert "> ")) 545 (insert "> "))
565 (setq save-list group-art-list) 546 (setq save-list group-art-list)
566 (nnmail-insert-lines) 547 (nnmail-insert-lines)
567 (nnmail-insert-xref group-art-list) 548 (nnmail-insert-xref group-art-list)
592 (obuf (current-buffer))) 573 (obuf (current-buffer)))
593 (set-buffer nnfolder-current-buffer) 574 (set-buffer nnfolder-current-buffer)
594 (goto-char (point-max)) 575 (goto-char (point-max))
595 (unless (eolp) 576 (unless (eolp)
596 (insert "\n")) 577 (insert "\n"))
597 (insert "\n") 578 (unless (bobp)
579 (insert "\n"))
598 (insert-buffer-substring obuf beg end) 580 (insert-buffer-substring obuf beg end)
599 (set-buffer obuf))) 581 (set-buffer obuf)))
600 582
601 ;; Did we save it anywhere? 583 ;; Did we save it anywhere?
602 save-list)) 584 save-list))
603 585
604 (defun nnfolder-insert-newsgroup-line (group-art) 586 (defun nnfolder-insert-newsgroup-line (group-art)
605 (save-excursion 587 (save-excursion
606 (goto-char (point-min)) 588 (goto-char (point-min))
607 (if (search-forward "\n\n" nil t) 589 (when (search-forward "\n\n" nil t)
608 (progn 590 (forward-char -1)
609 (forward-char -1) 591 (insert (format (concat nnfolder-article-marker "%d %s\n")
610 (insert (format (concat nnfolder-article-marker "%d %s\n") 592 (cdr group-art) (current-time-string))))))
611 (cdr group-art) (current-time-string)))))))
612 593
613 (defun nnfolder-possibly-activate-groups (&optional group) 594 (defun nnfolder-possibly-activate-groups (&optional group)
614 (save-excursion 595 (save-excursion
615 ;; If we're looking for the activation of a specific group, find out 596 ;; If we're looking for the activation of a specific group, find out
616 ;; its real name and switch to it. 597 ;; its real name and switch to it.
617 (if group (nnfolder-possibly-change-group group)) 598 (when group
599 (nnfolder-possibly-change-group group))
618 ;; If the group alist isn't active, activate it now. 600 ;; If the group alist isn't active, activate it now.
619 (nnmail-activate 'nnfolder))) 601 (nnmail-activate 'nnfolder)))
620 602
621 (defun nnfolder-active-number (group) 603 (defun nnfolder-active-number (group)
622 (when group 604 (when group
627 (if active 609 (if active
628 (setcdr active (1+ (cdr active))) 610 (setcdr active (1+ (cdr active)))
629 ;; This group is new, so we create a new entry for it. 611 ;; This group is new, so we create a new entry for it.
630 ;; This might be a bit naughty... creating groups on the drop of 612 ;; This might be a bit naughty... creating groups on the drop of
631 ;; a hat, but I don't know... 613 ;; a hat, but I don't know...
632 (setq nnfolder-group-alist 614 (push (list group (setq active (cons 1 1)))
633 (cons (list group (setq active (cons 1 1))) 615 nnfolder-group-alist))
634 nnfolder-group-alist)))
635 (cdr active)) 616 (cdr active))
636 (nnmail-save-active nnfolder-group-alist nnfolder-active-file) 617 (nnmail-save-active nnfolder-group-alist nnfolder-active-file)
637 (nnfolder-possibly-activate-groups group))))) 618 (nnfolder-possibly-activate-groups group)))))
638 619
639 620
655 (defun nnfolder-read-folder (file &optional scanning) 636 (defun nnfolder-read-folder (file &optional scanning)
656 ;; This is an attempt at a serious shortcut - don't even read in the file 637 ;; This is an attempt at a serious shortcut - don't even read in the file
657 ;; if we know we've seen it since the last time it was touched. 638 ;; if we know we've seen it since the last time it was touched.
658 (let ((scantime (cadr (assoc nnfolder-current-group 639 (let ((scantime (cadr (assoc nnfolder-current-group
659 nnfolder-scantime-alist))) 640 nnfolder-scantime-alist)))
660 (modtime (nth 5 (or (file-attributes file) '(nil nil nil nil nil))))) 641 (modtime (nth 5 (file-attributes file))))
661 (if (and scanning scantime 642 (if (and scanning scantime
662 (eq (car scantime) (car modtime)) 643 (eq (car scantime) (car modtime))
663 (eq (cdr scantime) (cadr modtime))) 644 (eq (cdr scantime) (cadr modtime)))
664 nil 645 nil
665 (save-excursion 646 (save-excursion
666 (nnfolder-possibly-activate-groups nil) 647 (nnfolder-possibly-activate-groups nil)
667 ;; Read in the file. 648 ;; Read in the file.
668 (set-buffer (setq nnfolder-current-buffer 649 (set-buffer (setq nnfolder-current-buffer
669 (nnheader-find-file-noselect file nil 'raw))) 650 (nnheader-find-file-noselect file)))
670 (buffer-disable-undo (current-buffer)) 651 (buffer-disable-undo (current-buffer))
652 (setq buffer-read-only nil)
671 ;; If the file hasn't been touched since the last time we scanned it, 653 ;; If the file hasn't been touched since the last time we scanned it,
672 ;; don't bother doing anything with it. 654 ;; don't bother doing anything with it.
673 (let ((delim (concat "^" message-unix-mail-delimiter)) 655 (let ((delim (concat "^" message-unix-mail-delimiter))
674 (marker (concat "\n" nnfolder-article-marker)) 656 (marker (concat "\n" nnfolder-article-marker))
675 (number "[0-9]+") 657 (number "[0-9]+")
689 ;; place to build other lists from the header markers, such as 671 ;; place to build other lists from the header markers, such as
690 ;; expunge lists, etc., if we ever desired to abandon the active 672 ;; expunge lists, etc., if we ever desired to abandon the active
691 ;; file entirely for mboxes.) 673 ;; file entirely for mboxes.)
692 (when (or nnfolder-ignore-active-file 674 (when (or nnfolder-ignore-active-file
693 (< maxid 2)) 675 (< maxid 2))
694 (while (and (search-forward marker nil t) 676 (while (and (search-forward marker nil t)
695 (re-search-forward number nil t)) 677 (re-search-forward number nil t))
696 (let ((newnum (string-to-number (match-string 0)))) 678 (let ((newnum (string-to-number (match-string 0))))
697 (setq maxid (max maxid newnum)) 679 (setq maxid (max maxid newnum))
698 (setq minid (min minid newnum)))) 680 (setq minid (min minid newnum))))
699 (setcar active (max 1 (min minid maxid))) 681 (setcar active (max 1 (min minid maxid)))
700 (setcdr active (max maxid (cdr active))) 682 (setcdr active (max maxid (cdr active)))
701 (goto-char (point-min))) 683 (goto-char (point-min)))
702 684
703 ;; As long as we trust that the user will only insert unmarked mail 685 ;; As long as we trust that the user will only insert unmarked mail
704 ;; at the end, go to the end and search backwards for the last 686 ;; at the end, go to the end and search backwards for the last
705 ;; marker. Find the start of that message, and begin to search for 687 ;; marker. Find the start of that message, and begin to search for
706 ;; unmarked messages from there. 688 ;; unmarked messages from there.
707 (if (not (or nnfolder-distrust-mbox 689 (when (not (or nnfolder-distrust-mbox
708 (< maxid 2))) 690 (< maxid 2)))
709 (progn 691 (goto-char (point-max))
710 (goto-char (point-max)) 692 (if (not (re-search-backward marker nil t))
711 (if (not (re-search-backward marker nil t)) 693 (goto-char (point-min))
712 (goto-char (point-min)) 694 (when (not (nnmail-search-unix-mail-delim))
713 (if (not (re-search-backward delim nil t)) 695 (goto-char (point-min)))))
714 (goto-char (point-min))))))
715 696
716 ;; Keep track of the active number on our own, and insert it back 697 ;; Keep track of the active number on our own, and insert it back
717 ;; into the active list when we're done. Also, prime the pump to 698 ;; into the active list when we're done. Also, prime the pump to
718 ;; cut down on the number of searches we do. 699 ;; cut down on the number of searches we do.
719 (setq end (point-marker)) 700 (setq end (point-marker))
720 (set-marker end (or (and (re-search-forward delim nil t) 701 (set-marker end (or (and (nnmail-search-unix-mail-delim)
721 (match-beginning 0)) 702 (point))
722 (point-max))) 703 (point-max)))
723 (while (not (= end (point-max))) 704 (while (not (= end (point-max)))
724 (setq start (marker-position end)) 705 (setq start (marker-position end))
725 (goto-char end) 706 (goto-char end)
726 ;; There may be more than one "From " line, so we skip past 707 ;; There may be more than one "From " line, so we skip past
727 ;; them. 708 ;; them.
728 (while (looking-at delim) 709 (while (looking-at delim)
729 (forward-line 1)) 710 (forward-line 1))
730 (set-marker end (or (and (re-search-forward delim nil t) 711 (set-marker end (or (and (nnmail-search-unix-mail-delim)
731 (match-beginning 0)) 712 (point))
732 (point-max))) 713 (point-max)))
733 (goto-char start) 714 (goto-char start)
734 (if (not (search-forward marker end t)) 715 (when (not (search-forward marker end t))
735 (progn 716 (narrow-to-region start end)
736 (narrow-to-region start end) 717 (nnmail-insert-lines)
737 (nnmail-insert-lines) 718 (nnfolder-insert-newsgroup-line
738 (nnfolder-insert-newsgroup-line 719 (cons nil (nnfolder-active-number nnfolder-current-group)))
739 (cons nil (nnfolder-active-number nnfolder-current-group))) 720 (widen)))
740 (widen))))
741 721
742 ;; Make absolutely sure that the active list reflects reality! 722 ;; Make absolutely sure that the active list reflects reality!
743 (nnmail-save-active nnfolder-group-alist nnfolder-active-file) 723 (nnmail-save-active nnfolder-group-alist nnfolder-active-file)
744 ;; Set the scantime for this group. 724 ;; Set the scantime for this group.
745 (setq newscantime (visited-file-modtime)) 725 (setq newscantime (visited-file-modtime))
746 (if scantime 726 (if scantime
747 (setcdr scantime (list newscantime)) 727 (setcdr scantime (list newscantime))
748 (push (list nnfolder-current-group newscantime) 728 (push (list nnfolder-current-group newscantime)
749 nnfolder-scantime-alist)) 729 nnfolder-scantime-alist))
750 (current-buffer)))))) 730 (current-buffer))))))
751 731
752 ;;;###autoload 732 ;;;###autoload
753 (defun nnfolder-generate-active-file () 733 (defun nnfolder-generate-active-file ()
754 "Look for mbox folders in the nnfolder directory and make them into groups." 734 "Look for mbox folders in the nnfolder directory and make them into groups."
755 (interactive) 735 (interactive)
756 (nnmail-activate 'nnfolder) 736 (nnmail-activate 'nnfolder)
757 (let ((files (directory-files nnfolder-directory)) 737 (let ((files (directory-files nnfolder-directory))
758 file) 738 file)
759 (while (setq file (pop files)) 739 (while (setq file (pop files))
760 (when (and (not (backup-file-name-p file)) 740 (when (and (not (backup-file-name-p file))
761 (nnheader-mail-file-mbox-p file)) 741 (nnheader-mail-file-mbox-p
762 (nnheader-message 5 "Adding group %s..." file) 742 (concat nnfolder-directory file)))
763 (push (list file (cons 1 0)) nnfolder-group-alist) 743 (nnheader-message 5 "Adding group %s..." file)
764 (nnfolder-possibly-change-group file) 744 (push (list file (cons 1 0)) nnfolder-group-alist)
765 ;; (nnfolder-read-folder file) 745 (nnfolder-possibly-change-group file)
766 (nnfolder-close-group file)) 746 (nnfolder-close-group file))
767 (message "")))) 747 (message ""))))
768 748
769 (defun nnfolder-group-pathname (group) 749 (defun nnfolder-group-pathname (group)
770 "Make pathname for GROUP." 750 "Make pathname for GROUP."
771 (let ((dir (file-name-as-directory (expand-file-name nnfolder-directory)))) 751 (let ((dir (file-name-as-directory (expand-file-name nnfolder-directory))))