1 ;;; gnus-cache.el --- cache interface for Gnus
2 ;; Copyright (C) 1995 Free Software Foundation, Inc.
4 ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
7 ;; This file is part of GNU Emacs.
9 ;; GNU Emacs is free software; you can redistribute it and/or modify
10 ;; it under the terms of the GNU General Public License as published by
11 ;; the Free Software Foundation; either version 2, or (at your option)
14 ;; GNU Emacs is distributed in the hope that it will be useful,
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 ;; GNU General Public License for more details.
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with GNU Emacs; see the file COPYING. If not, write to
21 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
29 (defvar gnus-cache-directory (concat gnus-article-save-directory "cache/")
30 "*The directory where cached articles will be stored.")
32 (defvar gnus-cache-enter-articles '(ticked dormant)
33 "*Classes of articles to enter into the cache.")
35 (defvar gnus-cache-remove-articles '(read)
36 "*Classes of articles to remove from the cache.")
40 (defvar gnus-cache-buffer nil)
41 (defvar gnus-cache-removeable-articles nil)
45 (defun gnus-cache-change-buffer (group)
47 (cond ((null gnus-cache-buffer)
48 ;; No current cache, so we create and init the buffer.
49 (setq gnus-cache-buffer
50 (cons group (get-buffer-create " *gnus-cache-overview*")))
51 (set-buffer (cdr gnus-cache-buffer))
52 (buffer-disable-undo (current-buffer))
54 (gnus-add-current-to-buffer-list)
55 (let ((file (gnus-cache-file-name group ".overview")))
56 (and (file-exists-p file)
57 (insert-file-contents file))))
58 ((not (string= group (car gnus-cache-buffer)))
59 ;; If a different overview cache is the current, we
60 ;; (possibly) save it and change to this groups.
61 (set-buffer (cdr gnus-cache-buffer))
62 (and (buffer-modified-p)
63 (write-region (point-min) (point-max)
65 (car gnus-cache-buffer) ".overview")
68 (setcar gnus-cache-buffer group)
69 (let ((file (gnus-cache-file-name group ".overview")))
70 (and (file-exists-p file)
71 (insert-file-contents file))))))
72 (setq gnus-cache-removeable-articles nil))
75 ;; Just save the overview buffer.
76 (defun gnus-cache-save-buffers ()
77 (and gnus-cache-buffer
79 (set-buffer (cdr gnus-cache-buffer))
80 (and (buffer-modified-p)
81 (write-region (point-min) (point-max)
82 (gnus-cache-file-name (car gnus-cache-buffer)
85 (setq gnus-cache-buffer nil))
87 ;; Return whether an article is a member of a class.
88 (defun gnus-cache-member-of-class (class ticked dormant unread)
89 (or (and ticked (memq 'ticked class))
90 (and dormant (memq 'dormant class))
91 (and unread (memq 'unread class))
92 (and (not unread) (memq 'read class))))
94 (defun gnus-cache-file-name (group article)
95 (concat (file-name-as-directory gnus-cache-directory)
96 (if (gnus-use-long-file-name 'not-cache)
97 group (gnus-replace-chars-in-string group ?. ?/))
98 "/" (if (stringp article) article (int-to-string article))))
100 (defun gnus-cache-possibly-enter-article
101 (group article headers ticked dormant unread)
102 (let ((number (header-number headers))
104 (if (or (not (gnus-cache-member-of-class
105 gnus-cache-enter-articles ticked dormant unread))
106 (file-exists-p (setq file (gnus-cache-file-name group article))))
108 ;; Possibly create the cache directory.
109 (or (file-exists-p (setq dir (file-name-directory file)))
110 (gnus-make-directory dir))
111 ;; Save the article in the cache.
112 (if (file-exists-p file)
113 t ; The article already is saved, so we end here.
114 (gnus-summary-select-article)
116 (set-buffer gnus-article-buffer)
117 (write-region (point-min) (point-max) file nil 'quiet)
118 (gnus-cache-change-buffer group)
119 (set-buffer (cdr gnus-cache-buffer))
120 (goto-char (point-max))
122 (while (and (not (bobp))
123 (> (read (current-buffer)) number))
129 (if (< (read (current-buffer)) number)
134 ;; [number subject from date id references chars lines xref]
135 (insert (format "%s\t%s\t%s\t%s\t%s\t%s\t%s\t%s\t%s\t\n"
136 (header-number headers)
137 (header-subject headers)
138 (header-from headers)
139 (header-date headers)
141 (or (header-references headers) "")
142 (or (header-chars headers) "")
143 (or (header-lines headers) "")
144 (or (header-xref headers) ""))))
147 (defun gnus-cache-enter-remove-article (article)
148 (setq gnus-cache-removeable-articles
149 (cons article gnus-cache-removeable-articles)))
151 (defun gnus-cache-possibly-remove-articles ()
152 (let ((articles gnus-cache-removeable-articles)
153 (cache-articles (gnus-cache-articles-in-group gnus-newsgroup-name))
156 (setq article (car articles)
157 articles (cdr articles))
158 (if (memq article cache-articles)
159 ;; The article was in the cache, so we see whether we are
160 ;; supposed to remove it from the cache.
161 (gnus-cache-possibly-remove-article
162 gnus-newsgroup-name article
163 (memq article gnus-newsgroup-marked)
164 (memq article gnus-newsgroup-dormant)
165 (or (memq article gnus-newsgroup-unreads)
166 (memq article gnus-newsgroup-unselected)))))))
168 (defun gnus-cache-possibly-remove-article
169 (group article ticked dormant unread)
170 (let ((file (gnus-cache-file-name group article)))
171 (if (or (not (file-exists-p file))
172 (not (gnus-cache-member-of-class
173 gnus-cache-remove-articles ticked dormant unread)))
177 (gnus-cache-change-buffer group)
178 (set-buffer (cdr gnus-cache-buffer))
179 (goto-char (point-min))
180 (if (or (looking-at (concat (int-to-string article) "\t"))
181 (search-forward (concat "\n" (int-to-string article) "\t")
183 (delete-region (progn (beginning-of-line) (point))
184 (progn (forward-line 1) (point))))))))
186 (defun gnus-cache-request-article (article group)
187 (let ((file (gnus-cache-file-name group article)))
188 (if (not (file-exists-p file))
191 (insert-file-contents file)
194 (defun gnus-cache-articles-in-group (group)
195 (let ((dir (file-name-directory (gnus-cache-file-name group 1)))
197 (if (not (file-exists-p dir))
199 (setq articles (directory-files dir nil "^[0-9]+$" t))
202 (sort (mapcar (function (lambda (name)
203 (string-to-int name)))
207 (defun gnus-cache-active-articles (group)
208 (let ((articles (gnus-cache-articles-in-group group)))
210 (cons (car articles) (gnus-last-element articles)))))
212 (defun gnus-cache-possibly-alter-active (group active)
213 (let ((cache-active (gnus-cache-active-articles group)))
214 (and cache-active (< (car cache-active) (car active))
215 (setcar active (car cache-active)))
216 (and cache-active (> (cdr cache-active) (cdr active))
217 (setcdr active (cdr cache-active)))))
219 (defun gnus-cache-retrieve-headers (articles group)
220 (let* ((cached (gnus-cache-articles-in-group group))
221 (articles (gnus-sorted-complement articles cached))
222 (cache-file (gnus-cache-file-name group ".overview"))
224 (let ((gnus-use-cache nil))
225 (setq type (and articles (gnus-retrieve-headers articles group))))
226 (gnus-cache-save-buffers)
228 (cond ((not (file-exists-p cache-file))
231 (set-buffer nntp-server-buffer)
233 (insert-file-contents cache-file)
236 (gnus-cache-braid-nov group cached)
239 (gnus-cache-braid-heads group cached)
242 (defun gnus-cache-braid-nov (group cached)
243 (let ((cache-buf (get-buffer-create " *gnus-cache*"))
245 (gnus-cache-save-buffers)
247 (set-buffer cache-buf)
248 (buffer-disable-undo (current-buffer))
250 (insert-file-contents (gnus-cache-file-name group ".overview"))
251 (goto-char (point-min))
253 (goto-char (point-min)))
254 (set-buffer nntp-server-buffer)
255 (goto-char (point-min))
257 (while (and (not (eobp))
258 (< (read (current-buffer)) (car cached)))
262 (set-buffer cache-buf)
263 (if (search-forward (concat "\n" (int-to-string (car cached)) "\t")
265 (setq beg (progn (beginning-of-line) (point))
266 end (progn (forward-line 1) (point)))
268 (and beg (insert-buffer-substring cache-buf beg end))
269 (setq cached (cdr cached)))
270 (kill-buffer cache-buf)))
272 (defun gnus-cache-braid-heads (group cached)
273 (let ((cache-buf (get-buffer-create " *gnus-cache*")))
275 (set-buffer cache-buf)
276 (buffer-disable-undo (current-buffer))
278 (set-buffer nntp-server-buffer)
279 (goto-char (point-min))
281 (while (and (not (eobp))
282 (looking-at "2.. +\\([0-9]+\\) ")
283 (< (progn (goto-char (match-beginning 1))
284 (read (current-buffer)))
286 (search-forward "\n.\n" nil 'move))
289 (set-buffer cache-buf)
291 (insert-file-contents (gnus-cache-file-name group (car cached)))
292 (goto-char (point-min))
293 (insert "220 " (int-to-string (car cached)) " Article retrieved.\n")
294 (search-forward "\n\n" nil 'move)
295 (delete-region (point) (point-max))
298 (insert-buffer-substring cache-buf)
299 (setq cached (cdr cached)))
300 (kill-buffer cache-buf)))
302 (defun gnus-jog-cache ()
303 "Go through all groups and put the articles into the cache."
305 (let ((newsrc (cdr gnus-newsrc-alist))
306 (gnus-cache-enter-articles '(unread))
307 (gnus-mark-article-hook nil)
309 (gnus-large-newsgroup nil))
311 (gnus-summary-read-group (car (car newsrc)))
312 (if (not (eq major-mode 'gnus-summary-mode))
314 (while gnus-newsgroup-unreads
315 (gnus-summary-select-article t t nil (car gnus-newsgroup-unreads))
316 (setq gnus-newsgroup-unreads (cdr gnus-newsgroup-unreads)))
317 (kill-buffer (current-buffer)))
318 (setq newsrc (cdr newsrc)))))
320 (provide 'gnus-cache)
322 ;;; gnus-cache.el ends here