X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fnnfolder.el;h=0245ff844151c8921a8c4ab73b48af02fb203da6;hp=deb83568fc4916766c8da30a16797e9a97c78bb2;hb=bbe68edb313e02acb4557e5cc4ff2f87a41ca66c;hpb=6277de5f0e5b26bc92640def5ac859b4b0f68aac diff --git a/lisp/nnfolder.el b/lisp/nnfolder.el index deb83568f..0245ff844 100644 --- a/lisp/nnfolder.el +++ b/lisp/nnfolder.el @@ -1,20 +1,20 @@ ;;; nnfolder.el --- mail folder access for Gnus -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001 -;; Free Software Foundation, Inc. -;; Author: Simon Josefsson (adding MARKS) +;; Copyright (C) 1995-2012 Free Software Foundation, Inc. + +;; Author: Simon Josefsson ;; ShengHuo Zhu (adding NOV) ;; Scott Byer ;; Lars Magne Ingebrigtsen -;; Masanobu UMEDA +;; Masanobu UMEDA ;; Keywords: mail ;; 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., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, 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,29 +41,21 @@ (require 'gnus-util) (require 'gnus-range) -(eval-and-compile - (autoload 'gnus-intersection "gnus-range")) +;; FIXME not explicitly used in this file. +(autoload 'gnus-article-unpropagatable-p "gnus-sum") (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 @@ -83,28 +77,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.") @@ -127,7 +113,7 @@ This variable is a virtual server slot. See the Gnus manual for details.") (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. @@ -136,9 +122,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") @@ -146,23 +130,6 @@ 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. - -This variable is a virtual server slot. See the Gnus manual for details.") - -(defvoo nnfolder-marks nil) - -(defvoo nnfolder-marks-file-suffix ".mrk") - -(defvar nnfolder-marks-modtime (gnus-make-hashtable)) - ;;; Interface functions @@ -170,10 +137,9 @@ This variable is a virtual server slot. See the Gnus manual for details.") (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) + (let (article start stop num) (nnfolder-possibly-change-group group server) (when nnfolder-current-buffer (set-buffer nnfolder-current-buffer) @@ -188,16 +154,53 @@ This variable is a virtual server slot. See the Gnus manual for details.") (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-number + (buffer-substring + (point) (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-number + (buffer-substring + (point) (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)))))) @@ -209,9 +212,6 @@ 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) @@ -237,8 +237,7 @@ This variable is a virtual server slot. See the Gnus manual for details.") (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) @@ -263,53 +262,57 @@ This variable is a virtual server slot. See the Gnus manual for details.") (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-number (buffer-substring + (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 @@ -332,8 +335,7 @@ This variable is a virtual server slot. See the Gnus manual for details.") 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 @@ -349,12 +351,21 @@ This variable is a virtual server slot. See the Gnus manual for details.") (deffoo nnfolder-request-create-group (group &optional server args) (nnfolder-possibly-change-group nil server) (nnmail-activate 'nnfolder) - (when group - (unless (assoc group nnfolder-group-alist) - (push (list group (cons 1 0)) nnfolder-group-alist) - (nnfolder-save-active nnfolder-group-alist nnfolder-active-file) - (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) @@ -393,20 +404,24 @@ This variable is a virtual server slot. See the Gnus manual for details.") ;; 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. @@ -422,37 +437,45 @@ This variable is a virtual server slot. See the Gnus manual for details.") (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)))) - (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 (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)) + (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) - (gnus-sorted-complement articles (nreverse deleted-articles))))) + (nnfolder-save-all-buffers) + (gnus-sorted-difference articles (nreverse deleted-articles))))) -(deffoo nnfolder-request-move-article (article group server - accept-form &optional last) +(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)) @@ -460,8 +483,7 @@ This variable is a virtual server slot. See the Gnus manual for details.") (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) @@ -487,7 +509,9 @@ 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: ") - (replace-match "From ")) + (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))) @@ -501,7 +525,10 @@ 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 + (nnmail-fetch-field "subject") + (nnmail-fetch-field "from"))) (setq result (if (stringp group) (list (cons group (nnfolder-active-number group))) (setq art-group @@ -524,18 +551,15 @@ This variable is a virtual server slot. See the Gnus manual for details.") (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)) - (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)) @@ -544,8 +568,7 @@ This variable is a virtual server slot. See the Gnus manual for details.") (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) @@ -561,12 +584,10 @@ 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)) - (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))) + (ignore-errors (delete-file data)) + (ignore-errors (delete-file nov)))) ;; Remove the group from all structures. (setq nnfolder-group-alist (delq (assoc group nnfolder-group-alist) nnfolder-group-alist) @@ -578,8 +599,7 @@ This variable is a virtual server slot. See the Gnus manual for details.") (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))) @@ -588,11 +608,7 @@ This variable is a virtual server slot. See the Gnus manual for details.") (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))) @@ -619,8 +635,7 @@ This variable is a virtual server slot. See the Gnus manual for details.") (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)) @@ -725,7 +740,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) @@ -788,7 +804,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 @@ -798,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. @@ -846,8 +863,9 @@ deleted. Point is left where the deleted region was." (buffer (set-buffer (let ((nnheader-file-coding-system nnfolder-file-coding-system)) - (nnheader-find-file-noselect file))))) + (nnheader-find-file-noselect file t))))) (mm-enable-multibyte) ;; Use multibyte buffer for future copying. + (buffer-disable-undo) (if (equal (cadr (assoc group nnfolder-scantime-alist)) (nth 5 (file-attributes file))) ;; This looks up-to-date, so we don't do any scanning. @@ -870,11 +888,12 @@ 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) - (buffer-disable-undo) (setq maxid (cdr active)) (unless (or gnus-nov-is-evil nnfolder-nov-is-evil @@ -960,7 +979,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)))) @@ -978,7 +997,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 @@ -1001,9 +1020,7 @@ This command does not work if you use short group names." (when (not (message-mail-file-mbox-p file)) (ignore-errors (delete-file file))))) - (let ((files (directory-files nnfolder-directory)) - file) - (while (setq file (pop files)) + (dolist (file (directory-files nnfolder-directory)) (when (and (not (backup-file-name-p file)) (message-mail-file-mbox-p (nnheader-concat nnfolder-directory file))) @@ -1018,10 +1035,10 @@ This command does not work if you use short group names." (nnfolder-possibly-change-folder file) (nnfolder-possibly-change-group file) (nnfolder-close-group file)))) - (nnheader-message 5 ""))) + (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)))) @@ -1038,6 +1055,8 @@ 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) @@ -1046,6 +1065,7 @@ This command does not work if you use short group names." (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))) @@ -1059,8 +1079,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) @@ -1084,8 +1103,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)) @@ -1095,8 +1113,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 @@ -1125,126 +1142,18 @@ This command does not work if you use short group names." (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))))) (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)) 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) - (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 (eq (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) - (princ nnfolder-marks (current-buffer)) - (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 - (gnus-sethash file - (nth 5 (file-attributes file)) - nnfolder-marks-modtime) - (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))))) - ;; 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) - (nnfolder-save-marks group server))))) - (provide 'nnfolder) ;;; nnfolder.el ends here