;;; nnfolder.el --- mail folder access for Gnus
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002
;; Free Software Foundation, Inc.
;; Author: Simon Josefsson <simon@josefsson.org> (adding MARKS)
;; ShengHuo Zhu <zsh@cs.rochester.edu> (adding NOV)
;; Scott Byer <byer@mv.us.adobe.com>
;; Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
+;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
;; Keywords: mail
;; This file is part of GNU Emacs.
(require 'gnus-range)
(eval-and-compile
+ (autoload 'gnus-article-unpropagatable-p "gnus-sum")
(autoload 'gnus-intersection "gnus-range"))
(nnoo-declare nnfolder)
(defvoo nnfolder-directory (expand-file-name message-directory)
- "The name of the nnfolder directory.
-
-This variable is a virtual server slot. See the Gnus manual for details.")
+ "The name of the nnfolder directory.")
(defvoo nnfolder-nov-directory nil
"The name of the nnfolder NOV directory.
(defvoo nnfolder-active-file
(nnheader-concat nnfolder-directory "active")
- "The name of the active file.
-
-This variable is a virtual server slot. See the Gnus manual for details.")
+ "The name of the active file.")
;; I renamed this variable to something more in keeping with the general GNU
;; style. -SLB
(defvoo nnfolder-newsgroups-file
(concat (file-name-as-directory nnfolder-directory) "newsgroups")
- "Mail newsgroups description file.
-
-This variable is a virtual server slot. See the Gnus manual for details.")
+ "Mail newsgroups description file.")
(defvoo nnfolder-get-new-mail t
- "If non-nil, nnfolder will check the incoming mail file and split the mail.
-
-This variable is a virtual server slot. See the Gnus manual for details.")
+ "If non-nil, nnfolder will check the incoming mail file and split the mail.")
(defvoo nnfolder-prepare-save-mail-hook nil
"Hook run narrowed to an article before saving.")
(defvoo nnfolder-save-buffer-hook nil
- "Hook run before saving the nnfolder mbox buffer.
-
-This variable is a virtual server slot. See the Gnus manual for details.")
+ "Hook run before saving the nnfolder mbox buffer.")
(defvoo nnfolder-inhibit-expiry nil
- "If non-nil, inhibit expiry.
-
-This variable is a virtual server slot. See the Gnus manual for details.")
+ "If non-nil, inhibit expiry.")
\f
(defvoo nnfolder-file-coding-system mm-text-coding-system)
(defvoo nnfolder-file-coding-system-for-write nnheader-file-coding-system
"Coding system for save nnfolder file.
-If NIL, NNFOLDER-FILE-CODING-SYSTEM is used.")
+if nil, `nnfolder-file-coding-system' is used.") ; FIXME: fill-in the doc-string of this variable
(defvoo nnfolder-nov-is-evil nil
"If non-nil, Gnus will never generate and use nov databases for mail groups.
set this to t, and want to set it to nil again, you should always run
the `nnfolder-generate-active-file' command. The function will go
through all nnfolder directories and generate nov databases for them
-all. This may very well take some time.
-
-This variable is a virtual server slot. See the Gnus manual for details.")
+all. This may very well take some time.")
(defvoo nnfolder-nov-file-suffix ".nov")
this to t, and want to set it to nil again, you should always remove
the corresponding marks file (usually base nnfolder file name
concatenated with `.mrk', but see `nnfolder-marks-file-suffix') for
-the group. Then the marks file will be regenerated properly by Gnus.
-
-This variable is a virtual server slot. See the Gnus manual for details.")
+the group. Then the marks file will be regenerated properly by Gnus.")
(defvoo nnfolder-marks nil)
(defvoo nnfolder-marks-file-suffix ".mrk")
+(defvar nnfolder-marks-modtime (gnus-make-hashtable))
+
\f
;;; Interface functions
(with-temp-buffer
(nnfolder-request-article (car maybe-expirable)
newsgroup server (current-buffer))
- (let ((nnml-current-directory nil))
+ (let ((nnfolder-current-directory nil))
(nnmail-expiry-target-group
- nnmail-expiry-target newsgroup))))
+ nnmail-expiry-target newsgroup)))
+ (nnfolder-possibly-change-group newsgroup server))
(nnheader-message 5 "Deleting article %d in %s..."
(car maybe-expirable) newsgroup)
(nnfolder-delete-mail)
(nnfolder-save-buffer)
(nnfolder-adjust-min-active newsgroup)
(nnfolder-save-active nnfolder-group-alist nnfolder-active-file)
- (gnus-sorted-complement articles (nreverse deleted-articles)))))
+ (gnus-sorted-difference articles (nreverse deleted-articles)))))
(deffoo nnfolder-request-move-article (article group server
accept-form &optional last)
result art-group)
(goto-char (point-min))
(when (looking-at "X-From-Line: ")
+ (save-match-data
+ (mail-header-unfold-field))
(replace-match "From "))
(with-temp-buffer
(let ((nnmail-file-coding-system nnfolder-active-file-coding-system)
(while (re-search-backward (concat "^" nnfolder-article-marker) nil t)
(delete-region (point) (progn (forward-line 1) (point))))
(when nnmail-cache-accepted-message-ids
- (nnmail-cache-insert (nnmail-fetch-field "message-id")))
+ (nnmail-cache-insert (nnmail-fetch-field "message-id") group))
(setq result (if (stringp group)
(list (cons group (nnfolder-active-number group)))
(setq art-group
(save-excursion
(set-buffer buffer)
(goto-char (point-min))
- (let (xfrom)
- (while (re-search-forward "^X-From-Line: \\(.*\\)$" nil t)
- (setq xfrom (match-string 1))
- (gnus-delete-line))
- (goto-char (point-min))
- (if xfrom
- (insert "From " xfrom "\n")
- (unless (looking-at "From ")
- (insert "From nobody " (current-time-string) "\n"))))
+ (if (not (looking-at "X-From-Line: "))
+ (insert "From nobody " (current-time-string) "\n")
+ (replace-match "From ")
+ (forward-line 1)
+ (while (looking-at "[ \t]")
+ (delete-char -1)
+ (forward-line 1)))
(nnfolder-normalize-buffer)
(set-buffer nnfolder-current-buffer)
(goto-char (point-min))
(if (not force)
() ; Don't delete the articles.
;; Delete the file that holds the group.
- (ignore-errors
- (delete-file (nnfolder-group-pathname group))
- (when (file-exists-p (nnfolder-group-nov-pathname group))
- (delete-file (nnfolder-group-nov-pathname group)))
- (when (file-exists-p (nnfolder-group-marks-pathname group))
- (delete-file (nnfolder-group-marks-pathname group)))))
+ (let ((data (nnfolder-group-pathname group))
+ (nov (nnfolder-group-nov-pathname group))
+ (mrk (nnfolder-group-marks-pathname group)))
+ (ignore-errors (delete-file data))
+ (ignore-errors (delete-file nov))
+ (ignore-errors (delete-file mrk))))
;; Remove the group from all structures.
(setq nnfolder-group-alist
(delq (assoc group nnfolder-group-alist) nnfolder-group-alist)
(let ((nnmail-file-coding-system
(or nnfolder-file-coding-system-for-write
nnfolder-file-coding-system-for-write)))
- (nnmail-write-region 1 1 file t 'nomesg)))
+ (nnmail-write-region (point-min) (point-min)
+ file t 'nomesg)))
(when (setq nnfolder-current-buffer (nnfolder-read-folder group))
(set-buffer nnfolder-current-buffer)
(push (list group nnfolder-current-buffer)
(goto-char (point-max))
(skip-chars-backward "\n")
(delete-region (point) (point-max))
- (insert "\n\n"))
+ (unless (bobp)
+ (insert "\n\n")))
(defun nnfolder-insert-newsgroup-line (group-art)
(save-excursion
(nnfolder-insert-newsgroup-line
(cons nil
(setq newnum
- (nnfolder-active-number nnfolder-current-group))))
+ (nnfolder-active-number group))))
(when novbuf
(let ((headers (nnfolder-parse-head newnum (point-min)
(point-max))))
(setq newscantime (visited-file-modtime))
(if scantime
(setcdr scantime (list newscantime))
- (push (list nnfolder-current-group newscantime)
+ (push (list group newscantime)
nnfolder-scantime-alist))
;; Save nov.
(when novbuf
(nnheader-insert-nov headers)))
(deffoo nnfolder-request-set-mark (group actions &optional server)
- (nnfolder-possibly-change-group group server)
+ (when (and server
+ (not (nnfolder-server-opened server)))
+ (nnfolder-open-server server))
(unless nnfolder-marks-is-evil
(nnfolder-open-marks group server)
(dolist (action actions)
nil)
(deffoo nnfolder-request-update-info (group info &optional server)
- (nnfolder-possibly-change-group group server)
- (unless nnfolder-marks-is-evil
+ ;; Change servers.
+ (when (and server
+ (not (nnfolder-server-opened server)))
+ (nnfolder-open-server server))
+ (when (and (not nnfolder-marks-is-evil) (nnfolder-marks-changed-p group))
+ (nnheader-message 8 "Updating marks for %s..." group)
(nnfolder-open-marks group server)
;; Update info using `nnfolder-marks'.
(mapcar (lambda (pred)
- (gnus-info-set-marks
- info
- (gnus-update-alist-soft
- (cdr pred)
- (cdr (assq (cdr pred) nnfolder-marks))
- (gnus-info-marks info))
- t))
+ (unless (memq (cdr pred) gnus-article-unpropagated-mark-lists)
+ (gnus-info-set-marks
+ info
+ (gnus-update-alist-soft
+ (cdr pred)
+ (cdr (assq (cdr pred) nnfolder-marks))
+ (gnus-info-marks info))
+ t)))
gnus-article-mark-lists)
(let ((seen (cdr (assq 'read nnfolder-marks))))
(gnus-info-set-read info
(if (and (integerp (car seen))
(null (cdr seen)))
(list (cons (car seen) (car seen)))
- seen))))
+ seen)))
+ (nnheader-message 8 "Updating marks for %s...done" group))
info)
(defun nnfolder-group-marks-pathname (group)
(let ((nnfolder-directory (or nnfolder-marks-directory nnfolder-directory)))
(concat (nnfolder-group-pathname group) nnfolder-marks-file-suffix)))
+(defun nnfolder-marks-changed-p (group)
+ (let ((file (nnfolder-group-marks-pathname group)))
+ (if (null (gnus-gethash file nnfolder-marks-modtime))
+ t ;; never looked at marks file, assume it has changed
+ (not (equal (gnus-gethash file nnfolder-marks-modtime)
+ (nth 5 (file-attributes file)))))))
+
(defun nnfolder-save-marks (group server)
(let ((file-name-coding-system nnmail-pathname-coding-system)
(file (nnfolder-group-marks-pathname group)))
(condition-case err
(progn
- (gnus-make-directory group)
(with-temp-file file
(erase-buffer)
- (princ nnfolder-marks (current-buffer))
- (insert "\n")))
+ (gnus-prin1 nnfolder-marks)
+ (insert "\n"))
+ (gnus-sethash file
+ (nth 5 (file-attributes file))
+ nnfolder-marks-modtime))
(error (or (gnus-yes-or-no-p
(format "Could not write to %s (%s). Continue? " file err))
(error "Cannot write to %s (%s)" err))))))
(defun nnfolder-open-marks (group server)
(let ((file (nnfolder-group-marks-pathname group)))
(if (file-exists-p file)
- (setq nnfolder-marks (condition-case err
- (with-temp-buffer
- (nnheader-insert-file-contents file)
- (read (current-buffer)))
- (error (or (gnus-yes-or-no-p
- (format "Error reading nnfolder marks file %s (%s). Continuing will use marks from .newsrc.eld. Continue? " file err))
- (error "Cannot read nnfolder marks file %s (%s)" file err)))))
+ (condition-case err
+ (with-temp-buffer
+ (gnus-sethash file (nth 5 (file-attributes file))
+ nnfolder-marks-modtime)
+ (nnheader-insert-file-contents file)
+ (setq nnfolder-marks (read (current-buffer)))
+ (dolist (el gnus-article-unpropagated-mark-lists)
+ (setq nnfolder-marks (gnus-remassoc el nnfolder-marks))))
+ (error (or (gnus-yes-or-no-p
+ (format "Error reading nnfolder marks file %s (%s). Continuing will use marks from .newsrc.eld. Continue? " file err))
+ (error "Cannot read nnfolder marks file %s (%s)" file err))))
;; User didn't have a .marks file. Probably first time
;; user of the .marks stuff. Bootstrap it from .newsrc.eld.
(let ((info (gnus-get-info
(gnus-group-prefixed-name
group
(gnus-server-to-method (format "nnfolder:%s" server))))))
- (nnheader-message 6 "Bootstrapping nnfolder marks...")
+ (nnheader-message 7 "Bootstrapping marks for %s..." group)
(setq nnfolder-marks (gnus-info-marks info))
(push (cons 'read (gnus-info-read info)) nnfolder-marks)
- (nnfolder-save-marks group server)))))
+ (dolist (el gnus-article-unpropagated-mark-lists)
+ (setq nnfolder-marks (gnus-remassoc el nnfolder-marks)))
+ (nnfolder-save-marks group server)
+ (nnheader-message 7 "Bootstrapping marks for %s...done" group)))))
(provide 'nnfolder)
projects / gnus / blobdiff