;;; gnus-cache.el --- cache interface for Gnus
-;; Copyright (C) 1995,96,97,98,99 Free Software Foundation, Inc.
+;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
(defvar gnus-cache-overview-coding-system 'raw-text
"Coding system used on Gnus cache files.")
-(defvar gnus-cache-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.
- (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))
(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)
- ;; 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))))
+ (> 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)
(when (and number
(> number 0) ; Reffed article.
(or force
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))
+ (let ((gnus-use-cache nil))
(gnus-request-article-this-buffer number group))
(when (> (buffer-size) 0)
(gnus-write-buffer 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))
(beginning-of-line))
(forward-line 1))
(beginning-of-line)
- (nnheader-insert-nov headers)
+ ;; [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)
+ (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) "")))
;; 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)
- (let ((coding-system-for-read gnus-cache-coding-system))
- (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)
- (let ((coding-system-for-read
- 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
(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))
(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")))
(nnheader-translate-file-chars
(if (gnus-use-long-file-name 'not-cache)
group
- (let ((group (nnheader-replace-duplicate-chars-in-string
- (nnheader-replace-chars-in-string 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) ?/))
(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-newsgroup-name article (gnus-summary-article-header article)
nil nil nil t))))
(defun gnus-cache-possibly-remove-article (article ticked dormant unread
(gnus-cache-save-buffers)
(save-excursion
(set-buffer cache-buf)
+ (buffer-disable-undo (current-buffer))
(erase-buffer)
- (let ((coding-system-for-read
- gnus-cache-overview-coding-system))
- (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)))
(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))
(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))))
+ (nnheader-insert-file-contents (gnus-cache-file-name group (car cached)))
(goto-char (point-min))
(insert "220 ")
(princ (car cached) (current-buffer))
"Read the cache active file."
(gnus-make-directory gnus-cache-directory)
(if (or (not (file-exists-p gnus-cache-active-file))
- (zerop (nth 7 (file-attributes gnus-cache-active-file)))
+ (not (zerop (nth 7 (file-attributes gnus-cache-active-file))))
force)
;; There is no active file, so we generate one.
(gnus-cache-generate-active)
;; 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
(when (or force
(and gnus-cache-active-hashtb
gnus-cache-active-altered))
- (gnus-write-active-file gnus-cache-active-file gnus-cache-active-hashtb t)
+ (nnheader-temp-write 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))
;; Mark the active hashtb as unaltered.
(setq gnus-cache-active-altered nil)))
projects / elisp / gnus.git- / blobdiff