Mercurial > hg > xemacs-beta

comparison lisp/gnus/nnfolder.el @ 32:e04119814345 r19-15b99

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b99
author cvs
date Mon, 13 Aug 2007 08:52:56 +0200
parents ec9a17fef872
children d620409f5eb8
comparison
equal deleted inserted replaced
31:b9328a10c56c 32:e04119814345
191 (string-to-int 191 (string-to-int
192 (buffer-substring 192 (buffer-substring
193 (point) (progn (end-of-line) (point))))))))))) 193 (point) (progn (end-of-line) (point)))))))))))
194 194
195 (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) 196 (nnfolder-possibly-change-group group server t)
197 (save-excursion 197 (save-excursion
198 (nnmail-activate 'nnfolder)
199 (if (not (assoc group nnfolder-group-alist)) 198 (if (not (assoc group nnfolder-group-alist))
200 (nnheader-report 'nnfolder "No such group: %s" group) 199 (nnheader-report 'nnfolder "No such group: %s" group)
201 (if dont-check 200 (if dont-check
202 (progn 201 (progn
203 (nnheader-report 'nnfolder "Selected group %s" group) 202 (nnheader-report 'nnfolder "Selected group %s" group)
215 (nnheader-insert "211 %d %d %d %s\n" 214 (nnheader-insert "211 %d %d %d %s\n"
216 (1+ (- (cdr range) (car range))) 215 (1+ (- (cdr range) (car range)))
217 (car range) (cdr range) group)))))))) 216 (car range) (cdr range) group))))))))
218 217
219 (deffoo nnfolder-request-scan (&optional group server) 218 (deffoo nnfolder-request-scan (&optional group server)
220 (nnfolder-possibly-change-group group server t) 219 (nnfolder-possibly-change-group nil server)
221 (nnmail-get-new-mail 220 (when nnfolder-get-new-mail
222 'nnfolder 221 (nnfolder-possibly-change-group group server)
223 (lambda () 222 (nnmail-get-new-mail
224 (let ((bufs nnfolder-buffer-alist)) 223 'nnfolder
225 (save-excursion 224 (lambda ()
226 (while bufs 225 (let ((bufs nnfolder-buffer-alist))
227 (if (not (buffer-name (nth 1 (car bufs)))) 226 (save-excursion
228 (setq nnfolder-buffer-alist 227 (while bufs
229 (delq (car bufs) nnfolder-buffer-alist)) 228 (if (not (buffer-name (nth 1 (car bufs))))
230 (set-buffer (nth 1 (car bufs))) 229 (setq nnfolder-buffer-alist
231 (nnfolder-save-buffer) 230 (delq (car bufs) nnfolder-buffer-alist))
232 (kill-buffer (current-buffer))) 231 (set-buffer (nth 1 (car bufs)))
233 (setq bufs (cdr bufs)))))) 232 (nnfolder-save-buffer)
234 nnfolder-directory 233 (kill-buffer (current-buffer)))
235 group)) 234 (setq bufs (cdr bufs))))))
235 nnfolder-directory
236 group)))
236 237
237 ;; Don't close the buffer if we're not shutting down the server. This way, 238 ;; Don't close the buffer if we're not shutting down the server. This way,
238 ;; we can keep the buffer in the group buffer cache, and not have to grovel 239 ;; we can keep the buffer in the group buffer cache, and not have to grovel
239 ;; over the buffer again unless we add new mail to it or modify it in some 240 ;; over the buffer again unless we add new mail to it or modify it in some
240 ;; way. 241 ;; way.
318 (push (car articles) rest))) 319 (push (car articles) rest)))
319 (setq articles (cdr articles))) 320 (setq articles (cdr articles)))
320 (unless nnfolder-inhibit-expiry 321 (unless nnfolder-inhibit-expiry
321 (nnheader-message 5 "Deleting articles...done")) 322 (nnheader-message 5 "Deleting articles...done"))
322 (nnfolder-save-buffer) 323 (nnfolder-save-buffer)
323 ;; Find the lowest active article in this group. 324 (nnfolder-adjust-min-active newsgroup)
324 (let* ((active (cadr (assoc newsgroup nnfolder-group-alist)))
325 (marker (concat "\n" nnfolder-article-marker))
326 (number "[0-9]+")
327 (activemin (cdr active)))
328 (goto-char (point-min))
329 (while (and (search-forward marker nil t)
330 (re-search-forward number nil t))
331 (setq activemin (min activemin
332 (string-to-number (buffer-substring
333 (match-beginning 0)
334 (match-end 0))))))
335 (setcar active activemin))
336 (nnmail-save-active nnfolder-group-alist nnfolder-active-file) 325 (nnmail-save-active nnfolder-group-alist nnfolder-active-file)
337 (nconc rest articles)))) 326 (nconc rest articles))))
338 327
339 (deffoo nnfolder-request-move-article 328 (deffoo nnfolder-request-move-article
340 (article group server accept-form &optional last) 329 (article group server accept-form &optional last)
360 (nnfolder-possibly-change-group group server) 349 (nnfolder-possibly-change-group group server)
361 (set-buffer nnfolder-current-buffer) 350 (set-buffer nnfolder-current-buffer)
362 (goto-char (point-min)) 351 (goto-char (point-min))
363 (when (search-forward (nnfolder-article-string article) nil t) 352 (when (search-forward (nnfolder-article-string article) nil t)
364 (nnfolder-delete-mail)) 353 (nnfolder-delete-mail))
365 (and last (nnfolder-save-buffer)))) 354 (when last
355 (nnfolder-save-buffer)
356 (nnfolder-adjust-min-active group))))
366 result)) 357 result))
367 358
368 (deffoo nnfolder-request-accept-article (group &optional server last) 359 (deffoo nnfolder-request-accept-article (group &optional server last)
369 (nnfolder-possibly-change-group group server) 360 (nnfolder-possibly-change-group group server)
370 (nnmail-check-syntax) 361 (nnmail-check-syntax)
450 t)))) 441 t))))
451 442
452 443
453 ;;; Internal functions. 444 ;;; Internal functions.
454 445
446 (defun nnfolder-adjust-min-active (group)
447 ;; Find the lowest active article in this group.
448 (let* ((active (cadr (assoc group nnfolder-group-alist)))
449 (marker (concat "\n" nnfolder-article-marker))
450 (number "[0-9]+")
451 (activemin (cdr active)))
452 (goto-char (point-min))
453 (while (and (search-forward marker nil t)
454 (re-search-forward number nil t))
455 (setq activemin (min activemin
456 (string-to-number (buffer-substring
457 (match-beginning 0)
458 (match-end 0))))))
459 (setcar active activemin)))
460
455 (defun nnfolder-article-string (article) 461 (defun nnfolder-article-string (article)
456 (if (numberp article) 462 (if (numberp article)
457 (concat "\n" nnfolder-article-marker (int-to-string article) " ") 463 (concat "\n" nnfolder-article-marker (int-to-string article) " ")
458 (concat "\nMessage-ID: " article))) 464 (concat "\nMessage-ID: " article)))
459 465
471 (if (and (not (bobp)) leave-delim) 477 (if (and (not (bobp)) leave-delim)
472 (progn (forward-line -2) (point)) 478 (progn (forward-line -2) (point))
473 (point)) 479 (point))
474 (point-max)))))) 480 (point-max))))))
475 481
476 (defun nnfolder-possibly-change-group (group &optional server scanning) 482 (defun nnfolder-possibly-change-group (group &optional server dont-check)
477 ;; Change servers. 483 ;; Change servers.
478 (when (and server 484 (when (and server
479 (not (nnfolder-server-opened server))) 485 (not (nnfolder-server-opened server)))
480 (nnfolder-open-server server)) 486 (nnfolder-open-server server))
481 ;; Change group. 487 ;; Change group.
487 (nnfolder-group-pathname group)))) 493 (nnfolder-group-pathname group))))
488 ;; The group doesn't exist, so we create a new entry for it. 494 ;; The group doesn't exist, so we create a new entry for it.
489 (push (list group (cons 1 0)) nnfolder-group-alist) 495 (push (list group (cons 1 0)) nnfolder-group-alist)
490 (nnmail-save-active nnfolder-group-alist nnfolder-active-file)) 496 (nnmail-save-active nnfolder-group-alist nnfolder-active-file))
491 497
492 (let (inf file) 498 (unless dont-check
493 ;; If we have to change groups, see if we don't already have the 499 (let (inf file)
494 ;; folder in memory. If we do, verify the modtime and destroy 500 ;; If we have to change groups, see if we don't already have the
495 ;; the folder if needed so we can rescan it. 501 ;; folder in memory. If we do, verify the modtime and destroy
496 (when (setq inf (assoc group nnfolder-buffer-alist)) 502 ;; the folder if needed so we can rescan it.
497 (setq nnfolder-current-buffer (nth 1 inf))) 503 (when (setq inf (assoc group nnfolder-buffer-alist))
498 504 (setq nnfolder-current-buffer (nth 1 inf)))
499 ;; If the buffer is not live, make sure it isn't in the alist. If it 505
500 ;; is live, verify that nobody else has touched the file since last 506 ;; If the buffer is not live, make sure it isn't in the alist. If it
501 ;; time. 507 ;; is live, verify that nobody else has touched the file since last
502 (when (and nnfolder-current-buffer 508 ;; time.
503 (not (gnus-buffer-live-p nnfolder-current-buffer))) 509 (when (and nnfolder-current-buffer
504 (setq nnfolder-buffer-alist (delq inf nnfolder-buffer-alist) 510 (not (gnus-buffer-live-p nnfolder-current-buffer)))
505 nnfolder-current-buffer nil)) 511 (setq nnfolder-buffer-alist (delq inf nnfolder-buffer-alist)
506 512 nnfolder-current-buffer nil))
507 (setq nnfolder-current-group group) 513
508 514 (setq nnfolder-current-group group)
509 (when (or (not nnfolder-current-buffer) 515
510 (not (verify-visited-file-modtime nnfolder-current-buffer))) 516 (when (or (not nnfolder-current-buffer)
511 (save-excursion 517 (not (verify-visited-file-modtime nnfolder-current-buffer)))
512 (setq file (nnfolder-group-pathname group)) 518 (save-excursion
513 ;; See whether we need to create the new file. 519 (setq file (nnfolder-group-pathname group))
514 (unless (file-exists-p file) 520 ;; See whether we need to create the new file.
515 (gnus-make-directory (file-name-directory file)) 521 (unless (file-exists-p file)
516 (nnmail-write-region 1 1 file t 'nomesg)) 522 (gnus-make-directory (file-name-directory file))
517 (when (setq nnfolder-current-buffer (nnfolder-read-folder group)) 523 (nnmail-write-region 1 1 file t 'nomesg))
518 (set-buffer nnfolder-current-buffer) 524 (when (setq nnfolder-current-buffer (nnfolder-read-folder group))
519 (push (list group nnfolder-current-buffer) 525 (set-buffer nnfolder-current-buffer)
520 nnfolder-buffer-alist))))))) 526 (push (list group nnfolder-current-buffer)
527 nnfolder-buffer-alist))))))))
521 528
522 (defun nnfolder-save-mail (group-art-list) 529 (defun nnfolder-save-mail (group-art-list)
523 "Called narrowed to an article." 530 "Called narrowed to an article."
524 (let* (save-list group-art) 531 (let* (save-list group-art)
525 (goto-char (point-min)) 532 (goto-char (point-min))
530 (unless (looking-at message-unix-mail-delimiter) 537 (unless (looking-at message-unix-mail-delimiter)
531 (insert "From nobody " (current-time-string) "\n") 538 (insert "From nobody " (current-time-string) "\n")
532 (goto-char (point-min))) 539 (goto-char (point-min)))
533 ;; Quote all "From " lines in the article. 540 ;; Quote all "From " lines in the article.
534 (forward-line 1) 541 (forward-line 1)
535 (while (re-search-forward "^From " nil t) 542 (let (case-fold-search)
536 (beginning-of-line) 543 (while (re-search-forward "^From " nil t)
537 (insert "> ")) 544 (beginning-of-line)
545 (insert "> ")))
538 (setq save-list group-art-list) 546 (setq save-list group-art-list)
539 (nnmail-insert-lines) 547 (nnmail-insert-lines)
540 (nnmail-insert-xref group-art-list) 548 (nnmail-insert-xref group-art-list)
541 (run-hooks 'nnmail-prepare-save-mail-hook) 549 (run-hooks 'nnmail-prepare-save-mail-hook)
542 (run-hooks 'nnfolder-prepare-save-mail-hook) 550 (run-hooks 'nnfolder-prepare-save-mail-hook)
710 (let ((files (directory-files nnfolder-directory)) 718 (let ((files (directory-files nnfolder-directory))
711 file) 719 file)
712 (while (setq file (pop files)) 720 (while (setq file (pop files))
713 (when (and (not (backup-file-name-p file)) 721 (when (and (not (backup-file-name-p file))
714 (message-mail-file-mbox-p 722 (message-mail-file-mbox-p
715 (concat nnfolder-directory file))) 723 (nnheader-concat nnfolder-directory file)))
716 (nnheader-message 5 "Adding group %s..." file) 724 (let ((oldgroup (assoc file nnfolder-group-alist)))
717 (push (list file (cons 1 0)) nnfolder-group-alist) 725 (if oldgroup
718 (nnfolder-possibly-change-group file) 726 (nnheader-message 5 "Refreshing group %s..." file)
719 (nnfolder-close-group file)) 727 (nnheader-message 5 "Adding group %s..." file))
720 (message "")))) 728 (setq nnfolder-group-alist (remove oldgroup nnfolder-group-alist))
729 (push (list file (cons 1 0)) nnfolder-group-alist)
730 (nnfolder-possibly-change-folder file)
731 (nnfolder-possibly-change-group file)
732 (nnfolder-close-group file))))
733 (message "")))
721 734
722 (defun nnfolder-group-pathname (group) 735 (defun nnfolder-group-pathname (group)
723 "Make pathname for GROUP." 736 "Make pathname for GROUP."
724 (let ((dir (file-name-as-directory (expand-file-name nnfolder-directory)))) 737 (let ((dir (file-name-as-directory (expand-file-name nnfolder-directory))))
725 ;; If this file exists, we use it directly. 738 ;; If this file exists, we use it directly.