time-date.el (seconds-to-string): New function to pretty print time delay in seconds
[gnus] / lisp / nnfolder.el
index b86a26b..a403f39 100644 (file)
@@ -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 <simon@josefsson.org> (adding MARKS)
+;; Copyright (C) 1995-2014 Free Software Foundation, Inc.
+
+;; Author: Simon Josefsson <simon@josefsson.org>
 ;;      ShengHuo Zhu <zsh@cs.rochester.edu> (adding NOV)
 ;;      Scott Byer <byer@mv.us.adobe.com>
 ;;     Lars Magne Ingebrigtsen <larsi@gnus.org>
 
 ;; 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,9 +22,7 @@
 ;; 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:
 
@@ -39,9 +37,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)
 
   "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 +126,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))
-
 \f
 
 ;;; Interface functions
@@ -155,8 +133,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 +208,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 +233,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 +262,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 +331,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 +347,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 +400,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 +433,45 @@ the group.  Then the&nbs