X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;ds=sidebyside;f=lisp%2Fgnus-cache.el;h=ef82715fd632ed803abb628760fd19659bbb4f2d;hb=3c6a96d019e0fcdf0d35f9d4873f62c1962995ad;hp=b22cd2f8de1134e045c69ff1a95337550d0ddc53;hpb=d14bd1a9c69a77dfcb3c52b9960cf1d73610f9ed;p=elisp%2Fgnus.git- diff --git a/lisp/gnus-cache.el b/lisp/gnus-cache.el index b22cd2f..ef82715 100644 --- 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 ;; Tatsuya Ichikawa @@ -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.") @@ -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)))