;;; 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>
+;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
;; Keywords: news
;; This file is part of GNU Emacs.
(defvar gnus-cache-overview-coding-system 'raw-text
"Coding system used on Gnus cache files.")
+(defvar gnus-cache-coding-system 'binary
+ "Coding system used on Gnus cache files.")
+
\f
;;; Internal variables.
(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))
(gnus-article-decode-hook nil))
(gnus-request-article-this-buffer number group))
(when (> (buffer-size) 0)
- (let ((coding-system-for-write
- gnus-cache-write-file-coding-system))
- (gnus-write-buffer file))
+ (gnus-write-buffer-as-coding-system
+ gnus-cache-write-file-coding-system file)
(gnus-cache-change-buffer group)
(set-buffer (cdr gnus-cache-buffer))
(goto-char (point-max))
(beginning-of-line))
(forward-line 1))
(beginning-of-line)
- ;; [number subject from date id references chars lines xref]
- (insert (format "%s\t%s\t%s\t%s\t%s\t%s\t%s\t%s\t%s\t\n"
- (mail-header-number headers)
- (let ((subject (mail-header-subject headers)))
- (or (get-text-property 0 'raw-text subject)
- subject))
- (let ((from (mail-header-from headers)))
- (or (get-text-property 0 'raw-text from)
- from))
- (mail-header-date headers)
- (mail-header-id headers)
- (or (mail-header-references headers) "")
- (or (mail-header-chars headers) "")
- (or (mail-header-lines headers) "")
- (or (mail-header-xref headers) "")))
+ (nnheader-insert-nov headers)
;; Update the active info.
(set-buffer gnus-summary-buffer)
(gnus-cache-update-active group number)
(when (file-exists-p file)
(erase-buffer)
(gnus-kill-all-overlays)
- (nnheader-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)
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.
(cons group
(set-buffer (gnus-get-buffer-create
" *gnus-cache-overview*"))))
- (buffer-disable-undo (current-buffer))
;; Insert the contents of this group's cache overview.
(erase-buffer)
(let ((file (gnus-cache-file-name group ".overview")))
(defun gnus-cache-update-article (group article)
"If ARTICLE is in the cache, remove it and re-enter it."
(gnus-cache-change-buffer group)
- (when (gnus-cache-possibly-remove-article article nil nil nil t)
+ (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-summary-article-header article)
(gnus-cache-save-buffers)
(save-excursion
(set-buffer cache-buf)
- (buffer-disable-undo (current-buffer))
(erase-buffer)
(nnheader-insert-file-contents (or file (gnus-cache-file-name group ".overview")))
(goto-char (point-min))
(let ((cache-buf (gnus-get-buffer-create " *gnus-cache*")))
(save-excursion
(set-buffer cache-buf)
- (buffer-disable-undo (current-buffer))
(erase-buffer))
(set-buffer nntp-server-buffer)
(goto-char (point-min))
(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)
(when top
(gnus-message 5 "Generating the cache active file...")
(setq gnus-cache-active-hashtb (gnus-make-hashtable 123)))
+ (when (string-match "^\\(nn[^_]+\\)_" group)
+ (setq group (replace-match "\\1:" t t group)))
;; Separate articles from all other files and directories.
(while files
(if (string-match "^[0-9]+$" (file-name-nondirectory (car files)))
;; Go through all the other files.
(while alphs
(when (and (file-directory-p (car alphs))
- (not (string-match "^\\.\\.?$"
+ (not (string-match "^\\."
(file-name-nondirectory (car alphs)))))
;; We descend directories.
(gnus-cache-generate-active (car alphs)))
projects / elisp / gnus.git- / blobdiff