Update copyright notices for 2013

[gnus] / lisp / gnus-cache.el

diff --git a/lisp/gnus-cache.el b/lisp/gnus-cache.el
index d8bdd35..b3cdb3b 100644 (file)
--- a/lisp/gnus-cache.el
+++ b/lisp/gnus-cache.el
@@ -1,16 +1,16 @@
 ;;; gnus-cache.el --- cache interface for Gnus
 ;;; gnus-cache.el --- cache interface for Gnus

-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003
-;;        Free Software Foundation, Inc.
+
+;; Copyright (C) 1995-2013 Free Software Foundation, Inc.

 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: news
 
 ;; This file is part of GNU Emacs.
 
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: news
 
 ;; 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
 ;; 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 Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of


@@ -18,24 +18,24 @@
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
 ;; 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:
 
 
 ;;; Commentary:
 
 ;;; Code:
 

+;; For Emacs <22.2 and XEmacs.
+(eval-and-compile
+  (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
+

 (eval-when-compile (require 'cl))
 
 (require 'gnus)
 (eval-when-compile (require 'cl))
 
 (require 'gnus)

-(require 'gnus-int)
-(require 'gnus-range)
-(require 'gnus-start)
+(require 'gnus-sum)
+

 (eval-when-compile
 (eval-when-compile

-  (if (not (fboundp 'gnus-agent-load-alist))
-      (defun gnus-agent-load-alist (group)))
-  (require 'gnus-sum))
+  (unless (fboundp 'gnus-agent-load-alist)
+    (defun gnus-agent-load-alist (group))))

 
 (defcustom gnus-cache-active-file
   (expand-file-name "active" gnus-cache-directory)
 
 (defcustom gnus-cache-active-file
   (expand-file-name "active" gnus-cache-directory)


@@ -91,10 +91,12 @@ it's not cached."
 (defvar gnus-cache-buffer nil)
 (defvar gnus-cache-active-hashtb nil)
 (defvar gnus-cache-active-altered nil)
 (defvar gnus-cache-buffer nil)
 (defvar gnus-cache-active-hashtb nil)
 (defvar gnus-cache-active-altered nil)

+(defvar gnus-cache-total-fetched-hashtb nil)

 
 

-(eval-and-compile
-  (autoload 'nnml-generate-nov-databases-1 "nnml")
-  (autoload 'nnvirtual-find-group-art "nnvirtual"))
+(declare-function nnvirtual-find-group-art "nnvirtual" (group article))
+
+(autoload 'nnml-generate-nov-databases-directory "nnml")
+(autoload 'nnvirtual-find-group-art "nnvirtual")

 
 \f
 
 
 \f
 


@@ -125,24 +127,27 @@ it's not cached."
          (overview-file (gnus-cache-file-name
                          (car gnus-cache-buffer) ".overview")))
       ;; write the overview only if it was modified
          (overview-file (gnus-cache-file-name
                          (car gnus-cache-buffer) ".overview")))
       ;; write the overview only if it was modified

-      (when (buffer-modified-p buffer)
-       (save-excursion
-         (set-buffer buffer)
+      (when (and (buffer-live-p buffer) (buffer-modified-p buffer))
+       (with-current-buffer buffer

          (if (> (buffer-size) 0)
              ;; Non-empty overview, write it to a file.
              (let ((coding-system-for-write
                     gnus-cache-overview-coding-system))
                (gnus-write-buffer overview-file))
          (if (> (buffer-size) 0)
              ;; Non-empty overview, write it to a file.
              (let ((coding-system-for-write
                     gnus-cache-overview-coding-system))
                (gnus-write-buffer overview-file))

-           ;; Empty overview file, remove it
-           (when (file-exists-p overview-file)
-             (delete-file overview-file))
-           ;; If possible, remove group's cache subdirectory.
-           (condition-case nil
-               ;; FIXME: we can detect the error type and warn the user
-               ;; of any inconsistencies (articles w/o nov entries?).
-               ;; for now, just be conservative...delete only if safe -- sj
-               (delete-directory (file-name-directory overview-file))
-             (error nil)))))
+           (let ((file-name-coding-system nnmail-pathname-coding-system))
+             ;; Empty overview file, remove it
+             (when (file-exists-p overview-file)
+               (delete-file overview-file))
+             ;; If possible, remove group's cache subdirectory.
+             (condition-case nil
+                 ;; FIXME: we can detect the error type and warn the user
+                 ;; of any inconsistencies (articles w/o nov entries?).
+                 ;; for now, just be conservative...delete only if safe -- sj
+                 (delete-directory (file-name-directory overview-file))
+               (error))))
+
+         (gnus-cache-update-overview-total-fetched-for
+          (car gnus-cache-buffer) overview-file)))

       ;; Kill the buffer -- it's either unmodified or saved.
       (gnus-kill-buffer buffer)
       (setq gnus-cache-buffer nil))))
       ;; Kill the buffer -- it's either unmodified or saved.
       (gnus-kill-buffer buffer)
       (setq gnus-cache-buffer nil))))


@@ -152,7 +157,9 @@ it's not cached."
   (when (and (or force (not (eq gnus-use-cache 'passive)))
             (numberp article)
             (> article 0))             ; This might be a dummy article.
   (when (and (or force (not (eq gnus-use-cache 'passive)))
             (numberp article)
             (> article 0))             ; This might be a dummy article.

-    (let ((number article) file headers)
+    (let ((number article)
+         file headers lines-chars
+         (file-name-coding-system nnmail-pathname-coding-system))

       ;; If this is a virtual group, we find the real group.
       (when (gnus-virtual-group-p group)
        (let ((result (nnvirtual-find-group-art
       ;; If this is a virtual group, we find the real group.
       (when (gnus-virtual-group-p group)
        (let ((result (nnvirtual-find-group-art


@@ -172,18 +179,21 @@ it's not cached."
        ;; Save the article in the cache.
        (if (file-exists-p file)
            t                           ; The article already is saved.
        ;; Save the article in the cache.
        (if (file-exists-p file)
            t                           ; The article already is saved.

-         (save-excursion
-           (set-buffer nntp-server-buffer)
+         (with-current-buffer nntp-server-buffer

            (require 'gnus-art)
            (let ((gnus-use-cache nil)
                  (gnus-article-decode-hook nil))
              (gnus-request-article-this-buffer number group))
            (when (> (buffer-size) 0)
              (let ((coding-system-for-write gnus-cache-coding-system))
            (require 'gnus-art)
            (let ((gnus-use-cache nil)
                  (gnus-article-decode-hook nil))
              (gnus-request-article-this-buffer number group))
            (when (> (buffer-size) 0)
              (let ((coding-system-for-write gnus-cache-coding-system))

-               (gnus-write-buffer file))
+               (gnus-write-buffer file)
+               (gnus-cache-update-file-total-fetched-for group file))
+             (setq lines-chars (nnheader-get-lines-and-char))

              (nnheader-remove-body)
              (setq headers (nnheader-parse-naked-head))
              (mail-header-set-number headers number)
              (nnheader-remove-body)
              (setq headers (nnheader-parse-naked-head))
              (mail-header-set-number headers number)

+             (mail-header-set-lines headers (car lines-chars))
+             (mail-header-set-chars headers (cadr lines-chars))

              (gnus-cache-change-buffer group)
              (set-buffer (cdr gnus-cache-buffer))
              (goto-char (point-max))
              (gnus-cache-change-buffer group)
              (set-buffer (cdr gnus-cache-buffer))
              (goto-char (point-max))


@@ -236,12 +246,10 @@ it's not cached."
 (defun gnus-cache-possibly-remove-articles-1 ()
   "Possibly remove some of the removable articles."
   (when (gnus-cache-fully-p gnus-newsgroup-name)
 (defun gnus-cache-possibly-remove-articles-1 ()
   "Possibly remove some of the removable articles."
   (when (gnus-cache-fully-p gnus-newsgroup-name)

-    (let ((articles gnus-cache-removable-articles)
-         (cache-articles gnus-newsgroup-cached)
-         article)
+    (let ((cache-articles gnus-newsgroup-cached))

       (gnus-cache-change-buffer gnus-newsgroup-name)
       (gnus-cache-change-buffer gnus-newsgroup-name)

-      (while articles
-       (when (memq (setq article (pop articles)) cache-articles)
+      (dolist (article gnus-cache-removable-articles)
+       (when (memq article cache-articles)

          ;; The article was in the cache, so we see whether we are
          ;; supposed to remove it from the cache.
          (gnus-cache-possibly-remove-article
          ;; The article was in the cache, so we see whether we are
          ;; supposed to remove it from the cache.
          (gnus-cache-possibly-remove-article


@@ -256,7 +264,8 @@ it's not cached."
 (defun gnus-cache-request-article (article group)
   "Retrieve ARTICLE in GROUP from the cache."
   (let ((file (gnus-cache-file-name group article))
 (defun gnus-cache-request-article (article group)
   "Retrieve ARTICLE in GROUP from the cache."
   (let ((file (gnus-cache-file-name group article))

-       (buffer-read-only nil))
+       (buffer-read-only nil)
+       (file-name-coding-system nnmail-pathname-coding-system))

     (when (file-exists-p file)
       (erase-buffer)
       (gnus-kill-all-overlays)
     (when (file-exists-p file)
       (erase-buffer)
       (gnus-kill-all-overlays)


@@ -285,7 +294,8 @@ it's not cached."
          (gnus-retrieve-headers articles group fetch-old))
       (let ((uncached-articles (gnus-sorted-difference articles cached))
            (cache-file (gnus-cache-file-name group ".overview"))
          (gnus-retrieve-headers articles group fetch-old))
       (let ((uncached-articles (gnus-sorted-difference articles cached))
            (cache-file (gnus-cache-file-name group ".overview"))

-           type)
+           type
+           (file-name-coding-system nnmail-pathname-coding-system))

        ;; We first retrieve all the headers that we don't have in
        ;; the cache.
        (let ((gnus-use-cache nil))
        ;; We first retrieve all the headers that we don't have in
        ;; the cache.
        (let ((gnus-use-cache nil))


@@ -325,9 +335,8 @@ it's not cached."
 If not given a prefix, use the process marked articles instead.
 Returns the list of articles entered."
   (interactive "P")
 If not given a prefix, use the process marked articles instead.
 Returns the list of articles entered."
   (interactive "P")

-  (let ((articles (gnus-summary-work-articles n))
-       article out)
-    (while (setq article (pop articles))
+  (let (out)
+    (dolist (article (gnus-summary-work-articles n))

       (gnus-summary-remove-process-mark article)
       (if (natnump article)
          (when (gnus-cache-possibly-enter-article
       (gnus-summary-remove-process-mark article)
       (if (natnump article)
          (when (gnus-cache-possibly-enter-article


@@ -348,17 +357,15 @@ If not given a prefix, use the process marked articles instead.
 Returns the list of articles removed."
   (interactive "P")
   (gnus-cache-change-buffer gnus-newsgroup-name)
 Returns the list of articles removed."
   (interactive "P")
   (gnus-cache-change-buffer gnus-newsgroup-name)

-  (let ((articles (gnus-summary-work-articles n))
-       article out)
-    (while articles
-      (setq article (pop articles))
+  (let (out)
+    (dolist (article (gnus-summary-work-articles n))

       (gnus-summary-remove-process-mark article)
       (when (gnus-cache-possibly-remove-article article nil nil nil t)
         (when gnus-newsgroup-agentized
           (let ((alist (gnus-agent-load-alist gnus-newsgroup-name)))
             (unless (cdr (assoc article alist))
               (setq gnus-newsgroup-undownloaded
       (gnus-summary-remove-process-mark article)
       (when (gnus-cache-possibly-remove-article article nil nil nil t)
         (when gnus-newsgroup-agentized
           (let ((alist (gnus-agent-load-alist gnus-newsgroup-name)))
             (unless (cdr (assoc article alist))
               (setq gnus-newsgroup-undownloaded

-                    (gnus-add-to-sorted-list 
+                    (gnus-add-to-sorted-list

                      gnus-newsgroup-undownloaded article)))))
        (push article out))
       (gnus-summary-update-download-mark article)
                      gnus-newsgroup-undownloaded article)))))
        (push article out))
       (gnus-summary-update-download-mark article)


@@ -375,9 +382,14 @@ Returns the list of articles removed."
   "Insert all the articles cached for this group into the current buffer."
   (interactive)
   (let ((gnus-verbose (max 6 gnus-verbose)))
   "Insert all the articles cached for this group into the current buffer."
   (interactive)
   (let ((gnus-verbose (max 6 gnus-verbose)))

-    (if (not gnus-newsgroup-cached)
-       (gnus-message 3 "No cached articles for this group")
-      (gnus-summary-goto-subjects gnus-newsgroup-cached))))
+    (cond
+     ((not gnus-newsgroup-cached)
+      (gnus-message 3 "No cached articles for this group"))
+     ;; This is faster if there are few articles to insert.
+     ((< (length gnus-newsgroup-cached) 20)
+      (gnus-summary-goto-subjects gnus-newsgroup-cached))
+     (t
+      (gnus-summary-include-articles gnus-newsgroup-cached)))))

 
 (defun gnus-summary-limit-include-cached ()
   "Limit the summary buffer to articles that are cached."
 
 (defun gnus-summary-limit-include-cached ()
   "Limit the summary buffer to articles that are cached."


@@ -407,7 +419,8 @@ Returns the list of articles removed."
                               " *gnus-cache-overview*"))))
       ;; Insert the contents of this group's cache overview.
       (erase-buffer)
                               " *gnus-cache-overview*"))))
       ;; Insert the contents of this group's cache overview.
       (erase-buffer)

-      (let ((file (gnus-cache-file-name group ".overview")))
+      (let ((file (gnus-cache-file-name group ".overview"))
+           (file-name-coding-system nnmail-pathname-coding-system))

        (when (file-exists-p file)
          (nnheader-insert-file-contents file)))
       ;; We have a fresh (empty/just loaded) buffer,
        (when (file-exists-p file)
          (nnheader-insert-file-contents file)))
       ;; We have a fresh (empty/just loaded) buffer,


@@ -421,7 +434,43 @@ Returns the list of articles removed."
       (and unread (memq 'unread class))
       (and (not unread) (not ticked) (not dormant) (memq 'read class))))
 
       (and unread (memq 'unread class))
       (and (not unread) (not ticked) (not dormant) (memq 'read class))))
 

+(defvar gnus-cache-decoded-group-names nil
+  "Alist of original group names and decoded group names.
+Decoding is done according to `gnus-group-name-charset-method-alist'
+or `gnus-group-name-charset-group-alist'.")
+
+(defvar gnus-cache-unified-group-names nil
+  "Alist of unified decoded group names and original group names.
+A group name is decoded according to
+`gnus-group-name-charset-method-alist' or
+`gnus-group-name-charset-group-alist' first, and is encoded and
+decoded again according to `nnmail-pathname-coding-system',
+`file-name-coding-system', or `default-file-name-coding-system'.
+
+It is used when asking for a original group name from a cache
+directory name, in which non-ASCII characters might have been unified
+into the ones of a certain charset particularly if the `utf-8' coding
+system for example was used.")
+
+(defun gnus-cache-decoded-group-name (group)
+  "Return a decoded group name of GROUP."
+  (or (cdr (assoc group gnus-cache-decoded-group-names))
+      (let ((decoded (gnus-group-decoded-name group))
+           (coding (or nnmail-pathname-coding-system
+                       (and (boundp 'file-name-coding-system)
+                            file-name-coding-system)
+                       (and (boundp 'default-file-name-coding-system)
+                            default-file-name-coding-system))))
+       (push (cons group decoded) gnus-cache-decoded-group-names)
+       (push (cons (mm-decode-coding-string
+                    (mm-encode-coding-string decoded coding)
+                    coding)
+                   group)
+             gnus-cache-unified-group-names)
+       decoded)))
+

 (defun gnus-cache-file-name (group article)
 (defun gnus-cache-file-name (group article)

+  (setq group (gnus-cache-decoded-group-name group))

   (expand-file-name
    (if (stringp article) article (int-to-string article))
    (file-name-as-directory
   (expand-file-name
    (if (stringp article) article (int-to-string article))
    (file-name-as-directory


@@ -454,7 +503,8 @@ Returns the list of articles removed."
   "Possibly remove ARTICLE from the cache."
   (let ((group gnus-newsgroup-name)
        (number article)
   "Possibly remove ARTICLE from the cache."
   (let ((group gnus-newsgroup-name)
        (number article)

-       file)
+       file
+       (file-name-coding-system nnmail-pathname-coding-system))

     ;; If this is a virtual group, we find the real group.
     (when (gnus-virtual-group-p group)
       (let ((result (nnvirtual-find-group-art
     ;; If this is a virtual group, we find the real group.
     (when (gnus-virtual-group-p group)
       (let ((result (nnvirtual-find-group-art


@@ -467,13 +517,15 @@ Returns the list of articles removed."
                   (gnus-cache-member-of-class
                    gnus-cache-remove-articles ticked dormant unread)))
       (save-excursion
                   (gnus-cache-member-of-class
                    gnus-cache-remove-articles ticked dormant unread)))
       (save-excursion

+       (gnus-cache-update-file-total-fetched-for group file t)

        (delete-file file)
        (delete-file file)

+

        (set-buffer (cdr gnus-cache-buffer))
        (goto-char (point-min))
        (when (or (looking-at (concat (int-to-string number) "\t"))
                  (search-forward (concat "\n" (int-to-string number) "\t")
                                  (point-max) t))
        (set-buffer (cdr gnus-cache-buffer))
        (goto-char (point-min))
        (when (or (looking-at (concat (int-to-string number) "\t"))
                  (search-forward (concat "\n" (int-to-string number) "\t")
                                  (point-max) t))

-         (gnus-delete-line)))
+           (gnus-delete-line)))

       (unless (setq gnus-newsgroup-cached
                    (delq article gnus-newsgroup-cached))
        (gnus-sethash gnus-newsgroup-name nil gnus-cache-active-hashtb)
       (unless (setq gnus-newsgroup-cached
                    (delq article gnus-newsgroup-cached))
        (gnus-sethash gnus-newsgroup-name nil gnus-cache-active-hashtb)


@@ -484,10 +536,11 @@ Returns the list of articles removed."
 (defun gnus-cache-articles-in-group (group)
   "Return a sorted list of cached articles in GROUP."
   (let ((dir (file-name-directory (gnus-cache-file-name group 1)))
 (defun gnus-cache-articles-in-group (group)
   "Return a sorted list of cached articles in GROUP."
   (let ((dir (file-name-directory (gnus-cache-file-name group 1)))

-       articles)
+       articles
+       (file-name-coding-system nnmail-pathname-coding-system))

     (when (file-exists-p dir)
       (setq articles
     (when (file-exists-p dir)
       (setq articles

-           (sort (mapcar (lambda (name) (string-to-int name))
+           (sort (mapcar (lambda (name) (string-to-number name))

                          (directory-files dir nil "^[0-9]+$" t))
                  '<))
       ;; Update the cache active file, just to synch more.
                          (directory-files dir nil "^[0-9]+$" t))
                  '<))
       ;; Update the cache active file, just to synch more.


@@ -504,11 +557,10 @@ Returns the list of articles removed."
   (let ((cache-buf (gnus-get-buffer-create " *gnus-cache*"))
        beg end)
     (gnus-cache-save-buffers)
   (let ((cache-buf (gnus-get-buffer-create " *gnus-cache*"))
        beg end)
     (gnus-cache-save-buffers)

-    (save-excursion
-      (set-buffer cache-buf)
+    (with-current-buffer cache-buf

       (erase-buffer)
       (erase-buffer)

-      (let ((coding-system-for-read
-            gnus-cache-overview-coding-system))
+      (let ((coding-system-for-read gnus-cache-overview-coding-system)
+           (file-name-coding-system nnmail-pathname-coding-system))

        (insert-file-contents
         (or file (gnus-cache-file-name group ".overview"))))
       (goto-char (point-min))
        (insert-file-contents
         (or file (gnus-cache-file-name group ".overview"))))
       (goto-char (point-min))


@@ -524,7 +576,7 @@ Returns the list of articles removed."
       (set-buffer cache-buf)
       (if (search-forward (concat "\n" (int-to-string (car cached)) "\t")
                          nil t)
       (set-buffer cache-buf)
       (if (search-forward (concat "\n" (int-to-string (car cached)) "\t")
                          nil t)

-         (setq beg (gnus-point-at-bol)
+         (setq beg (point-at-bol)

                end (progn (end-of-line) (point)))
        (setq beg nil))
       (set-buffer nntp-server-buffer)
                end (progn (end-of-line) (point)))
        (setq beg nil))
       (set-buffer nntp-server-buffer)


@@ -536,35 +588,33 @@ Returns the list of articles removed."
 
 (defun gnus-cache-braid-heads (group cached)
   (let ((cache-buf (gnus-get-buffer-create " *gnus-cache*")))
 
 (defun gnus-cache-braid-heads (group cached)
   (let ((cache-buf (gnus-get-buffer-create " *gnus-cache*")))

-    (save-excursion
-      (set-buffer cache-buf)
+    (with-current-buffer cache-buf

       (erase-buffer))
     (set-buffer nntp-server-buffer)
     (goto-char (point-min))
       (erase-buffer))
     (set-buffer nntp-server-buffer)
     (goto-char (point-min))

-    (while cached
+    (dolist (entry cached)

       (while (and (not (eobp))
                  (looking-at "2.. +\\([0-9]+\\) ")
                  (< (progn (goto-char (match-beginning 1))
                            (read (current-buffer)))
       (while (and (not (eobp))
                  (looking-at "2.. +\\([0-9]+\\) ")
                  (< (progn (goto-char (match-beginning 1))
                            (read (current-buffer)))

-                    (car cached)))
+                    entry))

        (search-forward "\n.\n" nil 'move))
       (beginning-of-line)
       (set-buffer cache-buf)
       (erase-buffer)
        (search-forward "\n.\n" nil 'move))
       (beginning-of-line)
       (set-buffer cache-buf)
       (erase-buffer)

-      (let ((coding-system-for-read
-            gnus-cache-coding-system))
-       (insert-file-contents (gnus-cache-file-name group (car cached))))
+      (let ((coding-system-for-read gnus-cache-coding-system)
+           (file-name-coding-system nnmail-pathname-coding-system))
+       (insert-file-contents (gnus-cache-file-name group entry)))

       (goto-char (point-min))
       (insert "220 ")
       (goto-char (point-min))
       (insert "220 ")

-      (princ (car cached) (current-buffer))
+      (princ (pop cached) (current-buffer))

       (insert " Article retrieved.\n")
       (search-forward "\n\n" nil 'move)
       (delete-region (point) (point-max))
       (forward-char -1)
       (insert ".")
       (set-buffer nntp-server-buffer)
       (insert " Article retrieved.\n")
       (search-forward "\n\n" nil 'move)
       (delete-region (point) (point-max))
       (forward-char -1)
       (insert ".")
       (set-buffer nntp-server-buffer)

-      (insert-buffer-substring cache-buf)
-      (setq cached (cdr cached)))
+      (insert-buffer-substring cache-buf))

     (kill-buffer cache-buf)))
 
 ;;;###autoload
     (kill-buffer cache-buf)))
 
 ;;;###autoload


@@ -576,7 +626,6 @@ $ emacs -batch -l ~/.emacs -l gnus -f gnus-jog-cache"
   (interactive)
   (let ((gnus-mark-article-hook nil)
        (gnus-expert-user t)
   (interactive)
   (let ((gnus-mark-article-hook nil)
        (gnus-expert-user t)

-       (nnmail-spool-file nil)

        (mail-sources nil)
        (gnus-use-dribble-file nil)
        (gnus-novice-user nil)
        (mail-sources nil)
        (gnus-use-dribble-file nil)
        (gnus-novice-user nil)


@@ -660,6 +709,7 @@ If LOW, update the lower bound instead."
   (interactive)
   (let* ((top (null directory))
         (directory (expand-file-name (or directory gnus-cache-directory)))
   (interactive)
   (let* ((top (null directory))
         (directory (expand-file-name (or directory gnus-cache-directory)))

+        (file-name-coding-system nnmail-pathname-coding-system)

         (files (directory-files directory 'full))
         (group
          (if top
         (files (directory-files directory 'full))
         (group
          (if top


@@ -681,20 +731,25 @@ If LOW, update the lower bound instead."
     ;; Separate articles from all other files and directories.
     (while files
       (if (string-match "^[0-9]+$" (file-name-nondirectory (car files)))
     ;; Separate articles from all other files and directories.
     (while files
       (if (string-match "^[0-9]+$" (file-name-nondirectory (car files)))

-         (push (string-to-int (file-name-nondirectory (pop files))) nums)
+         (push (string-to-number (file-name-nondirectory (pop files))) nums)

        (push (pop files) alphs)))
     ;; If we have nums, then this is probably a valid group.
     (when (setq nums (sort nums '<))
        (push (pop files) alphs)))
     ;; If we have nums, then this is probably a valid group.
     (when (setq nums (sort nums '<))

-      (gnus-sethash group (cons (car nums) (gnus-last-element nums))
+      ;; Use non-decoded group name.
+      ;; FIXME: this is kind of a workaround.  The active file should
+      ;; be updated at the time articles are cached.  It will make
+      ;; `gnus-cache-unified-group-names' needless.
+      (gnus-sethash (or (cdr (assoc group gnus-cache-unified-group-names))
+                       group)
+                   (cons (car nums) (gnus-last-element nums))

                    gnus-cache-active-hashtb))
     ;; Go through all the other files.
                    gnus-cache-active-hashtb))
     ;; Go through all the other files.

-    (while alphs
-      (when (and (file-directory-p (car alphs))
+    (dolist (file alphs)
+      (when (and (file-directory-p file)

                 (not (string-match "^\\."
                 (not (string-match "^\\."

-                                   (file-name-nondirectory (car alphs)))))
+                                   (file-name-nondirectory file))))

        ;; We descend directories.
        ;; We descend directories.

-       (gnus-cache-generate-active (car alphs)))
-      (setq alphs (cdr alphs)))
+       (gnus-cache-generate-active file)))

     ;; Write the new active file.
     (when top
       (gnus-cache-write-active t)
     ;; Write the new active file.
     (when top
       (gnus-cache-write-active t)


@@ -706,7 +761,10 @@ If LOW, update the lower bound instead."
   (interactive (list gnus-cache-directory))
   (gnus-cache-close)
   (let ((nnml-generate-active-function 'identity))
   (interactive (list gnus-cache-directory))
   (gnus-cache-close)
   (let ((nnml-generate-active-function 'identity))

-    (nnml-generate-nov-databases-1 dir))
+    (nnml-generate-nov-databases-directory dir))
+
+  (setq gnus-cache-total-fetched-hashtb nil)
+

   (gnus-cache-open))
 
 (defun gnus-cache-move-cache (dir)
   (gnus-cache-open))
 
 (defun gnus-cache-move-cache (dir)


@@ -727,6 +785,137 @@ If GROUP is non-nil, also cater to `gnus-cacheable-groups' and
              (or (not gnus-uncacheable-groups)
                  (not (string-match gnus-uncacheable-groups group)))))))
 
              (or (not gnus-uncacheable-groups)
                  (not (string-match gnus-uncacheable-groups group)))))))
 

+;;;###autoload
+(defun gnus-cache-rename-group (old-group new-group)
+  "Rename OLD-GROUP as NEW-GROUP.
+Always updates the cache, even when disabled, as the old cache
+files would corrupt Gnus when the cache was next enabled.  It
+depends on the caller to determine whether group renaming is
+supported."
+  (let ((old-dir (gnus-cache-file-name old-group ""))
+       (new-dir (gnus-cache-file-name new-group ""))
+       (file-name-coding-system nnmail-pathname-coding-system))
+    (gnus-rename-file old-dir new-dir t))
+
+  (gnus-cache-rename-group-total-fetched-for old-group new-group)
+
+  (let ((no-save gnus-cache-active-hashtb))
+    (unless gnus-cache-active-hashtb
+      (gnus-cache-read-active))
+    (let* ((old-group-hash-value
+           (gnus-gethash old-group gnus-cache-active-hashtb))
+          (new-group-hash-value
+           (gnus-gethash new-group gnus-cache-active-hashtb))
+          (delta
+           (or old-group-hash-value new-group-hash-value)))
+      (gnus-sethash new-group old-group-hash-value gnus-cache-active-hashtb)
+      (gnus-sethash old-group nil gnus-cache-active-hashtb)
+
+      (if no-save
+         (setq gnus-cache-active-altered delta)
+       (gnus-cache-write-active delta)))))
+
+;;;###autoload
+(defun gnus-cache-delete-group (group)
+  "Delete GROUP from the cache.
+Always updates the cache, even when disabled, as the old cache
+files would corrupt gnus when the cache was next enabled.
+Depends upon the caller to determine whether group deletion is
+supported."
+  (let ((dir (gnus-cache-file-name group ""))
+       (file-name-coding-system nnmail-pathname-coding-system))
+    (gnus-delete-directory dir))
+
+  (gnus-cache-delete-group-total-fetched-for group)
+
+  (let ((no-save gnus-cache-active-hashtb))
+    (unless gnus-cache-active-hashtb
+      (gnus-cache-read-active))
+    (let* ((group-hash-value (gnus-gethash group gnus-cache-active-hashtb)))
+      (gnus-sethash group nil gnus-cache-active-hashtb)
+
+      (if no-save
+         (setq gnus-cache-active-altered group-hash-value)
+       (gnus-cache-write-active group-hash-value)))))
+
+(defvar gnus-cache-inhibit-update-total-fetched-for nil)
+(defvar gnus-cache-need-update-total-fetched-for nil)
+
+(defmacro gnus-cache-with-refreshed-group (group &rest body)
+  `(prog1 (let ((gnus-cache-inhibit-update-total-fetched-for t))
+           ,@body)
+     (when (and gnus-cache-need-update-total-fetched-for
+               (not gnus-cache-inhibit-update-total-fetched-for))
+       (with-current-buffer gnus-group-buffer
+         (setq gnus-cache-need-update-total-fetched-for nil)
+         (gnus-group-update-group ,group t)))))
+
+(defun gnus-cache-update-file-total-fetched-for (group file &optional subtract)
+  (when gnus-cache-total-fetched-hashtb
+    (gnus-cache-with-refreshed-group
+     group
+     (let* ((entry (or (gnus-gethash group gnus-cache-total-fetched-hashtb)
+                      (gnus-sethash group (make-vector 2 0)
+                                    gnus-cache-total-fetched-hashtb)))
+           size)
+
+       (if file
+          (setq size (or (nth 7 (file-attributes file)) 0))
+        (let* ((file-name-coding-system nnmail-pathname-coding-system)
+               (files (directory-files (gnus-cache-file-name group "")
+                                       t nil t))
+               file attrs)
+          (setq size 0.0)
+          (while (setq file (pop files))
+            (setq attrs (file-attributes file))
+            (unless (nth 0 attrs)
+              (incf size (float (nth 7 attrs)))))))
+
+       (setq gnus-cache-need-update-total-fetched-for t)
+
+       (incf (nth 1 entry) (if subtract (- size) size))))))
+
+(defun gnus-cache-update-overview-total-fetched-for (group file)
+  (when gnus-cache-total-fetched-hashtb
+    (gnus-cache-with-refreshed-group
+     group
+     (let* ((entry (or (gnus-gethash group gnus-cache-total-fetched-hashtb)
+                      (gnus-sethash group (make-list 2 0)
+                                    gnus-cache-total-fetched-hashtb)))
+           (file-name-coding-system nnmail-pathname-coding-system)
+           (size (or (nth 7 (file-attributes
+                             (or file
+                                 (gnus-cache-file-name group ".overview"))))
+                     0)))
+       (setq gnus-cache-need-update-total-fetched-for t)
+       (setf (nth 0 entry) size)))))
+
+(defun gnus-cache-rename-group-total-fetched-for (old-group new-group)
+  "Record of disk space used by OLD-GROUP now associated with NEW-GROUP."
+  (when gnus-cache-total-fetched-hashtb
+    (let ((entry (gnus-gethash old-group gnus-cache-total-fetched-hashtb)))
+      (gnus-sethash new-group entry gnus-cache-total-fetched-hashtb)
+      (gnus-sethash old-group nil gnus-cache-total-fetched-hashtb))))
+
+(defun gnus-cache-delete-group-total-fetched-for (group)
+  "Delete record of disk space used by GROUP being deleted."
+  (when gnus-cache-total-fetched-hashtb
+      (gnus-sethash group nil gnus-cache-total-fetched-hashtb)))
+
+(defun gnus-cache-total-fetched-for (group &optional no-inhibit)
+  "Get total disk space used by the cache for the specified GROUP."
+  (unless (equal group "dummy.group")
+    (unless gnus-cache-total-fetched-hashtb
+      (setq gnus-cache-total-fetched-hashtb (gnus-make-hashtable 1024)))
+
+    (let* ((entry (gnus-gethash group gnus-cache-total-fetched-hashtb)))
+      (if entry
+         (apply '+ entry)
+       (let ((gnus-cache-inhibit-update-total-fetched-for (not no-inhibit)))
+         (+
+          (gnus-cache-update-overview-total-fetched-for group nil)
+          (gnus-cache-update-file-total-fetched-for     group nil)))))))
+

 (provide 'gnus-cache)
 
 ;;; gnus-cache.el ends here
 (provide 'gnus-cache)
 
 ;;; gnus-cache.el ends here