Make sure that the error message doesn't error out.
[gnus] / lisp / nnfolder.el
index 1de4e52..1e0a950 100644 (file)
@@ -1,20 +1,21 @@
 ;;; nnfolder.el --- mail folder access for Gnus
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001
-;;        Free Software Foundation, Inc.
+
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
+;;   2005, 2006, 2007, 2008, 2009, 2010 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.
 
-;; 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
 ;; 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 <http://www.gnu.org/licenses/>.
 
 ;;; Commentary:
 
 ;;; Code:
 
+;; For Emacs < 22.2.
+(eval-and-compile
+  (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
+
 (require 'nnheader)
 (require 'message)
 (require 'nnmail)
 (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)
 
 (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.
@@ -60,9 +60,7 @@ 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
@@ -84,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.")
 
 \f
 
@@ -128,7 +118,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.
@@ -137,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")
 
@@ -154,9 +142,7 @@ 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.")
+the group.  Then the marks file will be regenerated properly by Gnus.")
 
 (defvoo nnfolder-marks nil)
 
@@ -171,10 +157,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)
@@ -189,16 +174,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))))))
@@ -238,8 +260,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)
@@ -264,33 +285,37 @@ 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)
@@ -333,8 +358,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
@@ -350,12 +374,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 n