;;; gnus-cache.el --- cache interface for Gnus
-;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc.
+;; Copyright (C) 1995,96,97,98,99 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; Tatsuya Ichikawa <t-ichi@po.shiojiri.ne.jp>
+;; Tatsuya Ichikawa <t-ichi@po.shiojiri.ne.jp>
+;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
;; Keywords: news
;; This file is part of GNU Emacs.
(if (> (buffer-size) 0)
;; Non-empty overview, write it to a file.
(gnus-write-buffer-as-coding-system
- overview-file gnus-cache-overview-coding-system)
+ gnus-cache-overview-coding-system overview-file)
;; Empty overview file, remove it
(when (file-exists-p overview-file)
(delete-file overview-file))
(numberp article)
(> article 0)
(vectorp headers)) ; This might be a dummy article.
- ;; If this is a virtual group, we find the real group.
- (when (gnus-virtual-group-p group)
- (let ((result (nnvirtual-find-group-art
- (gnus-group-real-name group) article)))
- (setq group (car result)
- headers (copy-sequence headers))
- (mail-header-set-number headers (cdr result))))
- (let ((number (mail-header-number headers))
- file)
+ (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
+ (gnus-group-real-name group) article)))
+ (setq group (car result)
+ number (cdr result))))
(when (and number
(> number 0) ; Reffed article.
(or force
(gnus-request-article-this-buffer number group))
(when (> (buffer-size) 0)
(gnus-write-buffer-as-coding-system
- file gnus-cache-write-file-coding-system)
+ gnus-cache-write-file-coding-system file)
(gnus-cache-change-buffer group)
(set-buffer (cdr gnus-cache-buffer))
(goto-char (point-max))
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.
(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.
"Read the cache active file."
(gnus-make-directory gnus-cache-directory)
(if (or (not (file-exists-p gnus-cache-active-file))
- (not (zerop (nth 7 (file-attributes gnus-cache-active-file))))
+ (zerop (nth 7 (file-attributes gnus-cache-active-file)))
force)
;; There is no active file, so we generate one.
(gnus-cache-generate-active)