Lines Matching +defs:gnus +defs:cache +defs:write +defs:active
0 ;;; gnus-cache.el --- cache interface for Gnus
6 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
32 (require 'gnus)
33 (require 'gnus-int)
34 (require 'gnus-range)
35 (require 'gnus-start)
37 (if (not (fboundp 'gnus-agent-load-alist))
38 (defun gnus-agent-load-alist (group)))
39 (require 'gnus-sum))
41 (defcustom gnus-cache-active-file
42 (expand-file-name "active" gnus-cache-directory)
43 "*The cache active file."
44 :group 'gnus-cache
47 (defcustom gnus-cache-enter-articles '(ticked dormant)
48 "Classes of articles to enter into the cache."
49 :group 'gnus-cache
52 (defcustom gnus-cache-remove-articles '(read)
53 "Classes of articles to remove from the cache."
54 :group 'gnus-cache
57 (defcustom gnus-cacheable-groups nil
60 If you only want to cache your nntp groups, you could set this
63 If a group matches both gnus-cacheable-groups and gnus-uncacheable-groups
65 :group 'gnus-cache
69 (defcustom gnus-uncacheable-groups nil
75 If a group matches both gnus-cacheable-groups and gnus-uncacheable-groups
77 :group 'gnus-cache
81 (defvar gnus-cache-overview-coding-system 'raw-text
82 "Coding system used on Gnus cache files.")
84 (defvar gnus-cache-coding-system 'raw-text
85 "Coding system used on Gnus cache files.")
92 (defvar gnus-cache-removable-articles nil)
93 (defvar gnus-cache-buffer nil)
94 (defvar gnus-cache-active-hashtb nil)
95 (defvar gnus-cache-active-altered nil)
106 (defun gnus-cache-open ()
107 "Initialize the cache."
108 (when (or (file-exists-p gnus-cache-directory)
109 (and gnus-use-cache
110 (not (eq gnus-use-cache 'passive))))
111 (gnus-cache-read-active)))
115 (gnus-add-shutdown 'gnus-cache-close 'gnus))
117 (defun gnus-cache-close ()
118 "Shut down the cache."
119 (gnus-cache-write-active)
120 (gnus-cache-save-buffers)
121 (setq gnus-cache-active-hashtb nil))
123 (defun gnus-cache-save-buffers ()
125 ;; delete empty cache subdirectories
126 (when gnus-cache-buffer
127 (let ((buffer (cdr gnus-cache-buffer))
128 (overview-file (gnus-cache-file-name
129 (car gnus-cache-buffer) ".overview")))
130 ;; write the overview only if it was modified
134 ;; Non-empty overview, write it to a file.
135 (let ((coding-system-for-write
136 gnus-cache-overview-coding-system))
137 (gnus-write-buffer overview-file))
141 ;; If possible, remove group's cache subdirectory.
149 (gnus-kill-buffer buffer)
150 (setq gnus-cache-buffer nil))))
152 (defun gnus-cache-possibly-enter-article
154 (when (and (or force (not (eq gnus-use-cache 'passive)))
159 (when (gnus-virtual-group-p group)
161 (gnus-group-real-name group) article)))
167 (and (gnus-cache-fully-p group)
168 (gnus-cache-member-of-class
169 gnus-cache-enter-articles ticked dormant unread)))
170 (not (file-exists-p (setq file (gnus-cache-file-name
172 ;; Possibly create the cache directory.
173 (gnus-make-directory (file-name-directory file))
174 ;; Save the article in the cache.
179 (require 'gnus-art)
180 (let ((gnus-use-cache nil)
181 (gnus-article-decode-hook nil))
182 (gnus-request-article-this-buffer number group))
184 (let ((coding-system-for-write gnus-cache-coding-system))
185 (gnus-write-buffer file))
189 (gnus-cache-change-buffer group)
190 (set-buffer (cdr gnus-cache-buffer))
198 (gnus-delete-line)
211 ;; Update the active info.
212 (set-buffer gnus-summary-buffer)
213 (gnus-cache-possibly-update-active group (cons number number))
214 (setq gnus-newsgroup-cached
215 (gnus-add-to-sorted-list gnus-newsgroup-cached article))
216 (gnus-summary-update-secondary-mark article))
219 (defun gnus-cache-enter-remove-article (article)
222 (push article gnus-cache-removable-articles)))
224 (defun gnus-cache-possibly-remove-articles ()
226 (if (not (gnus-virtual-group-p gnus-newsgroup-name))
227 (gnus-cache-possibly-remove-articles-1)
228 (let ((arts gnus-cache-removable-articles)
232 (gnus-group-real-name gnus-newsgroup-name) (pop arts)))
233 (let ((gnus-cache-removable-articles (list (cdr ga)))
234 (gnus-newsgroup-name (car ga)))
235 (gnus-cache-possibly-remove-articles-1)))))
236 (setq gnus-cache-removable-articles nil)))
238 (defun gnus-cache-possibly-remove-articles-1 ()
240 (when (gnus-cache-fully-p gnus-newsgroup-name)
241 (let ((articles gnus-cache-removable-articles)
242 (cache-articles gnus-newsgroup-cached)
244 (gnus-cache-change-buffer gnus-newsgroup-name)
246 (when (memq (setq article (pop articles)) cache-articles)
247 ;; The article was in the cache, so we see whether we are
248 ;; supposed to remove it from the cache.
249 (gnus-cache-possibly-remove-article
250 article (memq article gnus-newsgroup-marked)
251 (memq article gnus-newsgroup-dormant)
252 (or (memq article gnus-newsgroup-unreads)
253 (memq article gnus-newsgroup-unselected))))))
256 (gnus-cache-save-buffers)))
258 (defun gnus-cache-request-article (article group)
259 "Retrieve ARTICLE in GROUP from the cache."
260 (let ((file (gnus-cache-file-name group article))
264 (gnus-kill-all-overlays)
265 (let ((coding-system-for-read gnus-cache-coding-system))
269 (defun gnus-cache-possibly-alter-active (group active)
270 "Alter the ACTIVE info for GROUP to reflect the articles in the cache."
271 (when gnus-cache-active-hashtb
272 (let ((cache-active (gnus-gethash group gnus-cache-active-hashtb)))
273 (when cache-active
274 (when (< (car cache-active) (car active))
275 (setcar active (car cache-active)))
276 (when (> (cdr cache-active) (cdr active))
277 (setcdr active (cdr cache-active)))))))
279 (defun gnus-cache-retrieve-headers (articles group &optional fetch-old)
282 (setq gnus-newsgroup-cached (gnus-cache-articles-in-group group))))
286 (let ((gnus-use-cache nil))
287 (gnus-retrieve-headers articles group fetch-old))
288 (let ((uncached-articles (gnus-sorted-difference articles cached))
289 (cache-file (gnus-cache-file-name group ".overview"))
292 ;; the cache.
293 (let ((gnus-use-cache nil))
296 (gnus-retrieve-headers
298 (gnus-cache-save-buffers)
302 ((not (file-exists-p cache-file))
311 gnus-cache-overview-coding-system))
312 (insert-file-contents cache-file))
317 (gnus-cache-braid-nov group cached)
321 (gnus-cache-braid-heads group (gnus-sorted-intersection
325 (defun gnus-cache-enter-article (&optional n)
326 "Enter the next N articles into the cache.
330 (let ((articles (gnus-summary-work-articles n))
333 (gnus-summary-remove-process-mark article)
335 (when (gnus-cache-possibly-enter-article
336 gnus-newsgroup-name article
338 (setq gnus-newsgroup-undownloaded (delq article gnus-newsgroup-undownloaded))
340 (gnus-message 2 "Can't cache article %d" article))
341 (gnus-summary-update-download-mark article)
342 (gnus-summary-update-secondary-mark article))
343 (gnus-summary-next-subject 1)
344 (gnus-summary-position-point)
347 (defun gnus-cache-remove-article (&optional n)
348 "Remove the next N articles from the cache.
352 (gnus-cache-change-buffer gnus-newsgroup-name)
353 (let ((articles (gnus-summary-work-articles n))
357 (gnus-summary-remove-process-mark article)
358 (when (gnus-cache-possibly-remove-article article nil nil nil t)
359 (when gnus-newsgroup-agentized
360 (let ((alist (gnus-agent-load-alist gnus-newsgroup-name)))
362 (setq gnus-newsgroup-undownloaded
363 (gnus-add-to-sorted-list
364 gnus-newsgroup-undownloaded article)))))
366 (gnus-summary-update-download-mark article)
367 (gnus-summary-update-secondary-mark article))
368 (gnus-summary-next-subject 1)
369 (gnus-summary-position-point)
372 (defun gnus-cached-article-p (article)
374 (memq article gnus-newsgroup-cached))
376 (defun gnus-summary-insert-cached-articles ()
379 (let ((gnus-verbose (max 6 gnus-verbose)))
380 (if (not gnus-newsgroup-cached)
381 (gnus-message 3 "No cached articles for this group")
382 (gnus-summary-goto-subjects gnus-newsgroup-cached))))
384 (defun gnus-summary-limit-include-cached ()
387 (let ((gnus-verbose (max 6 gnus-verbose)))
388 (if gnus-newsgroup-cached
390 (gnus-summary-limit gnus-newsgroup-cached)
391 (gnus-summary-position-point))
392 (gnus-message 3 "No cached articles for this group"))))
396 (defun gnus-cache-change-buffer (group)
397 (and gnus-cache-buffer
398 ;; See if the current group's overview cache has been loaded.
399 (or (string= group (car gnus-cache-buffer))
400 ;; Another overview cache is current, save it.
401 (gnus-cache-save-buffers)))
402 ;; if gnus-cache buffer is nil, create it
403 (unless gnus-cache-buffer
404 ;; Create cache buffer
406 (setq gnus-cache-buffer
408 (set-buffer (gnus-get-buffer-create
409 " *gnus-cache-overview*"))))
410 ;; Insert the contents of this group's cache overview.
412 (let ((file (gnus-cache-file-name group ".overview")))
416 ;; mark it as unmodified to save a redundant write later.
420 (defun gnus-cache-member-of-class (class ticked dormant unread)
426 (defun gnus-cache-file-name (group article)
427 (setq group (gnus-group-decoded-name group))
433 (if (gnus-use-long-file-name 'not-cache)
444 gnus-cache-directory))))
446 (defun gnus-cache-update-article (group article)
447 "If ARTICLE is in the cache, remove it and re-enter it."
448 (gnus-cache-change-buffer group)
449 (when (gnus-cache-possibly-remove-article article nil nil nil t)
450 (let ((gnus-use-cache nil))
451 (gnus-cache-possibly-enter-article
452 gnus-newsgroup-name article
455 (defun gnus-cache-possibly-remove-article (article ticked dormant unread
457 "Possibly remove ARTICLE from the cache."
458 (let ((group gnus-newsgroup-name)
462 (when (gnus-virtual-group-p group)
464 (gnus-group-real-name group) article)))
467 (setq file (gnus-cache-file-name group number))
470 (gnus-cache-member-of-class
471 gnus-cache-remove-articles ticked dormant unread)))
474 (set-buffer (cdr gnus-cache-buffer))
479 (gnus-delete-line)))
480 (unless (setq gnus-newsgroup-cached
481 (delq article gnus-newsgroup-cached))
482 (gnus-sethash gnus-newsgroup-name nil gnus-cache-active-hashtb)
483 (setq gnus-cache-active-altered t))
484 (gnus-summary-update-secondary-mark article)
487 (defun gnus-cache-articles-in-group (group)
489 (let ((dir (file-name-directory (gnus-cache-file-name group 1)))
496 ;; Update the cache active file, just to synch more.
499 (gnus-cache-update-active group (car articles) t)
500 (gnus-cache-update-active group (car (last articles))))
501 (when (gnus-gethash group gnus-cache-active-hashtb)
502 (gnus-sethash group nil gnus-cache-active-hashtb)
503 (setq gnus-cache-active-altered t)))
506 (defun gnus-cache-braid-nov (group cached &optional file)
507 (let ((cache-buf (gnus-get-buffer-create " *gnus-cache*"))
509 (gnus-cache-save-buffers)
511 (set-buffer cache-buf)
514 gnus-cache-overview-coding-system))
516 (or file (gnus-cache-file-name group ".overview"))))
527 (set-buffer cache-buf)
530 (setq beg (gnus-point-at-bol)
535 (insert-buffer-substring cache-buf beg end)
538 (kill-buffer cache-buf)))
540 (defun gnus-cache-braid-heads (group cached)
541 (let ((cache-buf (gnus-get-buffer-create " *gnus-cache*")))
543 (set-buffer cache-buf)
555 (set-buffer cache-buf)
558 gnus-cache-coding-system))
559 (insert-file-contents (gnus-cache-file-name group (car cached))))
569 (insert-buffer-substring cache-buf)
571 (kill-buffer cache-buf)))
574 (defun gnus-jog-cache ()
575 "Go through all groups and put the articles into the cache.
578 $ emacs -batch -l ~/.emacs -l gnus -f gnus-jog-cache"
580 (let ((gnus-mark-article-hook nil)
581 (gnus-expert-user t)
584 (gnus-use-dribble-file nil)
585 (gnus-novice-user nil)
586 (gnus-large-newsgroup nil))
588 (gnus)
590 (gnus-group-mark-buffer)
591 (gnus-group-iterate nil
593 (let (gnus-auto-select-next)
594 (gnus-summary-read-group group nil t)
595 ;; ... and enter the articles into the cache.
596 (when (eq major-mode 'gnus-summary-mode)
597 (gnus-uu-mark-buffer)
598 (gnus-cache-enter-article)
601 (defun gnus-cache-read-active (&optional force)
602 "Read the cache active file."
603 (gnus-make-directory gnus-cache-directory)
604 (if (or (not (file-exists-p gnus-cache-active-file))
605 (zerop (nth 7 (file-attributes gnus-cache-active-file)))
607 ;; There is no active file, so we generate one.
608 (gnus-cache-generate-active)
609 ;; We simply read the active file.
611 (gnus-set-work-buffer)
612 (nnheader-insert-file-contents gnus-cache-active-file)
613 (gnus-active-to-gnus-format
614 nil (setq gnus-cache-active-hashtb
615 (gnus-make-hashtable
617 (setq gnus-cache-active-altered nil))))
619 (defun gnus-cache-write-active (&optional force)
620 "Write the active hashtb to the active file."
622 (and gnus-cache-active-hashtb
623 gnus-cache-active-altered))
624 (gnus-write-active-file gnus-cache-active-file gnus-cache-active-hashtb t)
625 ;; Mark the active hashtb as unaltered.
626 (setq gnus-cache-active-altered nil)))
628 (defun gnus-cache-possibly-update-active (group active)
629 "Update active info bounds of GROUP with ACTIVE if necessary.
633 (if gnus-cache-active-hashtb
634 (let ((cache-active (gnus-gethash group gnus-cache-active-hashtb)))
635 (when cache-active
636 (unless (< (car active) (car cache-active))
638 (unless (> (cdr active) (cdr cache-active))
640 (gnus-cache-read-active))
642 (gnus-cache-update-active group (car active) t))
644 (gnus-cache-update-active group (cdr active)))))
646 (defun gnus-cache-update-active (group number &optional low)
647 "Update the upper bound of the active info of GROUP to NUMBER.
649 (let ((active (gnus-gethash group gnus-cache-active-hashtb)))
650 (if (null active)
651 ;; We just create a new active entry for this group.
652 (gnus-sethash group (cons number number) gnus-cache-active-hashtb)
655 (setcar active number)
656 (setcdr active number)))
657 ;; Mark the active hashtb as altered.
658 (setq gnus-cache-active-altered t)))
661 (defun gnus-cache-generate-active (&optional directory)
662 "Generate the cache active file."
665 (directory (expand-file-name (or directory gnus-cache-directory)))
673 (expand-file-name gnus-cache-directory))))
680 (gnus-message 5 "Generating the cache active file...")
681 (setq gnus-cache-active-hashtb (gnus-make-hashtable 123)))
691 (gnus-sethash group (cons (car nums) (gnus-last-element nums))
692 gnus-cache-active-hashtb))
699 (gnus-cache-generate-active (car alphs)))
701 ;; Write the new active file.
703 (gnus-cache-write-active t)
704 (gnus-message 5 "Generating the cache active file...done"))))
707 (defun gnus-cache-generate-nov-databases (dir)
709 (interactive (list gnus-cache-directory))
710 (gnus-cache-close)
711 (let ((nnml-generate-active-function 'identity))
713 (gnus-cache-open))
715 (defun gnus-cache-move-cache (dir)
716 "Move the cache tree to somewhere else."
717 (interactive "FMove the cache tree to: ")
718 (rename-file gnus-cache-directory dir))
720 (defun gnus-cache-fully-p (&optional group)
721 "Returns non-nil if the cache should be fully used.
722 If GROUP is non-nil, also cater to `gnus-cacheable-groups' and
723 `gnus-uncacheable-groups'."
724 (and gnus-use-cache
725 (not (eq gnus-use-cache 'passive))
728 (and (or (not gnus-cacheable-groups)
729 (string-match gnus-cacheable-groups group))
730 (or (not gnus-uncacheable-groups)
731 (not (string-match gnus-uncacheable-groups group)))))))
734 (defun gnus-cache-rename-group (old-group new-group)
736 Always updates the cache, even when disabled, as the old cache
737 files would corrupt Gnus when the cache was next enabled. It
740 (let ((old-dir (gnus-cache-file-name old-group ""))
741 (new-dir (gnus-cache-file-name new-group "")))
742 (gnus-rename-file old-dir new-dir t))
744 (let ((no-save gnus-cache-active-hashtb))
745 (unless gnus-cache-active-hashtb
746 (gnus-cache-read-active))
748 (gnus-gethash old-group gnus-cache-active-hashtb))
750 (gnus-gethash new-group gnus-cache-active-hashtb))
753 (gnus-sethash new-group old-group-hash-value gnus-cache-active-hashtb)
754 (gnus-sethash old-group nil gnus-cache-active-hashtb)
757 (setq gnus-cache-active-altered delta)
758 (gnus-cache-write-active delta)))))
761 (defun gnus-cache-delete-group (group)
762 "Delete GROUP from the cache.
763 Always updates the cache, even when disabled, as the old cache
764 files would corrupt gnus when the cache was next enabled.
767 (let ((dir (gnus-cache-file-name group "")))
768 (gnus-delete-directory dir))
770 (let ((no-save gnus-cache-active-hashtb))
771 (unless gnus-cache-active-hashtb
772 (gnus-cache-read-active))
773 (let* ((group-hash-value (gnus-gethash group gnus-cache-active-hashtb)))
774 (gnus-sethash group nil gnus-cache-active-hashtb)
777 (setq gnus-cache-active-altered group-hash-value)
778 (gnus-cache-write-active group-hash-value)))))
780 (provide 'gnus-cache)
783 ;;; gnus-cache.el ends here