-;;; gnus-cache.el --- cache interface for Gnus
-;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc.
+;;; gnus-cache.el --- cache interface for Chaos
+;; Copyright (C) 1995,96,97,98,99 Free Software Foundation, Inc.
-;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
+;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
;; Keywords: news
;; This file is part of GNU Emacs.
:group 'gnus-cache
:type '(set (const ticked) (const dormant) (const unread) (const read)))
+(defcustom gnus-cacheable-groups nil
+ "*Groups that match this regexp will be cached.
+
+If you only want to cache your nntp groups, you could set this
+variable to \"^nntp\".
+
+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))
+
(defcustom gnus-uncacheable-groups nil
"*Groups that match this regexp will not be cached.
If you want to avoid caching your nnml groups, you could set this
-variable to \"^nnml\"."
+variable to \"^nnml\".
+
+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))
+(defvar gnus-cache-overview-coding-system 'raw-text
+ "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.
- (gnus-write-buffer overview-file)
+ (let ((coding-system-for-write
+ gnus-cache-overview-coding-system))
+ (gnus-write-buffer overview-file))
;; Empty overview file, remove it
(when (file-exists-p overview-file)
(delete-file overview-file))
headers (copy-sequence headers))
(mail-header-set-number headers (cdr result))))
(let ((number (mail-header-number headers))
- file dir)
+ file)
(when (and number
(> number 0) ; Reffed article.
(or force
- (and (or (not gnus-uncacheable-groups)
+ (and (or (not gnus-cacheable-groups)
+ (string-match gnus-cacheable-groups group))
+ (or (not gnus-uncacheable-groups)
(not (string-match
gnus-uncacheable-groups group)))
(gnus-cache-member-of-class
(not (file-exists-p (setq file (gnus-cache-file-name
group number)))))
;; Possibly create the cache directory.
- (gnus-make-directory (setq dir (file-name-directory file)))
+ (gnus-make-directory (file-name-directory file))
;; Save the article in the cache.
(if (file-exists-p file)
t ; The article already is saved.
;; [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)
- (mail-header-subject headers)
- (mail-header-from headers)
+ (mime-entity-fetch-field headers 'Subject)
+ (mime-entity-fetch-field headers 'From)
(mail-header-date headers)
(mail-header-id headers)
(or (mail-header-references headers) "")
(when (file-exists-p file)
(erase-buffer)
(gnus-kill-all-overlays)
- (insert-file-contents file)
+ (nnheader-insert-file-contents file)
t)))
(defun gnus-cache-possibly-alter-active (group active)
;; unsuccessful), so we use the cached headers exclusively.
(set-buffer nntp-server-buffer)
(erase-buffer)
- (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
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.
(defun gnus-summary-insert-cached-articles ()
"Insert all the articles cached for this group into the current buffer."
(interactive)
- (let ((cached 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"))
(save-excursion
(setq gnus-cache-buffer
(cons group
- (set-buffer (get-buffer-create " *gnus-cache-overview*"))))
+ (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)
(defun gnus-cache-update-article (group article)
"If ARTICLE is in the cache, remove it and re-enter it."
- (when (gnus-cache-possibly-remove-article article nil nil nil t)
+ (gnus-cache-change-buffer group)
+ (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)
articles)))
(defun gnus-cache-braid-nov (group cached &optional file)
- (let ((cache-buf (get-buffer-create " *gnus-cache*"))
+ (let ((cache-buf (gnus-get-buffer-create " *gnus-cache*"))
beg end)
(gnus-cache-save-buffers)
(save-excursion
(set-buffer cache-buf)
(buffer-disable-undo (current-buffer))
(erase-buffer)
- (insert-file-contents (or file (gnus-cache-file-name group ".overview")))
+ (nnheader-insert-file-contents (or file (gnus-cache-file-name group ".overview")))
(goto-char (point-min))
(insert "\n")
(goto-char (point-min)))
(kill-buffer cache-buf)))
(defun gnus-cache-braid-heads (group cached)
- (let ((cache-buf (get-buffer-create " *gnus-cache*")))
+ (let ((cache-buf (gnus-get-buffer-create " *gnus-cache*")))
(save-excursion
(set-buffer cache-buf)
(buffer-disable-undo (current-buffer))
(save-excursion
(set-buffer cache-buf)
(erase-buffer)
- (insert-file-contents (gnus-cache-file-name group (car cached)))
+ (nnheader-insert-file-contents (gnus-cache-file-name group (car cached)))
(goto-char (point-min))
(insert "220 ")
(princ (car cached) (current-buffer))
(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.
;; We simply read the active file.
(save-excursion
(gnus-set-work-buffer)
- (insert-file-contents gnus-cache-active-file)
+ (nnheader-insert-file-contents gnus-cache-active-file)
(gnus-active-to-gnus-format
nil (setq gnus-cache-active-hashtb
(gnus-make-hashtable
(if top
""
(string-match
- (concat "^" (file-name-as-directory
- (expand-file-name gnus-cache-directory)))
+ (concat "^" (regexp-quote
+ (file-name-as-directory
+ (expand-file-name gnus-cache-directory))))
(directory-file-name directory))
(nnheader-replace-chars-in-string
(substring (directory-file-name directory) (match-end 0))
(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