X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fnnfolder.el;h=876647f331edc8eaff6fc5ed22da6fe335f618d6;hb=9b741e050b400987d68ff761c6cc3276c932839c;hp=f234b8d25516bb7afd748d17b0f7a2b885e15a2f;hpb=1a7b8c37b8aadeae04f57577c44f9be28f3e4398;p=elisp%2Fgnus.git- diff --git a/lisp/nnfolder.el b/lisp/nnfolder.el index f234b8d..876647f 100644 --- a/lisp/nnfolder.el +++ b/lisp/nnfolder.el @@ -1,8 +1,9 @@ ;;; 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 ;; Free Software Foundation, Inc. -;; Author: ShengHuo Zhu (adding NOV) +;; Author: Simon Josefsson (adding MARKS) +;; ShengHuo Zhu (adding NOV) ;; Scott Byer ;; Lars Magne Ingebrigtsen ;; Masanobu UMEDA @@ -36,28 +37,30 @@ (require 'message) (require 'nnmail) (require 'nnoo) +(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) (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. 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. - -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 @@ -79,28 +82,20 @@ message, a huge time saver for large mailboxes.") (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.") @@ -123,7 +118,7 @@ This variable is a virtual server slot. See the Gnus manual for details.") (defvoo nnfolder-file-coding-system nnheader-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. @@ -132,9 +127,7 @@ This variable shouldn't be flipped much. If you have, for some reason, 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") @@ -142,6 +135,21 @@ This variable is a virtual server slot. See the Gnus manual for details.") (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)) + ;;; Interface functions @@ -188,6 +196,9 @@ This variable is a virtual server slot. See the Gnus manual for details.") (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) @@ -402,9 +413,10 @@ This variable is a virtual server slot. See the Gnus manual for details.") (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) @@ -418,7 +430,7 @@ This variable is a virtual server slot. See the Gnus manual for details.") (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) @@ -463,6 +475,8 @@ This variable is a virtual server slot. See the Gnus manual for details.") 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) @@ -477,7 +491,7 @@ This variable is a virtual server slot. See the Gnus manual for details.") (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 @@ -503,15 +517,13 @@ This variable is a virtual server slot. See the Gnus manual for details.") (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)) @@ -537,9 +549,12 @@ This variable is a virtual server slot. See the Gnus manual for details.") (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) @@ -558,9 +573,14 @@ This variable is a virtual server slot. See the Gnus manual for details.") (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))) @@ -694,7 +714,8 @@ deleted. Point is left where the deleted region was." (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) @@ -757,7 +778,8 @@ deleted. Point is left where the deleted region was." (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 @@ -927,7 +949,7 @@ deleted. Point is left where the deleted region was." (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)))) @@ -944,7 +966,7 @@ deleted. Point is left where the deleted region was." (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 @@ -1111,6 +1133,112 @@ This command does not work if you use short group names." (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