Lines Matching +defs:gnus +defs:article +defs:buffer
0 ;;; gnus-cache.el --- cache interface for Gnus
6 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
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)
44 :group 'gnus-cache
47 (defcustom gnus-cache-enter-articles '(ticked dormant)
49 :group 'gnus-cache
52 (defcustom gnus-cache-remove-articles '(read)
54 :group 'gnus-cache
57 (defcustom gnus-cacheable-groups nil
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
84 (defvar gnus-cache-coding-system 'raw-text
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 ()
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 ()
119 (gnus-cache-write-active)
120 (gnus-cache-save-buffers)
121 (setq gnus-cache-active-hashtb nil))
123 (defun gnus-cache-save-buffers ()
124 ;; save the overview buffer if it exists and has been modified
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")))
131 (when (and (buffer-live-p buffer) (buffer-modified-p buffer))
132 (with-current-buffer buffer
133 (if (> (buffer-size) 0)
136 gnus-cache-overview-coding-system))
137 (gnus-write-buffer overview-file))
148 ;; Kill the buffer -- it's either unmodified or saved.
149 (gnus-kill-buffer buffer)
150 (setq gnus-cache-buffer nil))))
152 (defun gnus-cache-possibly-enter-article
153 (group article ticked dormant unread &optional force)
154 (when (and (or force (not (eq gnus-use-cache 'passive)))
155 (numberp article)
156 (> article 0)) ; This might be a dummy article.
157 (let ((number article) file headers)
159 (when (gnus-virtual-group-p group)
161 (gnus-group-real-name group) article)))
165 (> number 0) ; Reffed 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
173 (gnus-make-directory (file-name-directory file))
174 ;; Save the article in the cache.
176 t ; The article already is saved.
178 (set-buffer nntp-server-buffer)
179 (require 'gnus-art)
180 (let ((gnus-use-cache nil)
181 (gnus-article-decode-hook nil))
182 (gnus-request-article-this-buffer number group))
183 (when (> (buffer-size) 0)
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))
195 (> (read (current-buffer)) number))
198 (gnus-delete-line)
205 (when (< (read (current-buffer)) number)
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)
221 (when 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)
243 article)
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
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)
260 (let ((file (gnus-cache-file-name group article))
261 (buffer-read-only nil))
263 (erase-buffer)
264 (gnus-kill-all-overlays)
265 (let ((coding-system-for-read gnus-cache-coding-system))
269 (defun gnus-cache-possibly-alter-active (group active)
271 (when gnus-cache-active-hashtb
272 (let ((cache-active (gnus-gethash group gnus-cache-active-hashtb)))
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"))
293 (let ((gnus-use-cache nil))
296 (gnus-retrieve-headers
298 (gnus-cache-save-buffers)
308 (set-buffer nntp-server-buffer)
309 (erase-buffer)
311 gnus-cache-overview-coding-system))
317 (gnus-cache-braid-nov group cached)
321 (gnus-cache-braid-heads group (gnus-sorted-intersection
325 (defun gnus-cache-enter-article (&optional n)
330 (let ((articles (gnus-summary-work-articles n))
331 article out)
332 (while (setq article (pop articles))
333 (gnus-summary-remove-process-mark article)
334 (if (natnump article)
335 (when (gnus-cache-possibly-enter-article
336 gnus-newsgroup-name article
338 (setq gnus-newsgroup-undownloaded (delq article gnus-newsgroup-undownloaded))
339 (push article out))
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)
352 (gnus-cache-change-buffer gnus-newsgroup-name)
353 (let ((articles (gnus-summary-work-articles n))
354 article out)
356 (setq article (pop articles))
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)))
361 (unless (cdr (assoc article alist))
362 (setq gnus-newsgroup-undownloaded
363 (gnus-add-to-sorted-list
364 gnus-newsgroup-undownloaded article)))))
365 (push article out))
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 ()
377 "Insert all the articles cached for this group into the current buffer."
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 ()
385 "Limit the summary buffer to articles that are 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
399 (or (string= group (car gnus-cache-buffer))
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*"))))
411 (erase-buffer)
412 (let ((file (gnus-cache-file-name group ".overview")))
415 ;; We have a fresh (empty/just loaded) buffer,
417 (set-buffer-modified-p nil))))
419 ;; Return whether an article is a member of a class.
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))
429 (if (stringp article) article (int-to-string article))
433 (if (gnus-use-long-file-name 'not-cache)
444 gnus-cache-directory))))
446 (defun gnus-cache-update-article (group article)
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
458 (let ((group gnus-newsgroup-name)
459 (number article)
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)))
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)
512 (erase-buffer)
514 gnus-cache-overview-coding-system))
516 (or file (gnus-cache-file-name group ".overview"))))
520 (set-buffer nntp-server-buffer)
524 (< (read (current-buffer)) (car cached)))
527 (set-buffer cache-buf)
530 (setq beg (gnus-point-at-bol)
533 (set-buffer nntp-server-buffer)
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)
544 (erase-buffer))
545 (set-buffer nntp-server-buffer)
551 (read (current-buffer)))
555 (set-buffer cache-buf)
556 (erase-buffer)
558 gnus-cache-coding-system))
559 (insert-file-contents (gnus-cache-file-name group (car cached))))
562 (princ (car cached) (current-buffer))
568 (set-buffer nntp-server-buffer)
569 (insert-buffer-substring cache-buf)
571 (kill-buffer cache-buf)))
574 (defun gnus-jog-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)
596 (when (eq major-mode 'gnus-summary-mode)
597 (gnus-uu-mark-buffer)
598 (gnus-cache-enter-article)
599 (kill-buffer (current-buffer))))))))
601 (defun gnus-cache-read-active (&optional force)
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)))
608 (gnus-cache-generate-active)
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)
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)
626 (setq gnus-cache-active-altered nil)))
628 (defun gnus-cache-possibly-update-active (group active)
633 (if gnus-cache-active-hashtb
634 (let ((cache-active (gnus-gethash group gnus-cache-active-hashtb)))
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)
649 (let ((active (gnus-gethash group gnus-cache-active-hashtb)))
652 (gnus-sethash group (cons number number) gnus-cache-active-hashtb)
658 (setq gnus-cache-active-altered t)))
661 (defun gnus-cache-generate-active (&optional directory)
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)))
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)
713 (gnus-cache-open))
715 (defun gnus-cache-move-cache (dir)
718 (rename-file gnus-cache-directory dir))
720 (defun gnus-cache-fully-p (&optional group)
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)
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)
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