X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fnnfolder.el;h=e189ab531f065d40a6265e1ede12eb2c1e1d58f1;hp=30c85c02a1da8eeb7a02b78975c18441e36dfcfb;hb=88a72625d1e27f31be5f521ed8a7369e9f708884;hpb=20bc985a3232ebba106d335afcfd6b596bb8efba diff --git a/lisp/nnfolder.el b/lisp/nnfolder.el index 30c85c02a..e189ab531 100644 --- a/lisp/nnfolder.el +++ b/lisp/nnfolder.el @@ -1,8 +1,8 @@ ;;; nnfolder.el --- mail folder access for Gnus -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004 -;; Free Software Foundation, Inc. -;; Author: Simon Josefsson (adding MARKS) +;; Copyright (C) 1995-2013 Free Software Foundation, Inc. + +;; Author: Simon Josefsson ;; ShengHuo Zhu (adding NOV) ;; Scott Byer ;; Lars Magne Ingebrigtsen @@ -11,10 +11,10 @@ ;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of @@ -22,14 +22,16 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: ;;; Code: +;; For Emacs <22.2 and XEmacs. +(eval-and-compile + (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) + (require 'nnheader) (require 'message) (require 'nnmail) @@ -39,9 +41,8 @@ (require 'gnus-util) (require 'gnus-range) -(eval-and-compile - (autoload 'gnus-article-unpropagatable-p "gnus-sum") - (autoload 'gnus-intersection "gnus-range")) +;; FIXME not explicitly used in this file. +(autoload 'gnus-article-unpropagatable-p "gnus-sum") (nnoo-declare nnfolder) @@ -52,10 +53,6 @@ "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.") @@ -133,21 +130,6 @@ all. This may very well take some time.") (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 @@ -155,8 +137,7 @@ the group. Then the marks file will be regenerated properly by Gnus.") (nnoo-define-basics nnfolder) (deffoo nnfolder-retrieve-headers (articles &optional group server fetch-old) - (save-excursion - (set-buffer nntp-server-buffer) + (with-current-buffer nntp-server-buffer (erase-buffer) (let (article start stop num) (nnfolder-possibly-change-group group server) @@ -231,9 +212,6 @@ the group. Then the marks file will be regenerated properly by Gnus.") (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) @@ -259,8 +237,7 @@ the group. Then the marks file will be regenerated properly by Gnus.") (deffoo nnfolder-request-article (article &optional group server buffer) (nnfolder-possibly-change-group group server) - (save-excursion - (set-buffer nnfolder-current-buffer) + (with-current-buffer nnfolder-current-buffer (goto-char (point-min)) (when (nnfolder-goto-article article) (let (start stop) @@ -289,48 +266,53 @@ the group. Then the marks file will be regenerated properly by Gnus.") (point) (point-at-eol))) -1)))))))) -(deffoo nnfolder-request-group (group &optional server dont-check) +(deffoo nnfolder-request-group (group &optional server dont-check info) (nnfolder-possibly-change-group group server t) (save-excursion - (if (not (assoc group nnfolder-group-alist)) - (nnheader-report 'nnfolder "No such group: %s" group) - (if dont-check - (progn - (nnheader-report 'nnfolder "Selected group %s" group) - t) - (let* ((active (assoc group nnfolder-group-alist)) - (group (car active)) - (range (cadr active))) - (cond - ((null active) - (nnheader-report 'nnfolder "No such group: %s" group)) - ((null nnfolder-current-group) - (nnheader-report 'nnfolder "Empty group: %s" group)) - (t - (nnheader-report 'nnfolder "Selected group %s" group) - (nnheader-insert "211 %d %d %d %s\n" - (1+ (- (cdr range) (car range))) - (car range) (cdr range) group)))))))) + (cond ((not (assoc group nnfolder-group-alist)) + (nnheader-report 'nnfolder "No such group: %s" group)) + ((file-directory-p (nnfolder-group-pathname group)) + (nnheader-report 'nnfolder "%s is a directory" + (file-name-as-directory + (let ((nnmail-pathname-coding-system nil)) + (nnfolder-group-pathname group))))) + (dont-check + (nnheader-report 'nnfolder "Selected group %s" group) + t) + (t + (let* ((active (assoc group nnfolder-group-alist)) + (group (car active)) + (range (cadr active))) + (cond + ((null active) + (nnheader-report 'nnfolder "No such group: %s" group)) + ((null nnfolder-current-group) + (nnheader-report 'nnfolder "Empty group: %s" group)) + (t + (nnheader-report 'nnfolder "Selected group %s" group) + (nnheader-insert "211 %d %d %d %s\n" + (1+ (- (cdr range) (car range))) + (car range) (cdr range) group)))))))) (deffoo nnfolder-request-scan (&optional group server) (nnfolder-possibly-change-group nil server) (when nnfolder-get-new-mail (nnfolder-possibly-change-group group server) (nnmail-get-new-mail - 'nnfolder - (lambda () - (let ((bufs nnfolder-buffer-alist)) - (save-excursion - (while bufs - (if (not (gnus-buffer-live-p (nth 1 (car bufs)))) - (setq nnfolder-buffer-alist - (delq (car bufs) nnfolder-buffer-alist)) - (set-buffer (nth 1 (car bufs))) - (nnfolder-save-buffer) - (kill-buffer (current-buffer))) - (setq bufs (cdr bufs)))))) - nnfolder-directory - group))) + 'nnfolder 'nnfolder-save-all-buffers + nnfolder-directory group))) + +(defun nnfolder-save-all-buffers () + (let ((bufs nnfolder-buffer-alist)) + (save-excursion + (while bufs + (if (not (gnus-buffer-live-p (nth 1 (car bufs)))) + (setq nnfolder-buffer-alist + (delq (car bufs) nnfolder-buffer-alist)) + (set-buffer (nth 1 (car bufs))) + (nnfolder-save-buffer) + (kill-buffer (current-buffer))) + (setq bufs (cdr bufs)))))) ;; Don't close the buffer if we're not shutting down the server. This way, ;; we can keep the buffer in the group buffer cache, and not have to grovel @@ -353,8 +335,7 @@ the group. Then the marks file will be regenerated properly by Gnus.") nnfolder-current-group (car inf)))) (when (and nnfolder-current-buffer (buffer-name nnfolder-current-buffer)) - (save-excursion - (set-buffer nnfolder-current-buffer) + (with-current-buffer nnfolder-current-buffer ;; If the buffer was modified, write the file out now. (nnfolder-save-buffer) ;; If we're shutting the server down, we need to kill the @@ -370,13 +351,21 @@ the group. Then the marks file will be regenerated properly by Gnus.") (deffoo nnfolder-request-create-group (group &optional server args) (nnfolder-possibly-change-group nil server) (nnmail-activate 'nnfolder) - (when (and group - (not (assoc group nnfolder-group-alist))) - (push (list group (cons 1 0)) nnfolder-group-alist) - (nnfolder-save-active nnfolder-group-alist nnfolder-active-file) - (save-current-buffer - (nnfolder-read-folder group))) - t) + (cond ((zerop (length group)) + (nnheader-report 'nnfolder "Invalid (empty) group name")) + ((file-directory-p (nnfolder-group-pathname group)) + (nnheader-report 'nnfolder "%s is a directory" + (file-name-as-directory + (let ((nnmail-pathname-coding-system nil)) + (nnfolder-group-pathname group))))) + ((assoc group nnfolder-group-alist) + t) + (t + (push (list group (cons 1 0)) nnfolder-group-alist) + (nnfolder-save-active nnfolder-group-alist nnfolder-active-file) + (save-current-buffer + (nnfolder-read-folder group)) + t))) (deffoo nnfolder-request-list (&optional server) (nnfolder-possibly-change-group nil server) @@ -415,20 +404,24 @@ the group. Then the marks file will be regenerated properly by Gnus.") ;; The article numbers are increasing, so this result is sorted. (nreverse numbers))))) -(deffoo nnfolder-request-expire-articles - (articles newsgroup &optional server force) +(autoload 'gnus-request-group "gnus-int") +(declare-function gnus-request-create-group "gnus-int" + (group &optional gnus-command-method args)) + +(deffoo nnfolder-request-expire-articles (articles newsgroup + &optional server force) (nnfolder-possibly-change-group newsgroup server) - (let* ((is-old t) - ;; The articles we have deleted so far. - (deleted-articles nil) - ;; The articles that really exist and will - ;; be expired if they are old enough. - (maybe-expirable - (gnus-sorted-intersection articles (nnfolder-existing-articles)))) + (let ((is-old t) + ;; The articles we have deleted so far. + (deleted-articles nil) + ;; The articles that really exist and will + ;; be expired if they are old enough. + (maybe-expirable + (gnus-sorted-intersection articles (nnfolder-existing-articles))) + target) (nnmail-activate 'nnfolder) - (save-excursion - (set-buffer nnfolder-current-buffer) + (with-current-buffer nnfolder-current-buffer ;; Since messages are sorted in arrival order and expired in the ;; same order, we can stop as soon as we find a message that is ;; too old. @@ -444,38 +437,45 @@ the group. Then the marks file will be regenerated properly by Gnus.") (buffer-substring (point) (progn (end-of-line) (point))) force nnfolder-inhibit-expiry)) - (unless (eq nnmail-expiry-target 'delete) + (setq target nnmail-expiry-target) + (unless (eq target 'delete) (with-temp-buffer (nnfolder-request-article (car maybe-expirable) newsgroup server (current-buffer)) (let ((nnfolder-current-directory nil)) - (nnmail-expiry-target-group - nnmail-expiry-target newsgroup))) + (when (functionp target) + (setq target (funcall target newsgroup))) + (when (and target (not (eq target 'delete))) + (if (or (gnus-request-group target) + (gnus-request-create-group target)) + (nnmail-expiry-target-group target newsgroup) + (setq target nil))))) (nnfolder-possibly-change-group newsgroup server)) - (nnheader-message 5 "Deleting article %d in %s..." - (car maybe-expirable) newsgroup) - (nnfolder-delete-mail) - (unless (or gnus-nov-is-evil nnfolder-nov-is-evil) - (nnfolder-nov-delete-article newsgroup (car maybe-expirable))) - ;; Must remember which articles were actually deleted - (push (car maybe-expirable) deleted-articles))) + (when target + (nnheader-message 5 "Deleting article %d in %s..." + (car maybe-expirable) newsgroup) + (nnfolder-delete-mail) + (unless (or gnus-nov-is-evil nnfolder-nov-is-evil) + (nnfolder-nov-delete-article newsgroup (car maybe-expirable))) + ;; Must remember which articles were actually deleted + (push (car maybe-expirable) deleted-articles)))) (setq maybe-expirable (cdr maybe-expirable))) (unless nnfolder-inhibit-expiry (nnheader-message 5 "Deleting articles...done")) (nnfolder-save-buffer) (nnfolder-adjust-min-active newsgroup) (nnfolder-save-active nnfolder-group-alist nnfolder-active-file) + (nnfolder-save-all-buffers) (gnus-sorted-difference articles (nreverse deleted-articles))))) -(deffoo nnfolder-request-move-article (article group server accept-form +(deffoo nnfolder-request-move-article (article group server accept-form &optional last move-is-internal) (save-excursion (let ((buf (get-buffer-create " *nnfolder move*")) result) (and (nnfolder-request-article article group server) - (save-excursion - (set-buffer buf) + (with-current-buffer buf (erase-buffer) (insert-buffer-substring nntp-server-buffer) (goto-char (point-min)) @@ -525,7 +525,7 @@ the group. Then the marks file will be regenerated properly by Gnus.") (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") (nnmail-fetch-field "from"))) @@ -551,8 +551,7 @@ the group. Then the marks file will be regenerated properly by Gnus.") (deffoo nnfolder-request-replace-article (article group buffer) (nnfolder-possibly-change-group group) - (save-excursion - (set-buffer buffer) + (with-current-buffer buffer (goto-char (point-min)) (if (not (looking-at "X-From-Line: ")) (insert "From nobody " (current-time-string) "\n") @@ -569,8 +568,7 @@ the group. Then the marks file will be regenerated properly by Gnus.") (nnfolder-delete-mail) (insert-buffer-substring buffer) (unless (or gnus-nov-is-evil nnfolder-nov-is-evil) - (save-excursion - (set-buffer buffer) + (with-current-buffer buffer (let ((headers (nnfolder-parse-head article (point-min) (point-max)))) (with-current-buffer (nnfolder-open-nov group) @@ -587,11 +585,9 @@ the group. Then the marks file will be regenerated properly by Gnus.") () ; Don't delete the articles. ;; Delete the file that holds the group. (let ((data (nnfolder-group-pathname group)) - (nov (nnfolder-group-nov-pathname group)) - (mrk (nnfolder-group-marks-pathname group))) + (nov (nnfolder-group-nov-pathname group))) (ignore-errors (delete-file data)) - (ignore-errors (delete-file nov)) - (ignore-errors (delete-file mrk)))) + (ignore-errors (delete-file nov)))) ;; Remove the group from all structures. (setq nnfolder-group-alist (delq (assoc group nnfolder-group-alist) nnfolder-group-alist) @@ -603,8 +599,7 @@ the group. Then the marks file will be regenerated properly by Gnus.") (deffoo nnfolder-request-rename-group (group new-name &optional server) (nnfolder-possibly-change-group group server) - (save-excursion - (set-buffer nnfolder-current-buffer) + (with-current-buffer nnfolder-current-buffer (and (file-writable-p buffer-file-name) (ignore-errors (let ((new-file (nnfolder-group-pathname new-name))) @@ -613,11 +608,7 @@ the group. Then the marks file will be regenerated properly by Gnus.") (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))) + (rename-file (nnfolder-group-nov-pathname group) new-file))) t) ;; That went ok, so we change the internal structures. (let ((entry (assoc group nnfolder-group-alist))) @@ -644,8 +635,7 @@ the group. Then the marks file will be regenerated properly by Gnus.") (marker (concat "\n" nnfolder-article-marker)) (number "[0-9]+") (activemin (cdr active))) - (save-excursion - (set-buffer nnfolder-current-buffer) + (with-current-buffer nnfolder-current-buffer (goto-char (point-min)) (while (and (search-forward marker nil t) (re-search-forward number nil t)) @@ -825,7 +815,7 @@ deleted. Point is left where the deleted region was." (insert "\n")) (forward-char -1) (insert (format (concat nnfolder-article-marker "%d %s\n") - (cdr group-art) (current-time-string))))) + (cdr group-art) (message-make-date))))) (defun nnfolder-active-number (group) ;; Find the next article number in GROUP. @@ -898,7 +888,9 @@ deleted. Point is left where the deleted region was." (active (or (cadr (assoc group nnfolder-group-alist)) (cons 1 0))) (scantime (assoc group nnfolder-scantime-alist)) - (minid (lsh -1 -1)) + (minid (or (and (boundp 'most-positive-fixnum) + most-positive-fixnum) + (lsh -1 -1))) maxid start end newscantime novbuf articles newnum buffer-read-only) @@ -1012,6 +1004,28 @@ deleted. Point is left where the deleted region was." (nnfolder-save-nov)) (current-buffer)))))) +(defun nnfolder-recursive-directory-files (dir prefix) + (let ((files nil)) + (dolist (file (directory-files dir)) + (cond + ((or (file-symlink-p (expand-file-name file dir)) + (member file '("." ".."))) + ;; Ignore + ) + ((file-directory-p (expand-file-name file dir)) + (setq files (nconc (nnfolder-recursive-directory-files + (expand-file-name file dir) + (if prefix + (concat prefix "." (directory-file-name file)) + (file-name-nondirectory file))) + files))) + ((file-regular-p (expand-file-name file dir)) + (push (if prefix + (concat prefix "." file) + file) + files)))) + files)) + ;;;###autoload (defun nnfolder-generate-active-file () "Look for mbox folders in the nnfolder directory and make them into groups. @@ -1028,10 +1042,13 @@ This command does not work if you use short group names." (when (not (message-mail-file-mbox-p file)) (ignore-errors (delete-file file))))) - (dolist (file (directory-files nnfolder-directory)) + (dolist (file (if nnmail-use-long-file-names + (directory-files nnfolder-directory) + (nnfolder-recursive-directory-files + nnfolder-directory nil))) (when (and (not (backup-file-name-p file)) (message-mail-file-mbox-p - (nnheader-concat nnfolder-directory file))) + (nnfolder-group-pathname file))) (let ((oldgroup (assoc file nnfolder-group-alist))) (if oldgroup (nnheader-message 5 "Refreshing group %s..." file) @@ -1063,17 +1080,21 @@ This command does not work if you use short group names." (or nnfolder-nov-directory nnfolder-directory))) (concat (nnfolder-group-pathname group) nnfolder-nov-file-suffix))) +(defvar copyright-update) + (defun nnfolder-save-buffer () "Save the buffer." - (when (buffer-modified-p) - (run-hooks 'nnfolder-save-buffer-hook) - (gnus-make-directory (file-name-directory (buffer-file-name))) - (let ((coding-system-for-write - (or nnfolder-file-coding-system-for-write - nnfolder-file-coding-system))) - (save-buffer))) - (unless (or gnus-nov-is-evil nnfolder-nov-is-evil) - (nnfolder-save-nov))) + (let ((delete-old-versions t)) + (when (buffer-modified-p) + (run-hooks 'nnfolder-save-buffer-hook) + (gnus-make-directory (file-name-directory (buffer-file-name))) + (let ((coding-system-for-write + (or nnfolder-file-coding-system-for-write + nnfolder-file-coding-system))) + (set (make-local-variable 'copyright-update) nil) + (save-buffer))) + (unless (or gnus-nov-is-evil nnfolder-nov-is-evil) + (nnfolder-save-nov)))) (defun nnfolder-save-active (group-alist active-file) (let ((nnmail-active-file-coding-system @@ -1084,8 +1105,7 @@ This command does not work if you use short group names." (defun nnfolder-open-nov (group) (or (cdr (assoc group nnfolder-nov-buffer-alist)) (let ((buffer (get-buffer-create (format " *nnfolder overview %s*" group)))) - (save-excursion - (set-buffer buffer) + (with-current-buffer buffer (set (make-local-variable 'nnfolder-nov-buffer-file-name) (nnfolder-group-nov-pathname group)) (erase-buffer) @@ -1109,8 +1129,7 @@ This command does not work if you use short group names." (setq nnfolder-nov-buffer-alist (cdr nnfolder-nov-buffer-alist))))) (defun nnfolder-nov-delete-article (group article) - (save-excursion - (set-buffer (nnfolder-open-nov group)) + (with-current-buffer (nnfolder-open-nov group) (when (nnheader-find-nov-line article) (delete-region (point) (progn (forward-line 1) (point)))) t)) @@ -1120,8 +1139,7 @@ This command does not work if you use short group names." nil (let ((nov (nnfolder-group-nov-pathname nnfolder-current-group))) (when (file-exists-p nov) - (save-excursion - (set-buffer nntp-server-buffer) + (with-current-buffer nntp-server-buffer (erase-buffer) (nnheader-insert-file-contents nov) (if (and fetch-old @@ -1157,119 +1175,11 @@ This command does not work if you use short group names." (defun nnfolder-add-nov (group article headers) "Add a nov line for the GROUP base." - (save-excursion - (set-buffer (nnfolder-open-nov group)) + (with-current-buffer (nnfolder-open-nov group) (goto-char (point-max)) (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)) nil - "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'. - (mapc (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)" file 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) -;;; arch-tag: a040d0f4-4f4e-445f-8972-839575c5f7e6 ;;; nnfolder.el ends here