Mercurial > hg > xemacs-beta

comparison lisp/gnus/nnfolder.el @ 108:360340f9fd5f r20-1b6

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-1b6
author cvs
date Mon, 13 Aug 2007 09:18:39 +0200
parents cf808b4c4290
children fe104dbd9147
comparison
equal deleted inserted replaced
107:523141596bda 108:360340f9fd5f
37 (nnoo-declare nnfolder) 37 (nnoo-declare nnfolder)
38 38
39 (defvoo nnfolder-directory (expand-file-name message-directory) 39 (defvoo nnfolder-directory (expand-file-name message-directory)
40 "The name of the nnfolder directory.") 40 "The name of the nnfolder directory.")
41 41
42 (defvoo nnfolder-active-file 42 (defvoo nnfolder-active-file
43 (nnheader-concat nnfolder-directory "active") 43 (nnheader-concat nnfolder-directory "active")
44 "The name of the active file.") 44 "The name of the active file.")
45 45
46 ;; I renamed this variable to something more in keeping with the general GNU 46 ;; I renamed this variable to something more in keeping with the general GNU
47 ;; style. -SLB 47 ;; style. -SLB
48 48
49 (defvoo nnfolder-ignore-active-file nil 49 (defvoo nnfolder-ignore-active-file nil
50 "If non-nil, causes nnfolder to do some extra work in order to determine 50 "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 51 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 52 saved, but it's values are not used. This costs some extra time when
53 scanning an mbox when opening it.") 53 scanning an mbox when opening it.")
54 54
55 (defvoo nnfolder-distrust-mbox nil 55 (defvoo nnfolder-distrust-mbox nil
56 "If non-nil, causes nnfolder to not trust the user with respect to 56 "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 57 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. 58 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 59 When nil, scans occur forward from the last marked message, a huge
60 time saver for large mailboxes.") 60 time saver for large mailboxes.")
61 61
62 (defvoo nnfolder-newsgroups-file 62 (defvoo nnfolder-newsgroups-file
63 (concat (file-name-as-directory nnfolder-directory) "newsgroups") 63 (concat (file-name-as-directory nnfolder-directory) "newsgroups")
64 "Mail newsgroups description file.") 64 "Mail newsgroups description file.")
65 65
66 (defvoo nnfolder-get-new-mail t 66 (defvoo nnfolder-get-new-mail t
67 "If non-nil, nnfolder will check the incoming mail file and split the mail.") 67 "If non-nil, nnfolder will check the incoming mail file and split the mail.")
87 (defvoo nnfolder-current-buffer nil) 87 (defvoo nnfolder-current-buffer nil)
88 (defvoo nnfolder-status-string "") 88 (defvoo nnfolder-status-string "")
89 (defvoo nnfolder-group-alist nil) 89 (defvoo nnfolder-group-alist nil)
90 (defvoo nnfolder-buffer-alist nil) 90 (defvoo nnfolder-buffer-alist nil)
91 (defvoo nnfolder-scantime-alist nil) 91 (defvoo nnfolder-scantime-alist nil)
92 (defvoo nnfolder-active-timestamp nil)
92 93
93 94
94 95
95 ;;; Interface functions 96 ;;; Interface functions
96 97
132 (nnheader-fold-continuation-lines) 133 (nnheader-fold-continuation-lines)
133 'headers))))) 134 'headers)))))
134 135
135 (deffoo nnfolder-open-server (server &optional defs) 136 (deffoo nnfolder-open-server (server &optional defs)
136 (nnoo-change-server 'nnfolder server defs) 137 (nnoo-change-server 'nnfolder server defs)
137 (when (not (file-exists-p nnfolder-directory)) 138 (nnmail-activate 'nnfolder t)
138 (gnus-make-directory nnfolder-directory)) 139 (gnus-make-directory nnfolder-directory)
139 (cond 140 (cond
140 ((not (file-exists-p nnfolder-directory)) 141 ((not (file-exists-p nnfolder-directory))
141 (nnfolder-close-server) 142 (nnfolder-close-server)
142 (nnheader-report 'nnfolder "Couldn't create directory: %s" 143 (nnheader-report 'nnfolder "Couldn't create directory: %s"
143 nnfolder-directory)) 144 nnfolder-directory))
144 ((not (file-directory-p (file-truename nnfolder-directory))) 145 ((not (file-directory-p (file-truename nnfolder-directory)))
145 (nnfolder-close-server) 146 (nnfolder-close-server)
146 (nnheader-report 'nnfolder "Not a directory: %s" nnfolder-directory)) 147 (nnheader-report 'nnfolder "Not a directory: %s" nnfolder-directory))
147 (t 148 (t
149 (nnmail-activate 'nnfolder)
148 (nnheader-report 'nnfolder "Opened server %s using directory %s" 150 (nnheader-report 'nnfolder "Opened server %s using directory %s"
149 server nnfolder-directory) 151 server nnfolder-directory)
150 t))) 152 t)))
151 153
152 (deffoo nnfolder-request-close () 154 (deffoo nnfolder-request-close ()
184 (if (numberp article) 186 (if (numberp article)
185 (cons nnfolder-current-group article) 187 (cons nnfolder-current-group article)
186 (goto-char (point-min)) 188 (goto-char (point-min))
187 (search-forward (concat "\n" nnfolder-article-marker)) 189 (search-forward (concat "\n" nnfolder-article-marker))
188 (cons nnfolder-current-group 190 (cons nnfolder-current-group
189 (string-to-int 191 (string-to-int
190 (buffer-substring 192 (buffer-substring
191 (point) (progn (end-of-line) (point))))))))))) 193 (point) (progn (end-of-line) (point)))))))))))
192 194
193 (deffoo nnfolder-request-group (group &optional server dont-check) 195 (deffoo nnfolder-request-group (group &optional server dont-check)
196 (nnfolder-possibly-change-group group server)
194 (save-excursion 197 (save-excursion
195 (nnmail-activate 'nnfolder) 198 (nnmail-activate 'nnfolder)
196 (if (not (assoc group nnfolder-group-alist)) 199 (if (not (assoc group nnfolder-group-alist))
197 (nnheader-report 'nnfolder "No such group: %s" group) 200 (nnheader-report 'nnfolder "No such group: %s" group)
198 (nnfolder-possibly-change-group group server)
199 (if dont-check 201 (if dont-check
200 (progn 202 (progn
201 (nnheader-report 'nnfolder "Selected group %s" group) 203 (nnheader-report 'nnfolder "Selected group %s" group)
202 t) 204 t)
203 (let* ((active (assoc group nnfolder-group-alist)) 205 (let* ((active (assoc group nnfolder-group-alist))
204 (group (car active)) 206 (group (car active))
205 (range (cadr active))) 207 (range (cadr active)))
206 (cond 208 (cond
207 ((null active) 209 ((null active)
208 (nnheader-report 'nnfolder "No such group: %s" group)) 210 (nnheader-report 'nnfolder "No such group: %s" group))
209 ((null nnfolder-current-group) 211 ((null nnfolder-current-group)
210 (nnheader-report 'nnfolder "Empty group: %s" group)) 212 (nnheader-report 'nnfolder "Empty group: %s" group))
211 (t 213 (t
212 (nnheader-report 'nnfolder "Selected group %s" group) 214 (nnheader-report 'nnfolder "Selected group %s" group)
213 (nnheader-insert "211 %d %d %d %s\n" 215 (nnheader-insert "211 %d %d %d %s\n"
214 (1+ (- (cdr range) (car range))) 216 (1+ (- (cdr range) (car range)))
215 (car range) (cdr range) group)))))))) 217 (car range) (cdr range) group))))))))
216 218
217 (deffoo nnfolder-request-scan (&optional group server) 219 (deffoo nnfolder-request-scan (&optional group server)
218 (nnfolder-possibly-change-group group server t) 220 (nnfolder-possibly-change-group group server t)
219 (nnmail-get-new-mail 221 (nnmail-get-new-mail
220 'nnfolder 222 'nnfolder
221 (lambda () 223 (lambda ()
222 (let ((bufs nnfolder-buffer-alist)) 224 (let ((bufs nnfolder-buffer-alist))
223 (save-excursion 225 (save-excursion
224 (while bufs 226 (while bufs
225 (if (not (buffer-name (nth 1 (car bufs)))) 227 (if (not (buffer-name (nth 1 (car bufs))))
226 (setq nnfolder-buffer-alist 228 (setq nnfolder-buffer-alist
227 (delq (car bufs) nnfolder-buffer-alist)) 229 (delq (car bufs) nnfolder-buffer-alist))
228 (set-buffer (nth 1 (car bufs))) 230 (set-buffer (nth 1 (car bufs)))
229 (nnfolder-save-buffer) 231 (nnfolder-save-buffer)
230 (kill-buffer (current-buffer))) 232 (kill-buffer (current-buffer)))
231 (setq bufs (cdr bufs)))))) 233 (setq bufs (cdr bufs))))))
267 t) 269 t)
268 270
269 (deffoo nnfolder-request-create-group (group &optional server args) 271 (deffoo nnfolder-request-create-group (group &optional server args)
270 (nnfolder-possibly-change-group nil server) 272 (nnfolder-possibly-change-group nil server)
271 (nnmail-activate 'nnfolder) 273 (nnmail-activate 'nnfolder)
272 (when group 274 (when group
273 (unless (assoc group nnfolder-group-alist) 275 (unless (assoc group nnfolder-group-alist)
274 (push (list group (cons 1 0)) nnfolder-group-alist) 276 (push (list group (cons 1 0)) nnfolder-group-alist)
275 (nnmail-save-active nnfolder-group-alist nnfolder-active-file))) 277 (nnmail-save-active nnfolder-group-alist nnfolder-active-file)))
276 t) 278 t)
277 279
289 (deffoo nnfolder-request-list-newsgroups (&optional server) 291 (deffoo nnfolder-request-list-newsgroups (&optional server)
290 (nnfolder-possibly-change-group nil server) 292 (nnfolder-possibly-change-group nil server)
291 (save-excursion 293 (save-excursion
292 (nnmail-find-file nnfolder-newsgroups-file))) 294 (nnmail-find-file nnfolder-newsgroups-file)))
293 295
294 (deffoo nnfolder-request-expire-articles 296 (deffoo nnfolder-request-expire-articles
295 (articles newsgroup &optional server force) 297 (articles newsgroup &optional server force)
296 (nnfolder-possibly-change-group newsgroup server) 298 (nnfolder-possibly-change-group newsgroup server)
297 (let* ((is-old t) 299 (let* ((is-old t)
298 rest) 300 rest)
299 (nnmail-activate 'nnfolder) 301 (nnmail-activate 'nnfolder)
300 302
301 (save-excursion 303 (save-excursion
302 (set-buffer nnfolder-current-buffer) 304 (set-buffer nnfolder-current-buffer)
303 (while (and articles is-old) 305 (while (and articles is-old)
304 (goto-char (point-min)) 306 (goto-char (point-min))
305 (when (search-forward (nnfolder-article-string (car articles)) nil t) 307 (when (search-forward (nnfolder-article-string (car articles)) nil t)
306 (if (setq is-old 308 (if (setq is-old
307 (nnmail-expired-article-p 309 (nnmail-expired-article-p
308 newsgroup 310 newsgroup
309 (buffer-substring 311 (buffer-substring
310 (point) (progn (end-of-line) (point))) 312 (point) (progn (end-of-line) (point)))
311 force nnfolder-inhibit-expiry)) 313 force nnfolder-inhibit-expiry))
312 (progn 314 (progn
313 (nnheader-message 5 "Deleting article %d..." 315 (nnheader-message 5 "Deleting article %d..."
314 (car articles) newsgroup) 316 (car articles) newsgroup)
315 (nnfolder-delete-mail)) 317 (nnfolder-delete-mail))
316 (push (car articles) rest))) 318 (push (car articles) rest)))
317 (setq articles (cdr articles))) 319 (setq articles (cdr articles)))
318 (unless nnfolder-inhibit-expiry 320 (unless nnfolder-inhibit-expiry
336 338
337 (deffoo nnfolder-request-move-article 339 (deffoo nnfolder-request-move-article
338 (article group server accept-form &optional last) 340 (article group server accept-form &optional last)
339 (let ((buf (get-buffer-create " *nnfolder move*")) 341 (let ((buf (get-buffer-create " *nnfolder move*"))
340 result) 342 result)
341 (and 343 (and
342 (nnfolder-request-article article group server) 344 (nnfolder-request-article article group server)
343 (save-excursion 345 (save-excursion
344 (set-buffer buf) 346 (set-buffer buf)
345 (buffer-disable-undo (current-buffer)) 347 (buffer-disable-undo (current-buffer))
346 (erase-buffer) 348 (erase-buffer)
347 (insert-buffer-substring nntp-server-buffer) 349 (insert-buffer-substring nntp-server-buffer)
348 (goto-char (point-min)) 350 (goto-char (point-min))
349 (while (re-search-forward 351 (while (re-search-forward
350 (concat "^" nnfolder-article-marker) 352 (concat "^" nnfolder-article-marker)
351 (save-excursion (search-forward "\n\n" nil t) (point)) t) 353 (save-excursion (search-forward "\n\n" nil t) (point)) t)
352 (delete-region (progn (beginning-of-line) (point)) 354 (delete-region (progn (beginning-of-line) (point))
353 (progn (forward-line 1) (point)))) 355 (progn (forward-line 1) (point))))
354 (setq result (eval accept-form)) 356 (setq result (eval accept-form))
365 367
366 (deffoo nnfolder-request-accept-article (group &optional server last) 368 (deffoo nnfolder-request-accept-article (group &optional server last)
367 (nnfolder-possibly-change-group group server) 369 (nnfolder-possibly-change-group group server)
368 (nnmail-check-syntax) 370 (nnmail-check-syntax)
369 (let ((buf (current-buffer)) 371 (let ((buf (current-buffer))
370 result) 372 result art-group)
371 (goto-char (point-min)) 373 (goto-char (point-min))
372 (when (looking-at "X-From-Line: ") 374 (when (looking-at "X-From-Line: ")
373 (replace-match "From ")) 375 (replace-match "From "))
374 (and 376 (and
375 (nnfolder-request-list) 377 (nnfolder-request-list)
376 (save-excursion 378 (save-excursion
377 (set-buffer buf) 379 (set-buffer buf)
378 (goto-char (point-min)) 380 (goto-char (point-min))
379 (search-forward "\n\n" nil t) 381 (search-forward "\n\n" nil t)
380 (forward-line -1) 382 (forward-line -1)
381 (while (re-search-backward (concat "^" nnfolder-article-marker) nil t) 383 (while (re-search-backward (concat "^" nnfolder-article-marker) nil t)
382 (delete-region (point) (progn (forward-line 1) (point)))) 384 (delete-region (point) (progn (forward-line 1) (point))))
385 (nnmail-cache-insert (nnmail-fetch-field "message-id"))
383 (setq result 386 (setq result
384 (car (nnfolder-save-mail 387 (car (nnfolder-save-mail
385 (if (stringp group) 388 (if (stringp group)
386 (list (cons group (nnfolder-active-number group))) 389 (list (cons group (nnfolder-active-number group)))
387 (nnmail-article-group 'nnfolder-active-number)))))) 390 (setq art-group
388 (save-excursion 391 (nnmail-article-group 'nnfolder-active-number)))))))
389 (set-buffer nnfolder-current-buffer) 392 (when last
390 (and last (nnfolder-save-buffer)))) 393 (save-excursion
394 (nnfolder-possibly-change-folder (or (caar art-group) group))
395 (nnfolder-save-buffer)
396 (nnmail-cache-close))))
391 (nnmail-save-active nnfolder-group-alist nnfolder-active-file) 397 (nnmail-save-active nnfolder-group-alist nnfolder-active-file)
392 (unless result 398 (unless result
393 (nnheader-report 'nnfolder "Couldn't store article")) 399 (nnheader-report 'nnfolder "Couldn't store article"))
394 result)) 400 result))
395 401
412 () ; Don't delete the articles. 418 () ; Don't delete the articles.
413 ;; Delete the file that holds the group. 419 ;; Delete the file that holds the group.
414 (ignore-errors 420 (ignore-errors
415 (delete-file (nnfolder-group-pathname group)))) 421 (delete-file (nnfolder-group-pathname group))))
416 ;; Remove the group from all structures. 422 ;; Remove the group from all structures.
417 (setq nnfolder-group-alist 423 (setq nnfolder-group-alist
418 (delq (assoc group nnfolder-group-alist) nnfolder-group-alist) 424 (delq (assoc group nnfolder-group-alist) nnfolder-group-alist)
419 nnfolder-current-group nil 425 nnfolder-current-group nil
420 nnfolder-current-buffer nil) 426 nnfolder-current-buffer nil)
421 ;; Save the active file. 427 ;; Save the active file.
422 (nnmail-save-active nnfolder-group-alist nnfolder-active-file) 428 (nnmail-save-active nnfolder-group-alist nnfolder-active-file)
426 (nnfolder-possibly-change-group group server) 432 (nnfolder-possibly-change-group group server)
427 (save-excursion 433 (save-excursion
428 (set-buffer nnfolder-current-buffer) 434 (set-buffer nnfolder-current-buffer)
429 (and (file-writable-p buffer-file-name) 435 (and (file-writable-p buffer-file-name)
430 (ignore-errors 436 (ignore-errors
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)
435 ;; That went ok, so we change the internal structures. 441 ;; That went ok, so we change the internal structures.
436 (let ((entry (assoc group nnfolder-group-alist))) 442 (let ((entry (assoc group nnfolder-group-alist)))
465 (if (and (not (bobp)) leave-delim) 471 (if (and (not (bobp)) leave-delim)
466 (progn (forward-line -2) (point)) 472 (progn (forward-line -2) (point))
467 (point)) 473 (point))
468 (point-max)))))) 474 (point-max))))))
469 475
470 ;; When scanning, we're not looking t immediately switch into the group - if
471 ;; we know our information is up to date, don't even bother reading the file.
472 (defun nnfolder-possibly-change-group (group &optional server scanning) 476 (defun nnfolder-possibly-change-group (group &optional server scanning)
477 ;; Change servers.
473 (when (and server 478 (when (and server
474 (not (nnfolder-server-opened server))) 479 (not (nnfolder-server-opened server)))
475 (nnfolder-open-server server)) 480 (nnfolder-open-server server))
476 (when (and group (or nnfolder-current-buffer 481 ;; Change group.
477 (not (equal group nnfolder-current-group)))) 482 (when (and group
478 (gnus-make-directory (directory-file-name nnfolder-directory)) 483 (not (equal group nnfolder-current-group)))
479 (nnfolder-possibly-activate-groups nil) 484 (nnmail-activate 'nnfolder)
480 (or (assoc group nnfolder-group-alist) 485 (when (and (not (assoc group nnfolder-group-alist))
481 (not (file-exists-p 486 (not (file-exists-p
482 (nnfolder-group-pathname group))) 487 (nnfolder-group-pathname group))))
483 (progn 488 ;; The group doesn't exist, so we create a new entry for it.
484 (push (list group (cons 1 0)) nnfolder-group-alist) 489 (push (list group (cons 1 0)) nnfolder-group-alist)
485 (nnmail-save-active nnfolder-group-alist nnfolder-active-file))) 490 (nnmail-save-active nnfolder-group-alist nnfolder-active-file))
491
486 (let (inf file) 492 (let (inf file)
487 (if (and (equal group nnfolder-current-group) 493 ;; If we have to change groups, see if we don't already have the
488 nnfolder-current-buffer 494 ;; folder in memory. If we do, verify the modtime and destroy
489 (buffer-name nnfolder-current-buffer)) 495 ;; the folder if needed so we can rescan it.
490 () 496 (when (setq inf (assoc group nnfolder-buffer-alist))
491 (setq nnfolder-current-group group) 497 (setq nnfolder-current-buffer (nth 1 inf)))
492 498
493 ;; If we have to change groups, see if we don't already have the mbox 499 ;; If the buffer is not live, make sure it isn't in the alist. If it
494 ;; in memory. If we do, verify the modtime and destroy the mbox if 500 ;; is live, verify that nobody else has touched the file since last
495 ;; needed so we can rescan it. 501 ;; time.
496 (when (setq inf (assoc group nnfolder-buffer-alist)) 502 (when (and nnfolder-current-buffer
497 (setq nnfolder-current-buffer (nth 1 inf))) 503 (not (gnus-buffer-live-p nnfolder-current-buffer)))
498 504 (setq nnfolder-buffer-alist (delq inf nnfolder-buffer-alist)
499 ;; If the buffer is not live, make sure it isn't in the alist. If it 505 nnfolder-current-buffer nil))
500 ;; is live, verify that nobody else has touched the file since last 506
501 ;; time. 507 (setq nnfolder-current-group group)
502 (when (or (not (and nnfolder-current-buffer 508
503 (buffer-name nnfolder-current-buffer))) 509 (when (or (not nnfolder-current-buffer)
504 (not (and (bufferp nnfolder-current-buffer) 510 (not (verify-visited-file-modtime nnfolder-current-buffer)))
505 (verify-visited-file-modtime 511 (save-excursion
506 nnfolder-current-buffer)))) 512 (setq file (nnfolder-group-pathname group))
507 (when (and nnfolder-current-buffer 513 ;; See whether we need to create the new file.
508 (buffer-name nnfolder-current-buffer) 514 (unless (file-exists-p file)
509 (bufferp nnfolder-current-buffer)) 515 (gnus-make-directory (file-name-directory file))
510 (kill-buffer nnfolder-current-buffer)) 516 (nnmail-write-region 1 1 file t 'nomesg))
511 (setq nnfolder-buffer-alist (delq inf nnfolder-buffer-alist)) 517 (when (setq nnfolder-current-buffer (nnfolder-read-folder group))
512 (setq inf nil)) 518 (set-buffer nnfolder-current-buffer)
513 519 (push (list group nnfolder-current-buffer)
514 (unless inf 520 nnfolder-buffer-alist)))))))
515 (save-excursion
516 (setq file (nnfolder-group-pathname group))
517 (unless (file-directory-p (file-truename file))
518 (unless (file-exists-p file)
519 (gnus-make-directory (file-name-directory file))
520 (nnmail-write-region 1 1 file t 'nomesg))
521 (setq nnfolder-current-group group)
522 (setq nnfolder-current-buffer
523 (nnfolder-read-folder file scanning))
524 (when nnfolder-current-buffer
525 (set-buffer nnfolder-current-buffer)
526 (push (list group nnfolder-current-buffer)
527 nnfolder-buffer-alist)))))))
528 (setq nnfolder-current-group group)))
529 521
530 (defun nnfolder-save-mail (group-art-list) 522 (defun nnfolder-save-mail (group-art-list)
531 "Called narrowed to an article." 523 "Called narrowed to an article."
532 (let* (save-list group-art) 524 (let* (save-list group-art)
533 (goto-char (point-min)) 525 (goto-char (point-min))
534 ;; The From line may have been quoted by movemail. 526 ;; The From line may have been quoted by movemail.
535 (when (looking-at (concat ">" message-unix-mail-delimiter)) 527 (when (looking-at (concat ">" message-unix-mail-delimiter))
536 (delete-char 1)) 528 (delete-char 1))
537 ;; This might come from somewhere else. 529 ;; This might come from somewhere else.
538 (unless (looking-at message-unix-mail-delimiter) 530 (unless (looking-at message-unix-mail-delimiter)
539 (insert "From nobody " (current-time-string) "\n") 531 (insert "From nobody " (current-time-string) "\n")
540 (goto-char (point-min))) 532 (goto-char (point-min)))
541 ;; Quote all "From " lines in the article. 533 ;; Quote all "From " lines in the article.
542 (forward-line 1) 534 (forward-line 1)
548 (nnmail-insert-xref group-art-list) 540 (nnmail-insert-xref group-art-list)
549 (run-hooks 'nnmail-prepare-save-mail-hook) 541 (run-hooks 'nnmail-prepare-save-mail-hook)
550 (run-hooks 'nnfolder-prepare-save-mail-hook) 542 (run-hooks 'nnfolder-prepare-save-mail-hook)
551 543
552 ;; Insert the mail into each of the destination groups. 544 ;; Insert the mail into each of the destination groups.
553 (while group-art-list 545 (while (setq group-art (pop group-art-list))
554 (setq group-art (car group-art-list) 546 ;; Kill any previous newsgroup markers.
555 group-art-list (cdr group-art-list))
556
557 ;; Kill the previous newsgroup markers.
558 (goto-char (point-min)) 547 (goto-char (point-min))
559 (search-forward "\n\n" nil t) 548 (search-forward "\n\n" nil t)
560 (forward-line -1) 549 (forward-line -1)
561 (while (search-backward (concat "\n" nnfolder-article-marker) nil t) 550 (while (search-backward (concat "\n" nnfolder-article-marker) nil t)
562 (delete-region (1+ (point)) (progn (forward-line 2) (point)))) 551 (delete-region (1+ (point)) (progn (forward-line 2) (point))))
563 552
564 (nnfolder-possibly-change-group (car group-art))
565 ;; Insert the new newsgroup marker. 553 ;; Insert the new newsgroup marker.
566 (nnfolder-insert-newsgroup-line group-art) 554 (nnfolder-insert-newsgroup-line group-art)
567 (unless nnfolder-current-buffer 555
568 (nnfolder-close-group (car group-art)) 556 (save-excursion
569 (nnfolder-request-create-group (car group-art)) 557 (let ((beg (point-min))
570 (nnfolder-possibly-change-group (car group-art))) 558 (end (point-max))
571 (let ((beg (point-min)) 559 (obuf (current-buffer)))
572 (end (point-max)) 560 (nnfolder-possibly-change-folder (car group-art))
573 (obuf (current-buffer))) 561 (goto-char (point-max))
574 (set-buffer nnfolder-current-buffer) 562 (unless (eolp)
575 (goto-char (point-max)) 563 (insert "\n"))
576 (unless (eolp) 564 (unless (bobp)
577 (insert "\n")) 565 (insert "\n"))
578 (unless (bobp) 566 (insert-buffer-substring obuf beg end))))
579 (insert "\n"))
580 (insert-buffer-substring obuf beg end)
581 (set-buffer obuf)))
582 567
583 ;; Did we save it anywhere? 568 ;; Did we save it anywhere?
584 save-list)) 569 save-list))
585 570
586 (defun nnfolder-insert-newsgroup-line (group-art) 571 (defun nnfolder-insert-newsgroup-line (group-art)
588 (goto-char (point-min)) 573 (goto-char (point-min))
589 (when (search-forward "\n\n" nil t) 574 (when (search-forward "\n\n" nil t)
590 (forward-char -1) 575 (forward-char -1)
591 (insert (format (concat nnfolder-article-marker "%d %s\n") 576 (insert (format (concat nnfolder-article-marker "%d %s\n")
592 (cdr group-art) (current-time-string)))))) 577 (cdr group-art) (current-time-string))))))
593
594 (defun nnfolder-possibly-activate-groups (&optional group)
595 (save-excursion
596 ;; If we're looking for the activation of a specific group, find out
597 ;; its real name and switch to it.
598 (when group
599 (nnfolder-possibly-change-group group))
600 ;; If the group alist isn't active, activate it now.
601 (nnmail-activate 'nnfolder)))
602 578
603 (defun nnfolder-active-number (group) 579 (defun nnfolder-active-number (group)
604 ;; Find the next article number in GROUP. 580 ;; Find the next article number in GROUP.
605 (let ((active (cadr (assoc group nnfolder-group-alist)))) 581 (let ((active (cadr (assoc group nnfolder-group-alist))))
606 (if active 582 (if active
610 ;; a hat, but I don't know... 586 ;; a hat, but I don't know...
611 (push (list group (setq active (cons 1 1))) 587 (push (list group (setq active (cons 1 1)))
612 nnfolder-group-alist)) 588 nnfolder-group-alist))
613 (cdr active))) 589 (cdr active)))
614 590
591 (defun nnfolder-possibly-change-folder (group)
592 (let ((inf (assoc group nnfolder-buffer-alist)))
593 (if (and inf
594 (gnus-buffer-live-p (cadr inf)))
595 (set-buffer (cadr inf))
596 (when inf
597 (setq nnfolder-buffer-alist (delq inf nnfolder-buffer-alist)))
598 (when nnfolder-group-alist
599 (nnmail-save-active nnfolder-group-alist nnfolder-active-file))
600 (push (list group (nnfolder-read-folder group))
601 nnfolder-buffer-alist))))
615 602
616 ;; This method has a problem if you've accidentally let the active list get 603 ;; This method has a problem if you've accidentally let the active list get
617 ;; out of sync with the files. This could happen, say, if you've 604 ;; out of sync with the files. This could happen, say, if you've
618 ;; accidentally gotten new mail with something other than Gnus (but why 605 ;; accidentally gotten new mail with something other than Gnus (but why
619 ;; would _that_ ever happen? :-). In that case, we will be in the middle of 606 ;; would _that_ ever happen? :-). In that case, we will be in the middle of
626 ;; rest of the message looking for any more, possibly higher IDs. We'll 613 ;; rest of the message looking for any more, possibly higher IDs. We'll
627 ;; assume the maximum that we find is the highest active. Note that this 614 ;; assume the maximum that we find is the highest active. Note that this
628 ;; shouldn't cost us much extra time at all, but will be a lot less 615 ;; shouldn't cost us much extra time at all, but will be a lot less
629 ;; vulnerable to glitches between the mbox and the active file. 616 ;; vulnerable to glitches between the mbox and the active file.
630 617
631 (defun nnfolder-read-folder (file &optional scanning) 618 (defun nnfolder-read-folder (group)
632 ;; This is an attempt at a serious shortcut - don't even read in the file 619 (let* ((file (nnfolder-group-pathname group))
633 ;; if we know we've seen it since the last time it was touched. 620 (buffer (set-buffer (nnheader-find-file-noselect file))))
634 (let ((scantime (cadr (assoc nnfolder-current-group 621 (if (equal (cadr (assoc group nnfolder-scantime-alist))
635 nnfolder-scantime-alist))) 622 (nth 5 (file-attributes file)))
636 (modtime (nth 5 (file-attributes file)))) 623 ;; This looks up-to-date, so we don't do any scanning.
637 (if (and scanning scantime 624 buffer
638 (eq (car scantime) (car modtime)) 625 ;; Parse the damn thing.
639 (eq (cdr scantime) (cadr modtime)))
640 nil
641 (save-excursion 626 (save-excursion
642 (nnfolder-possibly-activate-groups nil) 627 (nnmail-activate 'nnfolder)
643 ;; Read in the file. 628 ;; Read in the file.
644 (set-buffer (setq nnfolder-current-buffer
645 (nnheader-find-file-noselect file)))
646 (buffer-disable-undo (current-buffer))
647 (setq buffer-read-only nil)
648 ;; If the file hasn't been touched since the last time we scanned it,
649 ;; don't bother doing anything with it.
650 (let ((delim (concat "^" message-unix-mail-delimiter)) 629 (let ((delim (concat "^" message-unix-mail-delimiter))
651 (marker (concat "\n" nnfolder-article-marker)) 630 (marker (concat "\n" nnfolder-article-marker))
652 (number "[0-9]+") 631 (number "[0-9]+")
653 (active (or (cadr (assoc nnfolder-current-group 632 (active (cadr (assoc group nnfolder-group-alist)))
654 nnfolder-group-alist)) 633 (scantime (assoc group nnfolder-scantime-alist))
655 (cons 1 0)))
656 (scantime (assoc nnfolder-current-group nnfolder-scantime-alist))
657 (minid (lsh -1 -1)) 634 (minid (lsh -1 -1))
658 maxid start end newscantime) 635 maxid start end newscantime
659 636 buffer-read-only)
660 (setq maxid (or (cdr active) 0)) 637 (buffer-disable-undo (current-buffer))
638 (setq maxid (cdr active))
661 (goto-char (point-min)) 639 (goto-char (point-min))
662 640
663 ;; Anytime the active number is 1 or 0, it is suspect. In that 641 ;; Anytime the active number is 1 or 0, it is suspect. In that
664 ;; case, search the file manually to find the active number. Or, 642 ;; case, search the file manually to find the active number. Or,
665 ;; of course, if we're being paranoid. (This would also be the 643 ;; of course, if we're being paranoid. (This would also be the
690 (goto-char (point-min))))) 668 (goto-char (point-min)))))
691 669
692 ;; Keep track of the active number on our own, and insert it back 670 ;; Keep track of the active number on our own, and insert it back
693 ;; into the active list when we're done. Also, prime the pump to 671 ;; into the active list when we're done. Also, prime the pump to
694 ;; cut down on the number of searches we do. 672 ;; cut down on the number of searches we do.
673 (unless (nnmail-search-unix-mail-delim)
674 (goto-char (point-max)))
695 (setq end (point-marker)) 675 (setq end (point-marker))
696 (set-marker end (or (and (nnmail-search-unix-mail-delim)
697 (point))
698 (point-max)))
699 (while (not (= end (point-max))) 676 (while (not (= end (point-max)))
700 (setq start (marker-position end)) 677 (setq start (marker-position end))
701 (goto-char end) 678 (goto-char end)
702 ;; There may be more than one "From " line, so we skip past 679 ;; There may be more than one "From " line, so we skip past
703 ;; them. 680 ;; them.
704 (while (looking-at delim) 681 (while (looking-at delim)
705 (forward-line 1)) 682 (forward-line 1))
706 (set-marker end (or (and (nnmail-search-unix-mail-delim) 683 (set-marker end (if (nnmail-search-unix-mail-delim)
707 (point)) 684 (point)
708 (point-max))) 685 (point-max)))
709 (goto-char start) 686 (goto-char start)
710 (when (not (search-forward marker end t)) 687 (when (not (search-forward marker end t))
711 (narrow-to-region start end) 688 (narrow-to-region start end)
712 (nnmail-insert-lines) 689 (nnmail-insert-lines)
713 (nnfolder-insert-newsgroup-line 690 (nnfolder-insert-newsgroup-line
714 (cons nil (nnfolder-active-number nnfolder-current-group))) 691 (cons nil (nnfolder-active-number nnfolder-current-group)))
715 (widen))) 692 (widen)))
716 693
694 (set-marker end nil)
717 ;; Make absolutely sure that the active list reflects reality! 695 ;; Make absolutely sure that the active list reflects reality!
718 (nnmail-save-active nnfolder-group-alist nnfolder-active-file) 696 (nnmail-save-active nnfolder-group-alist nnfolder-active-file)
719 ;; Set the scantime for this group. 697 ;; Set the scantime for this group.
720 (setq newscantime (visited-file-modtime)) 698 (setq newscantime (visited-file-modtime))
721 (if scantime 699 (if scantime
731 (nnmail-activate 'nnfolder) 709 (nnmail-activate 'nnfolder)
732 (let ((files (directory-files nnfolder-directory)) 710 (let ((files (directory-files nnfolder-directory))
733 file) 711 file)
734 (while (setq file (pop files)) 712 (while (setq file (pop files))
735 (when (and (not (backup-file-name-p file)) 713 (when (and (not (backup-file-name-p file))
736 (nnheader-mail-file-mbox-p 714 (message-mail-file-mbox-p
737 (concat nnfolder-directory file))) 715 (concat nnfolder-directory file)))
738 (nnheader-message 5 "Adding group %s..." file) 716 (nnheader-message 5 "Adding group %s..." file)
739 (push (list file (cons 1 0)) nnfolder-group-alist) 717 (push (list file (cons 1 0)) nnfolder-group-alist)
740 (nnfolder-possibly-change-group file) 718 (nnfolder-possibly-change-group file)
741 (nnfolder-close-group file)) 719 (nnfolder-close-group file))
743 721
744 (defun nnfolder-group-pathname (group) 722 (defun nnfolder-group-pathname (group)
745 "Make pathname for GROUP." 723 "Make pathname for GROUP."
746 (let ((dir (file-name-as-directory (expand-file-name nnfolder-directory)))) 724 (let ((dir (file-name-as-directory (expand-file-name nnfolder-directory))))
747 ;; If this file exists, we use it directly. 725 ;; If this file exists, we use it directly.
748 (if (or nnmail-use-long-file-names 726 (if (or nnmail-use-long-file-names
749 (file-exists-p (concat dir group))) 727 (file-exists-p (concat dir group)))
750 (concat dir group) 728 (concat dir group)
751 ;; If not, we translate dots into slashes. 729 ;; If not, we translate dots into slashes.
752 (concat dir (nnheader-replace-chars-in-string group ?. ?/))))) 730 (concat dir (nnheader-replace-chars-in-string group ?. ?/)))))
753 731