|
0
|
1 ;;; gnus-cache.el --- cache interface for Gnus
|
|
98
|
2 ;; Copyright (C) 1995,96,97 Free Software Foundation, Inc.
|
|
0
|
3
|
|
|
4 ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
|
|
|
5 ;; Keywords: news
|
|
|
6
|
|
|
7 ;; This file is part of GNU Emacs.
|
|
|
8
|
|
|
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)
|
|
|
12 ;; any later version.
|
|
|
13
|
|
|
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.
|
|
|
18
|
|
|
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 the
|
|
|
21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
|
22 ;; Boston, MA 02111-1307, USA.
|
|
|
23
|
|
|
24 ;;; Commentary:
|
|
|
25
|
|
|
26 ;;; Code:
|
|
|
27
|
|
|
28 (require 'gnus)
|
|
98
|
29 (require 'gnus-int)
|
|
|
30 (require 'gnus-range)
|
|
|
31 (require 'gnus-start)
|
|
|
32 (eval-when-compile
|
|
|
33 (require 'gnus-sum))
|
|
0
|
34
|
|
98
|
35 (defgroup gnus-cache nil
|
|
|
36 "Cache interface."
|
|
|
37 :group 'gnus)
|
|
|
38
|
|
|
39 (defcustom gnus-cache-directory
|
|
0
|
40 (nnheader-concat gnus-directory "cache/")
|
|
98
|
41 "*The directory where cached articles will be stored."
|
|
|
42 :group 'gnus-cache
|
|
|
43 :type 'directory)
|
|
0
|
44
|
|
108
|
45 (defcustom gnus-cache-active-file
|
|
0
|
46 (concat (file-name-as-directory gnus-cache-directory) "active")
|
|
98
|
47 "*The cache active file."
|
|
|
48 :group 'gnus-cache
|
|
|
49 :type 'file)
|
|
0
|
50
|
|
98
|
51 (defcustom gnus-cache-enter-articles '(ticked dormant)
|
|
|
52 "Classes of articles to enter into the cache."
|
|
|
53 :group 'gnus-cache
|
|
|
54 :type '(set (const ticked) (const dormant) (const unread) (const read)))
|
|
16
|
55
|
|
98
|
56 (defcustom gnus-cache-remove-articles '(read)
|
|
|
57 "Classes of articles to remove from the cache."
|
|
|
58 :group 'gnus-cache
|
|
|
59 :type '(set (const ticked) (const dormant) (const unread) (const read)))
|
|
|
60
|
|
|
61 (defcustom gnus-uncacheable-groups nil
|
|
0
|
62 "*Groups that match this regexp will not be cached.
|
|
|
63
|
|
|
64 If you want to avoid caching your nnml groups, you could set this
|
|
98
|
65 variable to \"^nnml\"."
|
|
|
66 :group 'gnus-cache
|
|
|
67 :type '(choice (const :tag "off" nil)
|
|
|
68 regexp))
|
|
0
|
69
|
|
|
70
|
|
|
71
|
|
|
72 ;;; Internal variables.
|
|
|
73
|
|
98
|
74 (defvar gnus-cache-removable-articles nil)
|
|
0
|
75 (defvar gnus-cache-buffer nil)
|
|
|
76 (defvar gnus-cache-active-hashtb nil)
|
|
|
77 (defvar gnus-cache-active-altered nil)
|
|
|
78
|
|
|
79 (eval-and-compile
|
|
|
80 (autoload 'nnml-generate-nov-databases-1 "nnml")
|
|
|
81 (autoload 'nnvirtual-find-group-art "nnvirtual"))
|
|
|
82
|
|
|
83
|
|
|
84
|
|
|
85 ;;; Functions called from Gnus.
|
|
|
86
|
|
|
87 (defun gnus-cache-open ()
|
|
|
88 "Initialize the cache."
|
|
2
|
89 (when (or (file-exists-p gnus-cache-directory)
|
|
|
90 (and gnus-use-cache
|
|
|
91 (not (eq gnus-use-cache 'passive))))
|
|
|
92 (gnus-cache-read-active)))
|
|
0
|
93
|
|
98
|
94 ;; Complexities of byte-compiling make this kludge necessary. Eeek.
|
|
|
95 (ignore-errors
|
|
|
96 (gnus-add-shutdown 'gnus-cache-close 'gnus))
|
|
0
|
97
|
|
|
98 (defun gnus-cache-close ()
|
|
|
99 "Shut down the cache."
|
|
|
100 (gnus-cache-write-active)
|
|
|
101 (gnus-cache-save-buffers)
|
|
|
102 (setq gnus-cache-active-hashtb nil))
|
|
|
103
|
|
|
104 (defun gnus-cache-save-buffers ()
|
|
|
105 ;; save the overview buffer if it exists and has been modified
|
|
|
106 ;; delete empty cache subdirectories
|
|
98
|
107 (when gnus-cache-buffer
|
|
0
|
108 (let ((buffer (cdr gnus-cache-buffer))
|
|
|
109 (overview-file (gnus-cache-file-name
|
|
|
110 (car gnus-cache-buffer) ".overview")))
|
|
|
111 ;; write the overview only if it was modified
|
|
98
|
112 (when (buffer-modified-p buffer)
|
|
|
113 (save-excursion
|
|
|
114 (set-buffer buffer)
|
|
|
115 (if (> (buffer-size) 0)
|
|
|
116 ;; Non-empty overview, write it to a file.
|
|
|
117 (gnus-write-buffer overview-file)
|
|
|
118 ;; Empty overview file, remove it
|
|
|
119 (when (file-exists-p overview-file)
|
|
|
120 (delete-file overview-file))
|
|
|
121 ;; If possible, remove group's cache subdirectory.
|
|
|
122 (condition-case nil
|
|
|
123 ;; FIXME: we can detect the error type and warn the user
|
|
|
124 ;; of any inconsistencies (articles w/o nov entries?).
|
|
|
125 ;; for now, just be conservative...delete only if safe -- sj
|
|
|
126 (delete-directory (file-name-directory overview-file))
|
|
|
127 (error nil)))))
|
|
|
128 ;; Kill the buffer -- it's either unmodified or saved.
|
|
0
|
129 (gnus-kill-buffer buffer)
|
|
|
130 (setq gnus-cache-buffer nil))))
|
|
|
131
|
|
108
|
132 (defun gnus-cache-possibly-enter-article
|
|
0
|
133 (group article headers ticked dormant unread &optional force)
|
|
|
134 (when (and (or force (not (eq gnus-use-cache 'passive)))
|
|
|
135 (numberp article)
|
|
|
136 (> article 0)
|
|
110
|
137 (vectorp headers)) ; This might be a dummy article.
|
|
0
|
138 ;; If this is a virtual group, we find the real group.
|
|
|
139 (when (gnus-virtual-group-p group)
|
|
108
|
140 (let ((result (nnvirtual-find-group-art
|
|
0
|
141 (gnus-group-real-name group) article)))
|
|
|
142 (setq group (car result)
|
|
|
143 headers (copy-sequence headers))
|
|
|
144 (mail-header-set-number headers (cdr result))))
|
|
|
145 (let ((number (mail-header-number headers))
|
|
|
146 file dir)
|
|
136
|
147 (when (and number
|
|
|
148 (> number 0) ; Reffed article.
|
|
0
|
149 (or force
|
|
98
|
150 (and (or (not gnus-uncacheable-groups)
|
|
|
151 (not (string-match
|
|
|
152 gnus-uncacheable-groups group)))
|
|
|
153 (gnus-cache-member-of-class
|
|
|
154 gnus-cache-enter-articles ticked dormant unread)))
|
|
0
|
155 (not (file-exists-p (setq file (gnus-cache-file-name
|
|
|
156 group number)))))
|
|
|
157 ;; Possibly create the cache directory.
|
|
98
|
158 (gnus-make-directory (setq dir (file-name-directory file)))
|
|
0
|
159 ;; Save the article in the cache.
|
|
|
160 (if (file-exists-p file)
|
|
|
161 t ; The article already is saved.
|
|
|
162 (save-excursion
|
|
|
163 (set-buffer nntp-server-buffer)
|
|
|
164 (let ((gnus-use-cache nil))
|
|
|
165 (gnus-request-article-this-buffer number group))
|
|
|
166 (when (> (buffer-size) 0)
|
|
98
|
167 (gnus-write-buffer file)
|
|
0
|
168 (gnus-cache-change-buffer group)
|
|
|
169 (set-buffer (cdr gnus-cache-buffer))
|
|
|
170 (goto-char (point-max))
|
|
|
171 (forward-line -1)
|
|
|
172 (while (condition-case ()
|
|
98
|
173 (when (not (bobp))
|
|
|
174 (> (read (current-buffer)) number))
|
|
0
|
175 (error
|
|
|
176 ;; The line was malformed, so we just remove it!!
|
|
|
177 (gnus-delete-line)
|
|
|
178 t))
|
|
|
179 (forward-line -1))
|
|
98
|
180 (if (bobp)
|
|
0
|
181 (if (not (eobp))
|
|
|
182 (progn
|
|
|
183 (beginning-of-line)
|
|
98
|
184 (when (< (read (current-buffer)) number)
|
|
|
185 (forward-line 1)))
|
|
0
|
186 (beginning-of-line))
|
|
|
187 (forward-line 1))
|
|
|
188 (beginning-of-line)
|
|
|
189 ;; [number subject from date id references chars lines xref]
|
|
|
190 (insert (format "%s\t%s\t%s\t%s\t%s\t%s\t%s\t%s\t%s\t\n"
|
|
|
191 (mail-header-number headers)
|
|
|
192 (mail-header-subject headers)
|
|
|
193 (mail-header-from headers)
|
|
|
194 (mail-header-date headers)
|
|
|
195 (mail-header-id headers)
|
|
|
196 (or (mail-header-references headers) "")
|
|
|
197 (or (mail-header-chars headers) "")
|
|
|
198 (or (mail-header-lines headers) "")
|
|
|
199 (or (mail-header-xref headers) "")))
|
|
|
200 ;; Update the active info.
|
|
|
201 (set-buffer gnus-summary-buffer)
|
|
|
202 (gnus-cache-update-active group number)
|
|
|
203 (push article gnus-newsgroup-cached)
|
|
|
204 (gnus-summary-update-secondary-mark article))
|
|
|
205 t))))))
|
|
|
206
|
|
|
207 (defun gnus-cache-enter-remove-article (article)
|
|
|
208 "Mark ARTICLE for later possible removal."
|
|
|
209 (when article
|
|
|
210 (push article gnus-cache-removable-articles)))
|
|
|
211
|
|
|
212 (defun gnus-cache-possibly-remove-articles ()
|
|
|
213 "Possibly remove some of the removable articles."
|
|
|
214 (if (not (gnus-virtual-group-p gnus-newsgroup-name))
|
|
|
215 (gnus-cache-possibly-remove-articles-1)
|
|
|
216 (let ((arts gnus-cache-removable-articles)
|
|
|
217 ga)
|
|
|
218 (while arts
|
|
|
219 (when (setq ga (nnvirtual-find-group-art
|
|
|
220 (gnus-group-real-name gnus-newsgroup-name) (pop arts)))
|
|
|
221 (let ((gnus-cache-removable-articles (list (cdr ga)))
|
|
|
222 (gnus-newsgroup-name (car ga)))
|
|
|
223 (gnus-cache-possibly-remove-articles-1)))))
|
|
|
224 (setq gnus-cache-removable-articles nil)))
|
|
|
225
|
|
|
226 (defun gnus-cache-possibly-remove-articles-1 ()
|
|
|
227 "Possibly remove some of the removable articles."
|
|
|
228 (unless (eq gnus-use-cache 'passive)
|
|
|
229 (let ((articles gnus-cache-removable-articles)
|
|
|
230 (cache-articles gnus-newsgroup-cached)
|
|
|
231 article)
|
|
|
232 (gnus-cache-change-buffer gnus-newsgroup-name)
|
|
|
233 (while articles
|
|
98
|
234 (when (memq (setq article (pop articles)) cache-articles)
|
|
|
235 ;; The article was in the cache, so we see whether we are
|
|
|
236 ;; supposed to remove it from the cache.
|
|
|
237 (gnus-cache-possibly-remove-article
|
|
|
238 article (memq article gnus-newsgroup-marked)
|
|
|
239 (memq article gnus-newsgroup-dormant)
|
|
|
240 (or (memq article gnus-newsgroup-unreads)
|
|
|
241 (memq article gnus-newsgroup-unselected))))))
|
|
0
|
242 ;; The overview file might have been modified, save it
|
|
|
243 ;; safe because we're only called at group exit anyway.
|
|
|
244 (gnus-cache-save-buffers)))
|
|
|
245
|
|
|
246 (defun gnus-cache-request-article (article group)
|
|
|
247 "Retrieve ARTICLE in GROUP from the cache."
|
|
|
248 (let ((file (gnus-cache-file-name group article))
|
|
|
249 (buffer-read-only nil))
|
|
|
250 (when (file-exists-p file)
|
|
|
251 (erase-buffer)
|
|
|
252 (gnus-kill-all-overlays)
|
|
|
253 (insert-file-contents file)
|
|
|
254 t)))
|
|
|
255
|
|
|
256 (defun gnus-cache-possibly-alter-active (group active)
|
|
|
257 "Alter the ACTIVE info for GROUP to reflect the articles in the cache."
|
|
2
|
258 (when gnus-cache-active-hashtb
|
|
|
259 (let ((cache-active (gnus-gethash group gnus-cache-active-hashtb)))
|
|
153
|
260 (when cache-active
|
|
|
261 (when (< (car cache-active) (car active))
|
|
|
262 (setcar active (car cache-active)))
|
|
|
263 (when (> (cdr cache-active) (cdr active))
|
|
|
264 (setcdr active (cdr cache-active)))))))
|
|
0
|
265
|
|
|
266 (defun gnus-cache-retrieve-headers (articles group &optional fetch-old)
|
|
|
267 "Retrieve the headers for ARTICLES in GROUP."
|
|
108
|
268 (let ((cached
|
|
0
|
269 (setq gnus-newsgroup-cached (gnus-cache-articles-in-group group))))
|
|
|
270 (if (not cached)
|
|
|
271 ;; No cached articles here, so we just retrieve them
|
|
|
272 ;; the normal way.
|
|
|
273 (let ((gnus-use-cache nil))
|
|
|
274 (gnus-retrieve-headers articles group fetch-old))
|
|
|
275 (let ((uncached-articles (gnus-sorted-intersection
|
|
|
276 (gnus-sorted-complement articles cached)
|
|
|
277 articles))
|
|
|
278 (cache-file (gnus-cache-file-name group ".overview"))
|
|
|
279 type)
|
|
108
|
280 ;; We first retrieve all the headers that we don't have in
|
|
0
|
281 ;; the cache.
|
|
|
282 (let ((gnus-use-cache nil))
|
|
|
283 (when uncached-articles
|
|
108
|
284 (setq type (and articles
|
|
|
285 (gnus-retrieve-headers
|
|
0
|
286 uncached-articles group fetch-old)))))
|
|
|
287 (gnus-cache-save-buffers)
|
|
|
288 ;; Then we insert the cached headers.
|
|
|
289 (save-excursion
|
|
|
290 (cond
|
|
|
291 ((not (file-exists-p cache-file))
|
|
|
292 ;; There are no cached headers.
|
|
|
293 type)
|
|
|
294 ((null type)
|
|
108
|
295 ;; There were no uncached headers (or retrieval was
|
|
0
|
296 ;; unsuccessful), so we use the cached headers exclusively.
|
|
|
297 (set-buffer nntp-server-buffer)
|
|
|
298 (erase-buffer)
|
|
|
299 (insert-file-contents cache-file)
|
|
|
300 'nov)
|
|
|
301 ((eq type 'nov)
|
|
|
302 ;; We have both cached and uncached NOV headers, so we
|
|
|
303 ;; braid them.
|
|
|
304 (gnus-cache-braid-nov group cached)
|
|
|
305 type)
|
|
|
306 (t
|
|
|
307 ;; We braid HEADs.
|
|
|
308 (gnus-cache-braid-heads group (gnus-sorted-intersection
|
|
|
309 cached articles))
|
|
|
310 type)))))))
|
|
|
311
|
|
|
312 (defun gnus-cache-enter-article (&optional n)
|
|
|
313 "Enter the next N articles into the cache.
|
|
|
314 If not given a prefix, use the process marked articles instead.
|
|
|
315 Returns the list of articles entered."
|
|
|
316 (interactive "P")
|
|
|
317 (gnus-set-global-variables)
|
|
|
318 (let ((articles (gnus-summary-work-articles n))
|
|
|
319 article out)
|
|
98
|
320 (while (setq article (pop articles))
|
|
|
321 (if (natnump article)
|
|
108
|
322 (when (gnus-cache-possibly-enter-article
|
|
|
323 gnus-newsgroup-name article
|
|
98
|
324 (gnus-summary-article-header article)
|
|
|
325 nil nil nil t)
|
|
|
326 (push article out))
|
|
|
327 (gnus-message 2 "Can't cache article %d" article))
|
|
0
|
328 (gnus-summary-remove-process-mark article)
|
|
|
329 (gnus-summary-update-secondary-mark article))
|
|
|
330 (gnus-summary-next-subject 1)
|
|
|
331 (gnus-summary-position-point)
|
|
|
332 (nreverse out)))
|
|
|
333
|
|
|
334 (defun gnus-cache-remove-article (n)
|
|
|
335 "Remove the next N articles from the cache.
|
|
|
336 If not given a prefix, use the process marked articles instead.
|
|
|
337 Returns the list of articles removed."
|
|
|
338 (interactive "P")
|
|
|
339 (gnus-set-global-variables)
|
|
|
340 (gnus-cache-change-buffer gnus-newsgroup-name)
|
|
|
341 (let ((articles (gnus-summary-work-articles n))
|
|
|
342 article out)
|
|
|
343 (while articles
|
|
|
344 (setq article (pop articles))
|
|
|
345 (when (gnus-cache-possibly-remove-article article nil nil nil t)
|
|
|
346 (push article out))
|
|
|
347 (gnus-summary-remove-process-mark article)
|
|
|
348 (gnus-summary-update-secondary-mark article))
|
|
|
349 (gnus-summary-next-subject 1)
|
|
|
350 (gnus-summary-position-point)
|
|
|
351 (nreverse out)))
|
|
|
352
|
|
|
353 (defun gnus-cached-article-p (article)
|
|
|
354 "Say whether ARTICLE is cached in the current group."
|
|
|
355 (memq article gnus-newsgroup-cached))
|
|
|
356
|
|
98
|
357 (defun gnus-summary-insert-cached-articles ()
|
|
|
358 "Insert all the articles cached for this group into the current buffer."
|
|
|
359 (interactive)
|
|
|
360 (let ((cached gnus-newsgroup-cached)
|
|
|
361 (gnus-verbose (max 6 gnus-verbose)))
|
|
|
362 (unless cached
|
|
|
363 (error "No cached articles for this group"))
|
|
|
364 (while cached
|
|
|
365 (gnus-summary-goto-subject (pop cached) t))))
|
|
|
366
|
|
0
|
367 ;;; Internal functions.
|
|
|
368
|
|
|
369 (defun gnus-cache-change-buffer (group)
|
|
|
370 (and gnus-cache-buffer
|
|
|
371 ;; See if the current group's overview cache has been loaded.
|
|
|
372 (or (string= group (car gnus-cache-buffer))
|
|
|
373 ;; Another overview cache is current, save it.
|
|
|
374 (gnus-cache-save-buffers)))
|
|
|
375 ;; if gnus-cache buffer is nil, create it
|
|
98
|
376 (unless gnus-cache-buffer
|
|
|
377 ;; Create cache buffer
|
|
|
378 (save-excursion
|
|
|
379 (setq gnus-cache-buffer
|
|
|
380 (cons group
|
|
|
381 (set-buffer (get-buffer-create " *gnus-cache-overview*"))))
|
|
|
382 (buffer-disable-undo (current-buffer))
|
|
|
383 ;; Insert the contents of this group's cache overview.
|
|
|
384 (erase-buffer)
|
|
|
385 (let ((file (gnus-cache-file-name group ".overview")))
|
|
|
386 (when (file-exists-p file)
|
|
|
387 (nnheader-insert-file-contents file)))
|
|
108
|
388 ;; We have a fresh (empty/just loaded) buffer,
|
|
98
|
389 ;; mark it as unmodified to save a redundant write later.
|
|
|
390 (set-buffer-modified-p nil))))
|
|
0
|
391
|
|
|
392 ;; Return whether an article is a member of a class.
|
|
|
393 (defun gnus-cache-member-of-class (class ticked dormant unread)
|
|
|
394 (or (and ticked (memq 'ticked class))
|
|
|
395 (and dormant (memq 'dormant class))
|
|
|
396 (and unread (memq 'unread class))
|
|
|
397 (and (not unread) (not ticked) (not dormant) (memq 'read class))))
|
|
|
398
|
|
|
399 (defun gnus-cache-file-name (group article)
|
|
|
400 (concat (file-name-as-directory gnus-cache-directory)
|
|
|
401 (file-name-as-directory
|
|
98
|
402 (nnheader-translate-file-chars
|
|
|
403 (if (gnus-use-long-file-name 'not-cache)
|
|
|
404 group
|
|
|
405 (let ((group (nnheader-replace-chars-in-string group ?/ ?_)))
|
|
|
406 ;; Translate the first colon into a slash.
|
|
|
407 (when (string-match ":" group)
|
|
|
408 (aset group (match-beginning 0) ?/))
|
|
|
409 (nnheader-replace-chars-in-string group ?. ?/)))))
|
|
0
|
410 (if (stringp article) article (int-to-string article))))
|
|
|
411
|
|
|
412 (defun gnus-cache-update-article (group article)
|
|
|
413 "If ARTICLE is in the cache, remove it and re-enter it."
|
|
|
414 (when (gnus-cache-possibly-remove-article article nil nil nil t)
|
|
|
415 (let ((gnus-use-cache nil))
|
|
108
|
416 (gnus-cache-possibly-enter-article
|
|
0
|
417 gnus-newsgroup-name article (gnus-summary-article-header article)
|
|
|
418 nil nil nil t))))
|
|
|
419
|
|
108
|
420 (defun gnus-cache-possibly-remove-article (article ticked dormant unread
|
|
0
|
421 &optional force)
|
|
|
422 "Possibly remove ARTICLE from the cache."
|
|
|
423 (let ((group gnus-newsgroup-name)
|
|
|
424 (number article)
|
|
|
425 file)
|
|
|
426 ;; If this is a virtual group, we find the real group.
|
|
|
427 (when (gnus-virtual-group-p group)
|
|
108
|
428 (let ((result (nnvirtual-find-group-art
|
|
0
|
429 (gnus-group-real-name group) article)))
|
|
|
430 (setq group (car result)
|
|
|
431 number (cdr result))))
|
|
|
432 (setq file (gnus-cache-file-name group number))
|
|
|
433 (when (and (file-exists-p file)
|
|
|
434 (or force
|
|
|
435 (gnus-cache-member-of-class
|
|
|
436 gnus-cache-remove-articles ticked dormant unread)))
|
|
|
437 (save-excursion
|
|
|
438 (delete-file file)
|
|
|
439 (set-buffer (cdr gnus-cache-buffer))
|
|
|
440 (goto-char (point-min))
|
|
98
|
441 (when (or (looking-at (concat (int-to-string number) "\t"))
|
|
|
442 (search-forward (concat "\n" (int-to-string number) "\t")
|
|
|
443 (point-max) t))
|
|
|
444 (delete-region (progn (beginning-of-line) (point))
|
|
|
445 (progn (forward-line 1) (point)))))
|
|
0
|
446 (setq gnus-newsgroup-cached
|
|
|
447 (delq article gnus-newsgroup-cached))
|
|
|
448 (gnus-summary-update-secondary-mark article)
|
|
|
449 t)))
|
|
|
450
|
|
|
451 (defun gnus-cache-articles-in-group (group)
|
|
|
452 "Return a sorted list of cached articles in GROUP."
|
|
153
|
453 (let ((dir (file-name-directory (gnus-cache-file-name group 1)))
|
|
|
454 articles)
|
|
0
|
455 (when (file-exists-p dir)
|
|
153
|
456 (setq articles
|
|
|
457 (sort (mapcar (lambda (name) (string-to-int name))
|
|
|
458 (directory-files dir nil "^[0-9]+$" t))
|
|
|
459 '<))
|
|
|
460 ;; Update the cache active file, just to synch more.
|
|
|
461 (when articles
|
|
|
462 (gnus-cache-update-active group (car articles) t)
|
|
|
463 (gnus-cache-update-active group (car (last articles))))
|
|
|
464 articles)))
|
|
0
|
465
|
|
155
|
466 (defun gnus-cache-braid-nov (group cached &optional file)
|
|
0
|
467 (let ((cache-buf (get-buffer-create " *gnus-cache*"))
|
|
|
468 beg end)
|
|
|
469 (gnus-cache-save-buffers)
|
|
|
470 (save-excursion
|
|
|
471 (set-buffer cache-buf)
|
|
|
472 (buffer-disable-undo (current-buffer))
|
|
|
473 (erase-buffer)
|
|
155
|
474 (insert-file-contents (or file (gnus-cache-file-name group ".overview")))
|
|
0
|
475 (goto-char (point-min))
|
|
|
476 (insert "\n")
|
|
|
477 (goto-char (point-min)))
|
|
|
478 (set-buffer nntp-server-buffer)
|
|
|
479 (goto-char (point-min))
|
|
|
480 (while cached
|
|
|
481 (while (and (not (eobp))
|
|
|
482 (< (read (current-buffer)) (car cached)))
|
|
|
483 (forward-line 1))
|
|
|
484 (beginning-of-line)
|
|
|
485 (save-excursion
|
|
|
486 (set-buffer cache-buf)
|
|
|
487 (if (search-forward (concat "\n" (int-to-string (car cached)) "\t")
|
|
|
488 nil t)
|
|
|
489 (setq beg (progn (beginning-of-line) (point))
|
|
|
490 end (progn (end-of-line) (point)))
|
|
|
491 (setq beg nil)))
|
|
98
|
492 (when beg
|
|
|
493 (insert-buffer-substring cache-buf beg end)
|
|
|
494 (insert "\n"))
|
|
0
|
495 (setq cached (cdr cached)))
|
|
|
496 (kill-buffer cache-buf)))
|
|
|
497
|
|
|
498 (defun gnus-cache-braid-heads (group cached)
|
|
|
499 (let ((cache-buf (get-buffer-create " *gnus-cache*")))
|
|
|
500 (save-excursion
|
|
|
501 (set-buffer cache-buf)
|
|
|
502 (buffer-disable-undo (current-buffer))
|
|
|
503 (erase-buffer))
|
|
|
504 (set-buffer nntp-server-buffer)
|
|
|
505 (goto-char (point-min))
|
|
|
506 (while cached
|
|
|
507 (while (and (not (eobp))
|
|
|
508 (looking-at "2.. +\\([0-9]+\\) ")
|
|
|
509 (< (progn (goto-char (match-beginning 1))
|
|
|
510 (read (current-buffer)))
|
|
|
511 (car cached)))
|
|
|
512 (search-forward "\n.\n" nil 'move))
|
|
|
513 (beginning-of-line)
|
|
|
514 (save-excursion
|
|
|
515 (set-buffer cache-buf)
|
|
|
516 (erase-buffer)
|
|
|
517 (insert-file-contents (gnus-cache-file-name group (car cached)))
|
|
|
518 (goto-char (point-min))
|
|
|
519 (insert "220 ")
|
|
|
520 (princ (car cached) (current-buffer))
|
|
|
521 (insert " Article retrieved.\n")
|
|
|
522 (search-forward "\n\n" nil 'move)
|
|
|
523 (delete-region (point) (point-max))
|
|
|
524 (forward-char -1)
|
|
|
525 (insert "."))
|
|
|
526 (insert-buffer-substring cache-buf)
|
|
|
527 (setq cached (cdr cached)))
|
|
|
528 (kill-buffer cache-buf)))
|
|
|
529
|
|
|
530 ;;;###autoload
|
|
|
531 (defun gnus-jog-cache ()
|
|
98
|
532 "Go through all groups and put the articles into the cache.
|
|
|
533
|
|
|
534 Usage:
|
|
|
535 $ emacs -batch -l ~/.emacs -l gnus -f gnus-jog-cache"
|
|
0
|
536 (interactive)
|
|
|
537 (let ((gnus-mark-article-hook nil)
|
|
|
538 (gnus-expert-user t)
|
|
|
539 (nnmail-spool-file nil)
|
|
|
540 (gnus-use-dribble-file nil)
|
|
|
541 (gnus-novice-user nil)
|
|
|
542 (gnus-large-newsgroup nil))
|
|
|
543 ;; Start Gnus.
|
|
|
544 (gnus)
|
|
|
545 ;; Go through all groups...
|
|
|
546 (gnus-group-mark-buffer)
|
|
108
|
547 (gnus-group-universal-argument
|
|
|
548 nil nil
|
|
0
|
549 (lambda ()
|
|
98
|
550 (interactive)
|
|
|
551 (gnus-summary-read-group (gnus-group-group-name) nil t)
|
|
0
|
552 ;; ... and enter the articles into the cache.
|
|
|
553 (when (eq major-mode 'gnus-summary-mode)
|
|
|
554 (gnus-uu-mark-buffer)
|
|
|
555 (gnus-cache-enter-article)
|
|
|
556 (kill-buffer (current-buffer)))))))
|
|
|
557
|
|
|
558 (defun gnus-cache-read-active (&optional force)
|
|
|
559 "Read the cache active file."
|
|
98
|
560 (gnus-make-directory gnus-cache-directory)
|
|
153
|
561 (if (or (not (file-exists-p gnus-cache-active-file))
|
|
|
562 force)
|
|
0
|
563 ;; There is no active file, so we generate one.
|
|
|
564 (gnus-cache-generate-active)
|
|
|
565 ;; We simply read the active file.
|
|
|
566 (save-excursion
|
|
|
567 (gnus-set-work-buffer)
|
|
|
568 (insert-file-contents gnus-cache-active-file)
|
|
|
569 (gnus-active-to-gnus-format
|
|
108
|
570 nil (setq gnus-cache-active-hashtb
|
|
|
571 (gnus-make-hashtable
|
|
0
|
572 (count-lines (point-min) (point-max)))))
|
|
|
573 (setq gnus-cache-active-altered nil))))
|
|
108
|
574
|
|
0
|
575 (defun gnus-cache-write-active (&optional force)
|
|
|
576 "Write the active hashtb to the active file."
|
|
|
577 (when (or force
|
|
|
578 (and gnus-cache-active-hashtb
|
|
|
579 gnus-cache-active-altered))
|
|
98
|
580 (nnheader-temp-write gnus-cache-active-file
|
|
0
|
581 (mapatoms
|
|
|
582 (lambda (sym)
|
|
|
583 (when (and sym (boundp sym))
|
|
|
584 (insert (format "%s %d %d y\n"
|
|
|
585 (symbol-name sym) (cdr (symbol-value sym))
|
|
|
586 (car (symbol-value sym))))))
|
|
98
|
587 gnus-cache-active-hashtb))
|
|
0
|
588 ;; Mark the active hashtb as unaltered.
|
|
|
589 (setq gnus-cache-active-altered nil)))
|
|
|
590
|
|
|
591 (defun gnus-cache-update-active (group number &optional low)
|
|
|
592 "Update the upper bound of the active info of GROUP to NUMBER.
|
|
|
593 If LOW, update the lower bound instead."
|
|
|
594 (let ((active (gnus-gethash group gnus-cache-active-hashtb)))
|
|
|
595 (if (null active)
|
|
|
596 ;; We just create a new active entry for this group.
|
|
|
597 (gnus-sethash group (cons number number) gnus-cache-active-hashtb)
|
|
|
598 ;; Update the lower or upper bound.
|
|
|
599 (if low
|
|
|
600 (setcar active number)
|
|
98
|
601 (setcdr active number)))
|
|
|
602 ;; Mark the active hashtb as altered.
|
|
|
603 (setq gnus-cache-active-altered t)))
|
|
0
|
604
|
|
|
605 ;;;###autoload
|
|
|
606 (defun gnus-cache-generate-active (&optional directory)
|
|
|
607 "Generate the cache active file."
|
|
|
608 (interactive)
|
|
|
609 (let* ((top (null directory))
|
|
|
610 (directory (expand-file-name (or directory gnus-cache-directory)))
|
|
|
611 (files (directory-files directory 'full))
|
|
108
|
612 (group
|
|
0
|
613 (if top
|
|
|
614 ""
|
|
108
|
615 (string-match
|
|
0
|
616 (concat "^" (file-name-as-directory
|
|
|
617 (expand-file-name gnus-cache-directory)))
|
|
|
618 (directory-file-name directory))
|
|
108
|
619 (nnheader-replace-chars-in-string
|
|
0
|
620 (substring (directory-file-name directory) (match-end 0))
|
|
|
621 ?/ ?.)))
|
|
|
622 nums alphs)
|
|
|
623 (when top
|
|
|
624 (gnus-message 5 "Generating the cache active file...")
|
|
|
625 (setq gnus-cache-active-hashtb (gnus-make-hashtable 123)))
|
|
|
626 ;; Separate articles from all other files and directories.
|
|
|
627 (while files
|
|
|
628 (if (string-match "^[0-9]+$" (file-name-nondirectory (car files)))
|
|
|
629 (push (string-to-int (file-name-nondirectory (pop files))) nums)
|
|
|
630 (push (pop files) alphs)))
|
|
|
631 ;; If we have nums, then this is probably a valid group.
|
|
|
632 (when (setq nums (sort nums '<))
|
|
|
633 (gnus-sethash group (cons (car nums) (gnus-last-element nums))
|
|
|
634 gnus-cache-active-hashtb))
|
|
|
635 ;; Go through all the other files.
|
|
|
636 (while alphs
|
|
|
637 (when (and (file-directory-p (car alphs))
|
|
|
638 (not (string-match "^\\.\\.?$"
|
|
|
639 (file-name-nondirectory (car alphs)))))
|
|
|
640 ;; We descend directories.
|
|
|
641 (gnus-cache-generate-active (car alphs)))
|
|
|
642 (setq alphs (cdr alphs)))
|
|
|
643 ;; Write the new active file.
|
|
|
644 (when top
|
|
|
645 (gnus-cache-write-active t)
|
|
|
646 (gnus-message 5 "Generating the cache active file...done"))))
|
|
|
647
|
|
|
648 ;;;###autoload
|
|
|
649 (defun gnus-cache-generate-nov-databases (dir)
|
|
|
650 "Generate NOV files recursively starting in DIR."
|
|
|
651 (interactive (list gnus-cache-directory))
|
|
|
652 (gnus-cache-close)
|
|
|
653 (let ((nnml-generate-active-function 'identity))
|
|
|
654 (nnml-generate-nov-databases-1 dir)))
|
|
|
655
|
|
98
|
656 (defun gnus-cache-move-cache (dir)
|
|
|
657 "Move the cache tree to somewhere else."
|
|
140
|
658 (interactive "FMove the cache tree to: ")
|
|
98
|
659 (rename-file gnus-cache-directory dir))
|
|
|
660
|
|
0
|
661 (provide 'gnus-cache)
|
|
108
|
662
|
|
0
|
663 ;;; gnus-cache.el ends here
|
