X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-cache.el;h=befdb5c40b003964407860f5fec3c8081b52e01d;hb=e5bec5d05f433a43fa2d14cdb7bebeeefab8835f;hp=4916331e5ef39825c59ea7db0abde3aa2ecdd1bb;hpb=a707b63af25b91cb730c12e65156ca364bf49a44;p=elisp%2Fgnus.git- diff --git a/lisp/gnus-cache.el b/lisp/gnus-cache.el index 4916331..befdb5c 100644 --- a/lisp/gnus-cache.el +++ b/lisp/gnus-cache.el @@ -3,6 +3,8 @@ ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen +;; Tatsuya Ichikawa +;; MORIOKA Tomohiko ;; Keywords: news ;; This file is part of GNU Emacs. @@ -27,6 +29,7 @@ ;;; Code: (eval-when-compile (require 'cl)) +(eval-when-compile (require 'gnus-clfns)) (require 'gnus) (require 'gnus-int) @@ -89,6 +92,7 @@ it's not cached." (defvar gnus-cache-buffer nil) (defvar gnus-cache-active-hashtb nil) (defvar gnus-cache-active-altered nil) +(defvar gnus-cache-write-file-coding-system 'raw-text) (eval-and-compile (autoload 'nnml-generate-nov-databases-1 "nnml") @@ -128,9 +132,8 @@ it's not cached." (set-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)) + (gnus-write-buffer-as-coding-system + gnus-cache-overview-coding-system overview-file) ;; Empty overview file, remove it (when (file-exists-p overview-file) (delete-file overview-file)) @@ -146,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 @@ -181,8 +185,8 @@ it's not cached." (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-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) @@ -260,8 +264,8 @@ it's not cached." (when (file-exists-p file) (erase-buffer) (gnus-kill-all-overlays) - (let ((coding-system-for-read gnus-cache-coding-system)) - (insert-file-contents file)) + (let ((nnheader-file-coding-system gnus-cache-coding-system)) + (nnheader-insert-file-contents file)) t))) (defun gnus-cache-possibly-alter-active (group active) @@ -307,9 +311,9 @@ it's not cached." ;; unsuccessful), so we use the cached headers exclusively. (set-buffer nntp-server-buffer) (erase-buffer) - (let ((coding-system-for-read + (let ((nnheader-file-coding-system gnus-cache-overview-coding-system)) - (insert-file-contents cache-file)) + (nnheader-insert-file-contents cache-file)) 'nov) ((eq type 'nov) ;; We have both cached and uncached NOV headers, so we @@ -322,6 +326,65 @@ it's not cached." cached articles)) type))))))) +(defun gnus-cache-retrieve-parsed-headers (articles group &optional fetch-old + dependencies force-new) + "Retrieve the parsed-headers for ARTICLES in GROUP." + (let ((cached + (setq gnus-newsgroup-cached (gnus-cache-articles-in-group group)))) + (if (not cached) + ;; No cached articles here, so we just retrieve them + ;; the normal way. + (let ((gnus-use-cache nil)) + (gnus-retrieve-parsed-headers articles group fetch-old + dependencies force-new)) + (let ((uncached-articles (gnus-sorted-intersection + (gnus-sorted-complement articles cached) + articles)) + (cache-file (gnus-cache-file-name group ".overview"))) + (gnus-cache-braid-headers + ;; We first retrieve all the headers that we don't have in + ;; the cache. + (prog1 + (let ((gnus-use-cache nil)) + (when uncached-articles + (and articles + (gnus-retrieve-parsed-headers + uncached-articles group fetch-old + dependencies)) + )) + (gnus-cache-save-buffers)) + ;; Then we insert the cached headers. + (cond ((not (file-exists-p cache-file)) + ;; There are no cached headers. + ) + ((eq gnus-headers-retrieved-by 'nov) + (with-current-buffer nntp-server-buffer + (erase-buffer) + (nnheader-insert-file-contents cache-file) + (nnheader-get-newsgroup-headers-xover* + articles nil dependencies group) + )) + (t + ;; We braid HEADs. + (nnheader-retrieve-headers-from-directory* + cached + (expand-file-name + (file-name-as-directory + (nnheader-translate-file-chars + (if (gnus-use-long-file-name 'not-cache) + group + (let ((group + (nnheader-replace-chars-in-string group ?/ ?_))) + ;; Translate the first colon into a slash. + (when (string-match ":" group) + (aset group (match-beginning 0) ?/)) + (nnheader-replace-chars-in-string group ?. ?/))) + t)) + gnus-cache-directory) + dependencies) + ))) + )))) + (defun gnus-cache-enter-article (&optional n) "Enter the next N articles into the cache. If not given a prefix, use the process marked articles instead. @@ -334,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)) @@ -434,7 +498,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 @@ -490,9 +554,8 @@ Returns the list of articles removed." (save-excursion (set-buffer cache-buf) (erase-buffer) - (let ((coding-system-for-read - gnus-cache-overview-coding-system)) - (insert-file-contents + (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") @@ -535,9 +598,9 @@ Returns the list of articles removed." (save-excursion (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 ((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)) @@ -550,6 +613,36 @@ Returns the list of articles removed." (setq cached (cdr cached))) (kill-buffer cache-buf))) +(defun gnus-cache-braid-headers (headers cached-headers) + (if cached-headers + (if headers + (let (cached-header hrest nhrest) + (nconc (catch 'tag + (while cached-headers + (setq cached-header (car cached-headers)) + (if (< (mail-header-number cached-header) + (mail-header-number (car headers))) + (throw 'tag (nreverse cached-headers)) + (setq hrest headers + nhrest (cdr hrest)) + (while (and nhrest + (> (mail-header-number cached-header) + (mail-header-number (car nhrest)))) + (setq hrest nhrest + nhrest (cdr nhrest)) + ) + ;;(if nhrest + (setcdr hrest (cons cached-header nhrest)) + ;; (setq headers + ;; (nconc headers (list cached-header))) + ;; (throw 'tag nil) + ;;) + ) + (setq cached-headers (cdr cached-headers)))) + headers)) + (nreverse cached-headers)) + headers)) + ;;;###autoload (defun gnus-jog-cache () "Go through all groups and put the articles into the cache.