X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-cache.el;h=207f096ea6ec37fb28cae31f3bba3371b01e77dc;hb=9b741e050b400987d68ff761c6cc3276c932839c;hp=574821e492cc13dce9e3512c64658f7eacaa7656;hpb=3738187cad20787b5b99c4061256e30e19ee721a;p=elisp%2Fgnus.git- diff --git a/lisp/gnus-cache.el b/lisp/gnus-cache.el index 574821e..207f096 100644 --- a/lisp/gnus-cache.el +++ b/lisp/gnus-cache.el @@ -1,8 +1,10 @@ ;;; gnus-cache.el --- cache interface for Gnus -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001 +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen +;; Tatsuya Ichikawa +;; MORIOKA Tomohiko ;; Keywords: news ;; This file is part of GNU Emacs. @@ -27,6 +29,7 @@ ;;; Code: (eval-when-compile (require 'cl)) +(eval-when-compile (require 'gnus-clfns)) (require 'gnus) (require 'gnus-int) @@ -89,6 +92,7 @@ it's not cached." (defvar gnus-cache-buffer nil) (defvar gnus-cache-active-hashtb nil) (defvar gnus-cache-active-altered nil) +(defvar gnus-cache-write-file-coding-system 'raw-text) (eval-and-compile (autoload 'nnml-generate-nov-databases-1 "nnml") @@ -128,9 +132,8 @@ it's not cached." (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)) @@ -146,11 +149,12 @@ it's not cached." (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) + (> article 0) ; This might be a dummy article. + (vectorp headers)) + (let ((number article) file) ;; If this is a virtual group, we find the real group. (when (gnus-virtual-group-p group) (let ((result (nnvirtual-find-group-art @@ -177,8 +181,8 @@ it's not cached." (gnus-article-decode-hook nil)) (gnus-request-article-this-buffer number group)) (when (> (buffer-size) 0) - (let ((coding-system-for-write gnus-cache-coding-system)) - (gnus-write-buffer file)) + (gnus-write-buffer-as-coding-system + gnus-cache-write-file-coding-system file) (setq headers (nnheader-parse-head t)) (mail-header-set-number headers number) (gnus-cache-change-buffer group) @@ -206,7 +210,8 @@ it's not cached." ;; Update the active info. (set-buffer gnus-summary-buffer) (gnus-cache-possibly-update-active group (cons number number)) - (push article gnus-newsgroup-cached) + (setq gnus-newsgroup-cached + (gnus-add-to-sorted-list gnus-newsgroup-cached article)) (gnus-summary-update-secondary-mark article)) t)))))) @@ -256,8 +261,8 @@ it's not cached." (when (file-exists-p file) (erase-buffer) (gnus-kill-all-overlays) - (let ((coding-system-for-read gnus-cache-coding-system)) - (insert-file-contents file)) + (let ((nnheader-file-coding-system gnus-cache-coding-system)) + (nnheader-insert-file-contents file)) t))) (defun gnus-cache-possibly-alter-active (group active) @@ -279,9 +284,7 @@ it's not cached." ;; the normal way. (let ((gnus-use-cache nil)) (gnus-retrieve-headers articles group fetch-old)) - (let ((uncached-articles (gnus-sorted-intersection - (gnus-sorted-complement articles cached) - articles)) + (let ((uncached-articles (gnus-sorted-difference articles cached)) (cache-file (gnus-cache-file-name group ".overview")) type) ;; We first retrieve all the headers that we don't have in @@ -303,9 +306,9 @@ it's not cached." ;; unsuccessful), so we use the cached headers exclusively. (set-buffer nntp-server-buffer) (erase-buffer) - (let ((coding-system-for-read + (let ((nnheader-file-coding-system 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 @@ -330,6 +333,7 @@ Returns the list of articles entered." (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)) @@ -338,7 +342,7 @@ Returns the list of articles entered." (gnus-summary-position-point) (nreverse out))) -(defun gnus-cache-remove-article (n) +(defun gnus-cache-remove-article (&optional n) "Remove the next N articles from the cache. If not given a prefix, use the process marked articles instead. Returns the list of articles removed." @@ -363,23 +367,25 @@ Returns the list of articles removed." (defun gnus-summary-insert-cached-articles () "Insert all the articles cached for this group into the current buffer." (interactive) - (let ((cached (sort (copy-sequence gnus-newsgroup-cached) '>)) + (let ((cached gnus-newsgroup-cached) (gnus-verbose (max 6 gnus-verbose))) - (unless cached - (gnus-message 3 "No cached articles for this group")) - (while cached - (gnus-summary-goto-subject (pop cached) t)))) + (if (not cached) + (gnus-message 3 "No cached articles for this group") + (save-excursion + (while cached + (gnus-summary-goto-subject (pop cached) t))) + (gnus-summary-limit (append gnus-newsgroup-cached gnus-newsgroup-limit)) + (gnus-summary-position-point)))) (defun gnus-summary-limit-include-cached () "Limit the summary buffer to articles that are cached." (interactive) - (let ((cached (sort (copy-sequence gnus-newsgroup-cached) '>)) - (gnus-verbose (max 6 gnus-verbose))) - (if cached - (progn - (gnus-summary-limit cached) - (gnus-summary-position-point)) - (gnus-message 3 "No cached articles for this group")))) + (let ((gnus-verbose (max 6 gnus-verbose))) + (if gnus-newsgroup-cached + (progn + (gnus-summary-limit gnus-newsgroup-cached) + (gnus-summary-position-point)) + (gnus-message 3 "No cached articles for this group")))) ;;; Internal functions. @@ -426,8 +432,8 @@ Returns the list of articles removed." ?. ?_))) ;; Translate the first colon into a slash. (when (string-match ":" group) - (setq group (concat (substring group 0 (match-beginning 0)) - "/" (substring group (match-end 0))))) + (setq group (concat (substring group 0 (match-beginning 0)) + "/" (substring group (match-end 0))))) (nnheader-replace-chars-in-string group ?. ?/))) t) gnus-cache-directory)))) @@ -438,7 +444,7 @@ Returns the list of articles removed." (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 @@ -467,8 +473,10 @@ Returns the list of articles removed." (point-max) t)) (delete-region (progn (beginning-of-line) (point)) (progn (forward-line 1) (point))))) - (setq gnus-newsgroup-cached - (delq article gnus-newsgroup-cached)) + (unless (setq gnus-newsgroup-cached + (delq article gnus-newsgroup-cached)) + (gnus-sethash gnus-newsgroup-name nil gnus-cache-active-hashtb) + (setq gnus-cache-active-altered t)) (gnus-summary-update-secondary-mark article) t))) @@ -482,9 +490,13 @@ Returns the list of articles removed." (directory-files dir nil "^[0-9]+$" t)) '<)) ;; Update the cache active file, just to synch more. - (when articles - (gnus-cache-update-active group (car articles) t) - (gnus-cache-update-active group (car (last articles)))) + (if articles + (progn + (gnus-cache-update-active group (car articles) t) + (gnus-cache-update-active group (car (last articles)))) + (when (gnus-gethash group gnus-cache-active-hashtb) + (gnus-sethash group nil gnus-cache-active-hashtb) + (setq gnus-cache-active-altered t))) articles))) (defun gnus-cache-braid-nov (group cached &optional file) @@ -494,9 +506,8 @@ Returns the list of articles removed." (save-excursion (set-buffer cache-buf) (erase-buffer) - (let ((coding-system-for-read - gnus-cache-overview-coding-system)) - (insert-file-contents + (let ((nnheader-file-coding-system gnus-cache-overview-coding-system)) + (nnheader-insert-file-contents (or file (gnus-cache-file-name group ".overview")))) (goto-char (point-min)) (insert "\n") @@ -508,13 +519,13 @@ Returns the list of articles removed." (< (read (current-buffer)) (car cached))) (forward-line 1)) (beginning-of-line) - (save-excursion - (set-buffer cache-buf) - (if (search-forward (concat "\n" (int-to-string (car cached)) "\t") - nil t) - (setq beg (progn (beginning-of-line) (point)) - end (progn (end-of-line) (point))) - (setq beg nil))) + (set-buffer cache-buf) + (if (search-forward (concat "\n" (int-to-string (car cached)) "\t") + nil t) + (setq beg (progn (beginning-of-line) (point)) + end (progn (end-of-line) (point))) + (setq beg nil)) + (set-buffer nntp-server-buffer) (when beg (insert-buffer-substring cache-buf beg end) (insert "\n")) @@ -539,9 +550,9 @@ Returns the list of articles removed." (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)))) + (let ((nnheader-file-coding-system gnus-cache-coding-system)) + (nnheader-insert-file-contents + (gnus-cache-file-name group (car cached)))) (goto-char (point-min)) (insert "220 ") (princ (car cached) (current-buffer)) @@ -713,7 +724,6 @@ If GROUP is non-nil, also cater to `gnus-cacheable-groups' and (string-match gnus-cacheable-groups group)) (or (not gnus-uncacheable-groups) (not (string-match gnus-uncacheable-groups group))))))) - (provide 'gnus-cache)