T-gnus 6.14.3.

[elisp/gnus.git-] / lisp / gnus-cache.el

diff --git a/lisp/gnus-cache.el b/lisp/gnus-cache.el
index b22cd2f..ef82715 100644 (file)
--- a/lisp/gnus-cache.el
+++ b/lisp/gnus-cache.el
@@ -1,5 +1,6 @@
 ;;; gnus-cache.el --- cache interface for Gnus
-;; Copyright (C) 1995,96,97,98,99 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000
+;;        Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;;         Tatsuya Ichikawa <t-ichi@po.shiojiri.ne.jp>
@@ -28,6 +29,7 @@
 ;;; Code:
 
 (eval-when-compile (require 'cl))
+(eval-when-compile (require 'gnus-clfns))
 
 (require 'gnus)
 (require 'gnus-int)
@@ -62,7 +64,7 @@ If a group matches both gnus-cacheable-groups and gnus-uncacheable-groups
 it's not cached."
   :group 'gnus-cache
   :type '(choice (const :tag "off" nil)
-                regexp))
+                regexp))
 
 (defcustom gnus-uncacheable-groups nil
   "*Groups that match this regexp will not be cached.
@@ -79,7 +81,7 @@ it's not cached."
 (defvar gnus-cache-overview-coding-system 'raw-text
   "Coding system used on Gnus cache files.")
 
-(defvar gnus-cache-coding-system 'binary
+(defvar gnus-cache-coding-system 'raw-text
   "Coding system used on Gnus cache files.")
 
 \f
@@ -147,11 +149,12 @@ it's not cached."
       (setq gnus-cache-buffer nil))))
 
 (defun gnus-cache-possibly-enter-article
-  (group article ticked dormant unread &optional force)
+  (group article headers ticked dormant unread &optional force)
   (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)
+            (> article 0)
+            (vectorp headers))         ; This might be a dummy article.
+    (let ((number article) file)
       ;; If this is a virtual group, we find the real group.
       (when (gnus-virtual-group-p group)
        (let ((result (nnvirtual-find-group-art
@@ -177,12 +180,15 @@ it's not cached."
            t                           ; The article already is saved.
          (save-excursion
            (set-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)
              (gnus-write-buffer-as-coding-system
               gnus-cache-write-file-coding-system file)
+             (setq headers (nnheader-parse-head t))
+             (mail-header-set-number headers number)
              (gnus-cache-change-buffer group)
              (set-buffer (cdr gnus-cache-buffer))
              (goto-char (point-max))
@@ -305,7 +311,9 @@ it's not cached."
            ;; unsuccessful), so we use the cached headers exclusively.
            (set-buffer nntp-server-buffer)
            (erase-buffer)
-           (nnheader-insert-file-contents cache-file)
+           (let ((nnheader-file-coding-system
+                  gnus-cache-overview-coding-system))
+             (nnheader-insert-file-contents cache-file))
            'nov)
           ((eq type 'nov)
            ;; We have both cached and uncached NOV headers, so we
@@ -389,6 +397,7 @@ Returns the list of articles entered."
       (if (natnump article)
          (when (gnus-cache-possibly-enter-article
                 gnus-newsgroup-name article
+                (gnus-summary-article-header article)
                 nil nil nil t)
            (push article out))
        (gnus-message 2 "Can't cache article %d" article))
@@ -422,7 +431,7 @@ Returns the list of articles removed."
 (defun gnus-summary-insert-cached-articles ()
   "Insert all the articles cached for this group into the current buffer."
   (interactive)
-  (let ((cached (sort (copy-sequence gnus-newsgroup-cached) '<))
+  (let ((cached (sort (copy-sequence gnus-newsgroup-cached) '>))
        (gnus-verbose (max 6 gnus-verbose)))
     (unless cached
       (gnus-message 3 "No cached articles for this group"))
@@ -470,7 +479,9 @@ Returns the list of articles removed."
           (nnheader-translate-file-chars
            (if (gnus-use-long-file-name 'not-cache)
                group
-             (let ((group (nnheader-replace-chars-in-string group ?/ ?_)))
+             (let ((group (nnheader-replace-duplicate-chars-in-string
+                           (nnheader-replace-chars-in-string group ?/ ?_)
+                           ?. ?_)))
                ;; Translate the first colon into a slash.
                (when (string-match ":" group)
                  (aset group (match-beginning 0) ?/))
@@ -484,7 +495,7 @@ Returns the list of articles removed."
   (when (gnus-cache-possibly-remove-article article nil nil nil t)
     (let ((gnus-use-cache nil))
       (gnus-cache-possibly-enter-article
-       gnus-newsgroup-name article
+       gnus-newsgroup-name article (gnus-summary-article-header article)
        nil nil nil t))))
 
 (defun gnus-cache-possibly-remove-article (article ticked dormant unread
@@ -540,7 +551,9 @@ Returns the list of articles removed."
     (save-excursion
       (set-buffer cache-buf)
       (erase-buffer)
-      (nnheader-insert-file-contents (or file (gnus-cache-file-name group ".overview")))
+      (let ((nnheader-file-coding-system gnus-cache-overview-coding-system))
+       (nnheader-insert-file-contents
+        (or file (gnus-cache-file-name group ".overview"))))
       (goto-char (point-min))
       (insert "\n")
       (goto-char (point-min)))
@@ -582,7 +595,9 @@ Returns the list of articles removed."
       (save-excursion
        (set-buffer cache-buf)
        (erase-buffer)
-       (nnheader-insert-file-contents (gnus-cache-file-name group (car cached)))
+       (let ((nnheader-file-coding-system gnus-cache-coding-system))
+         (nnheader-insert-file-contents
+          (gnus-cache-file-name group (car cached))))
        (goto-char (point-min))
        (insert "220 ")
        (princ (car cached) (current-buffer))
@@ -675,14 +690,9 @@ $ emacs -batch -l ~/.emacs -l gnus -f gnus-jog-cache"
   (when (or force
            (and gnus-cache-active-hashtb
                 gnus-cache-active-altered))
-    (with-temp-file gnus-cache-active-file
-      (mapatoms
-       (lambda (sym)
-        (when (and sym (boundp sym))
-          (insert (format "%s %d %d y\n"
-                          (symbol-name sym) (cdr (symbol-value sym))
-                          (car (symbol-value sym))))))
-       gnus-cache-active-hashtb))
+    (gnus-write-active-file-as-coding-system
+     gnus-cache-write-file-coding-system
+     gnus-cache-active-file gnus-cache-active-hashtb t)
     ;; Mark the active hashtb as unaltered.
     (setq gnus-cache-active-altered nil)))