;;; nnfolder.el --- mail folder access for Gnus
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003
;; Free Software Foundation, Inc.
-;; Author: ShengHuo Zhu <zsh@cs.rochester.edu> (adding NOV)
+;; 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 'nnmail)
(require 'nnoo)
(eval-when-compile (require 'cl))
+(require 'gnus)
(require 'gnus-util)
(require 'gnus-range)
(eval-and-compile
+ (autoload 'gnus-article-unpropagatable-p "gnus-sum")
(autoload 'gnus-intersection "gnus-range"))
(nnoo-declare nnfolder)
"The name of the nnfolder NOV directory.
If nil, `nnfolder-directory' is used.")
+(defvoo nnfolder-marks-directory nil
+ "The name of the nnfolder MARKS directory.
+If nil, `nnfolder-directory' is used.")
+
(defvoo nnfolder-active-file
(nnheader-concat nnfolder-directory "active")
"The name of the active file.")
(defvoo nnfolder-save-buffer-hook nil
"Hook run before saving the nnfolder mbox buffer.")
+
(defvoo nnfolder-inhibit-expiry nil
"If non-nil, inhibit expiry.")
(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.
(defvar nnfolder-nov-buffer-file-name nil)
+(defvoo nnfolder-marks-is-evil nil
+ "If non-nil, Gnus will never generate and use marks file for mail groups.
+Using marks files makes it possible to backup and restore mail groups
+separately from `.newsrc.eld'. If you have, for some reason, set
+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.")
+
+(defvoo nnfolder-marks nil)
+
+(defvoo nnfolder-marks-file-suffix ".mrk")
+
+(defvar nnfolder-marks-modtime (gnus-make-hashtable))
+
\f
;;; Interface functions
(save-excursion
(set-buffer nntp-server-buffer)
(erase-buffer)
- (let (article start stop)
+ (let (article start stop num)
(nnfolder-possibly-change-group group server)
(when nnfolder-current-buffer
(set-buffer nnfolder-current-buffer)
(nnfolder-existing-articles)))
(while (setq article (pop articles))
(set-buffer nnfolder-current-buffer)
- (when (nnfolder-goto-article article)
- (setq start (point))
- (setq stop (if (search-forward "\n\n" nil t)
- (1- (point))
- (point-max)))
- (set-buffer nntp-server-buffer)
- (insert (format "221 %d Article retrieved.\n" article))
- (insert-buffer-substring nnfolder-current-buffer start stop)
- (goto-char (point-max))
- (insert ".\n")))
+ (cond ((nnfolder-goto-article article)
+ (setq start (point))
+ (setq stop (if (search-forward "\n\n" nil t)
+ (1- (point))
+ (point-max)))
+ (set-buffer nntp-server-buffer)
+ (insert (format "221 %d Article retrieved.\n" article))
+ (insert-buffer-substring nnfolder-current-buffer
+ start stop)
+ (goto-char (point-max))
+ (insert ".\n"))
+
+ ;; If we couldn't find this article, skip over ranges
+ ;; of missing articles so we don't search the whole file
+ ;; for each of them.
+ ((numberp article)
+ (setq start (point))
+ (and
+ ;; Check that we are either at BOF or after an
+ ;; article with a lower number. We do this so we
+ ;; won't be confused by out-of-order article numbers,
+ ;; as caused by active file bogosity.
+ (cond
+ ((bobp))
+ ((search-backward (concat "\n" nnfolder-article-marker)
+ nil t)
+ (goto-char (match-end 0))
+ (setq num (string-to-int
+ (buffer-substring
+ (point) (gnus-point-at-eol))))
+ (goto-char start)
+ (< num article)))
+ ;; Check that we are before an article with a
+ ;; higher number.
+ (search-forward (concat "\n" nnfolder-article-marker)
+ nil t)
+ (progn
+ (setq num (string-to-int
+ (buffer-substring
+ (point) (gnus-point-at-eol))))
+ (> num article))
+ ;; Discard any article numbers before the one we're
+ ;; now looking at.
+ (while (and articles
+ (< (car articles) num))
+ (setq articles (cdr articles))))
+ (goto-char start))))
(set-buffer nntp-server-buffer)
(nnheader-fold-continuation-lines)
'headers))))))
(unless (or gnus-nov-is-evil nnfolder-nov-is-evil)
(and nnfolder-nov-directory
(gnus-make-directory nnfolder-nov-directory)))
+ (unless nnfolder-marks-is-evil
+ (and nnfolder-marks-directory
+ (gnus-make-directory nnfolder-marks-directory)))
(cond
((not (file-exists-p nnfolder-directory))
(nnfolder-close-server)
(cons nnfolder-current-group
(if (search-forward (concat "\n" nnfolder-article-marker)
nil t)
- (string-to-int
- (buffer-substring
- (point) (progn (end-of-line) (point))))
+ (string-to-int (buffer-substring
+ (point) (gnus-point-at-eol)))
-1))))))))
(deffoo nnfolder-request-group (group &optional server dont-check)
(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)
(concat "^" nnfolder-article-marker)
(save-excursion (and (search-forward "\n\n" nil t) (point)))
t)
- (delete-region (progn (beginning-of-line) (point))
- (progn (forward-line 1) (point))))
+ (gnus-delete-line))
(setq result (eval accept-form))
(kill-buffer buf)
result)
result art-group)
(goto-char (point-min))
(when (looking-at "X-From-Line: ")
- (replace-match "From "))
- (let ((nnmail-file-coding-system nnfolder-active-file-coding-system))
- (with-temp-buffer
+ (replace-match "From ")
+ (while (progn (forward-line) (looking-at "[ \t]"))
+ (delete-char -1)))
+ (with-temp-buffer
+ (let ((nnmail-file-coding-system nnfolder-active-file-coding-system)
+ (nntp-server-buffer (current-buffer)))
(nnmail-find-file nnfolder-active-file)
(setq nnfolder-group-alist (nnmail-parse-active))))
(save-excursion
(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
+ (nnmail-fetch-field "subject")))
(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))
- (delete-file (nnfolder-group-nov-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 ((new-file (nnfolder-group-pathname new-name)))
(gnus-make-directory (file-name-directory new-file))
(rename-file buffer-file-name new-file)
- (setq new-file (nnfolder-group-nov-pathname new-name))
- (rename-file (nnfolder-group-nov-pathname group)
- new-file))
+ (when (file-exists-p (nnfolder-group-nov-pathname group))
+ (setq new-file (nnfolder-group-nov-pathname new-name))
+ (gnus-make-directory (file-name-directory new-file))
+ (rename-file (nnfolder-group-nov-pathname group) new-file))
+ (when (file-exists-p (nnfolder-group-marks-pathname group))
+ (setq new-file (nnfolder-group-marks-pathname new-name))
+ (gnus-make-directory (file-name-directory new-file))
+ (rename-file (nnfolder-group-marks-pathname group) new-file)))
t)
;; That went ok, so we change the internal structures.
(let ((entry (assoc group 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-message 5 "")))
(defun nnfolder-group-pathname (group)
- "Make pathname for GROUP."
+ "Make file name for GROUP."
(setq group
(mm-encode-coding-string group nnmail-pathname-coding-system))
(let ((dir (file-name-as-directory (expand-file-name nnfolder-directory))))
(if (search-forward "\n\n" e t) (setq e (1- (point)))))
(with-temp-buffer
(insert-buffer-substring buf b e)
- ;; Fold continuation lines.
- (goto-char (point-min))
- (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
- (replace-match " " t t))
- ;; Remove any tabs; they are too confusing.
- (subst-char-in-region (point-min) (point-max) ?\t ? )
- (let ((headers (nnheader-parse-head t)))
+ (let ((headers (nnheader-parse-naked-head)))
(mail-header-set-chars headers chars)
(mail-header-set-number headers number)
headers)))))
(mail-header-set-number headers article)
(nnheader-insert-nov headers)))
+(deffoo nnfolder-request-set-mark (group actions &optional 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)
+ (let ((range (nth 0 action))
+ (what (nth 1 action))
+ (marks (nth 2 action)))
+ (assert (or (eq what 'add) (eq what 'del)) t
+ "Unknown request-set-mark action: %s" what)
+ (dolist (mark marks)
+ (setq nnfolder-marks (gnus-update-alist-soft
+ mark
+ (funcall (if (eq what 'add) 'gnus-range-add
+ 'gnus-remove-from-range)
+ (cdr (assoc mark nnfolder-marks)) range)
+ nnfolder-marks)))))
+ (nnfolder-save-marks group server))
+ nil)
+
+(deffoo nnfolder-request-update-info (group info &optional server)
+ ;; 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)
+ (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)))
+ (nnheader-message 8 "Updating marks for %s...done" group))
+ info)
+
+(defun nnfolder-group-marks-pathname (group)
+ "Make pathname for GROUP NOV."
+ (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
+ (with-temp-file file
+ (erase-buffer)
+ (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)
+ (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 7 "Bootstrapping marks for %s..." group)
+ (setq nnfolder-marks (gnus-info-marks info))
+ (push (cons 'read (gnus-info-read info)) nnfolder-marks)
+ (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)
;;; nnfolder.el ends here
projects / gnus / blobdiff