X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-cache.el;h=436baadcc67bcd59fd644ed07507e6ff0525479d;hb=ed341c45e5e97c823e86a642b7136a140f2af6f3;hp=0cc99b5716c2c9f446d02e83418d32f5521a0dce;hpb=3304290c446e3fd89151ebe599b3c0cea8522329;p=elisp%2Fgnus.git- diff --git a/lisp/gnus-cache.el b/lisp/gnus-cache.el index 0cc99b5..436baad 100644 --- a/lisp/gnus-cache.el +++ b/lisp/gnus-cache.el @@ -1,5 +1,5 @@ ;;; gnus-cache.el --- cache interface for Gnus -;; Copyright (C) 1995,96,97,98,99 Free Software Foundation, Inc. +;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news @@ -77,9 +77,6 @@ it's not cached." (defvar gnus-cache-overview-coding-system 'raw-text "Coding system used on Gnus cache files.") -(defvar gnus-cache-coding-system 'raw-text - "Coding system used on Gnus cache files.") - ;;; Internal variables. @@ -127,9 +124,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)) @@ -145,17 +141,20 @@ 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) - ;; If this is a virtual group, we find the real group. - (when (gnus-virtual-group-p group) - (let ((result (nnvirtual-find-group-art - (gnus-group-real-name group) article))) - (setq group (car result) - number (cdr result)))) + (> article 0) + (vectorp headers)) ; This might be a dummy article. + ;; If this is a virtual group, we find the real group. + (when (gnus-virtual-group-p group) + (let ((result (nnvirtual-find-group-art + (gnus-group-real-name group) article))) + (setq group (car result) + headers (copy-sequence headers)) + (mail-header-set-number headers (cdr result)))) + (let ((number (mail-header-number headers)) + file) (when (and number (> number 0) ; Reffed article. (or force @@ -175,14 +174,10 @@ it's not cached." t ; The article already is saved. (save-excursion (set-buffer nntp-server-buffer) - (require 'gnus-art) - (let ((gnus-use-cache nil) - (gnus-article-decode-hook nil)) + (let ((gnus-use-cache nil)) (gnus-request-article-this-buffer number group)) (when (> (buffer-size) 0) (gnus-write-buffer file) - (setq headers (nnheader-parse-head t)) - (mail-header-set-number headers number) (gnus-cache-change-buffer group) (set-buffer (cdr gnus-cache-buffer)) (goto-char (point-max)) @@ -204,7 +199,17 @@ it's not cached." (beginning-of-line)) (forward-line 1)) (beginning-of-line) - (nnheader-insert-nov headers) + ;; [number subject from date id references chars lines xref] + (insert (format "%s\t%s\t%s\t%s\t%s\t%s\t%s\t%s\t%s\t\n" + (mail-header-number headers) + (mail-header-subject headers) + (mail-header-from headers) + (mail-header-date headers) + (mail-header-id headers) + (or (mail-header-references headers) "") + (or (mail-header-chars headers) "") + (or (mail-header-lines headers) "") + (or (mail-header-xref headers) ""))) ;; Update the active info. (set-buffer gnus-summary-buffer) (gnus-cache-update-active group number) @@ -258,8 +263,7 @@ 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)) + (nnheader-insert-file-contents file) t))) (defun gnus-cache-possibly-alter-active (group active) @@ -305,9 +309,7 @@ it's not cached." ;; unsuccessful), so we use the cached headers exclusively. (set-buffer nntp-server-buffer) (erase-buffer) - (let ((coding-system-for-read - 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 @@ -332,6 +334,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)) @@ -391,6 +394,7 @@ Returns the list of articles removed." (cons group (set-buffer (gnus-get-buffer-create " *gnus-cache-overview*")))) + (buffer-disable-undo (current-buffer)) ;; Insert the contents of this group's cache overview. (erase-buffer) (let ((file (gnus-cache-file-name group ".overview"))) @@ -413,9 +417,7 @@ Returns the list of articles removed." (nnheader-translate-file-chars (if (gnus-use-long-file-name 'not-cache) group - (let ((group (nnheader-replace-duplicate-chars-in-string - (nnheader-replace-chars-in-string group ?/ ?_) - ?. ?_))) + (let ((group (nnheader-replace-chars-in-string group ?/ ?_))) ;; Translate the first colon into a slash. (when (string-match ":" group) (aset group (match-beginning 0) ?/)) @@ -426,10 +428,10 @@ Returns the list of articles removed." (defun gnus-cache-update-article (group article) "If ARTICLE is in the cache, remove it and re-enter it." (gnus-cache-change-buffer group) - (when (gnus-cache-possibly-remove-article article nil nil nil t) + (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 @@ -484,11 +486,9 @@ Returns the list of articles removed." (gnus-cache-save-buffers) (save-excursion (set-buffer cache-buf) + (buffer-disable-undo (current-buffer)) (erase-buffer) - (let ((coding-system-for-read - gnus-cache-overview-coding-system)) - (insert-file-contents - (or file (gnus-cache-file-name group ".overview")))) + (nnheader-insert-file-contents (or file (gnus-cache-file-name group ".overview"))) (goto-char (point-min)) (insert "\n") (goto-char (point-min))) @@ -516,6 +516,7 @@ Returns the list of articles removed." (let ((cache-buf (gnus-get-buffer-create " *gnus-cache*"))) (save-excursion (set-buffer cache-buf) + (buffer-disable-undo (current-buffer)) (erase-buffer)) (set-buffer nntp-server-buffer) (goto-char (point-min)) @@ -530,9 +531,7 @@ 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)))) + (nnheader-insert-file-contents (gnus-cache-file-name group (car cached))) (goto-char (point-min)) (insert "220 ") (princ (car cached) (current-buffer)) @@ -576,14 +575,14 @@ $ emacs -batch -l ~/.emacs -l gnus -f gnus-jog-cache" "Read the cache active file." (gnus-make-directory gnus-cache-directory) (if (or (not (file-exists-p gnus-cache-active-file)) - (zerop (nth 7 (file-attributes gnus-cache-active-file))) + (not (zerop (nth 7 (file-attributes gnus-cache-active-file)))) force) ;; There is no active file, so we generate one. (gnus-cache-generate-active) ;; We simply read the active file. (save-excursion (gnus-set-work-buffer) - (insert-file-contents gnus-cache-active-file) + (nnheader-insert-file-contents gnus-cache-active-file) (gnus-active-to-gnus-format nil (setq gnus-cache-active-hashtb (gnus-make-hashtable @@ -595,7 +594,14 @@ $ emacs -batch -l ~/.emacs -l gnus -f gnus-jog-cache" (when (or force (and gnus-cache-active-hashtb gnus-cache-active-altered)) - (gnus-write-active-file gnus-cache-active-file gnus-cache-active-hashtb t) + (nnheader-temp-write gnus-cache-active-file + (mapatoms + (lambda (sym) + (when (and sym (boundp sym)) + (insert (format "%s %d %d y\n" + (symbol-name sym) (cdr (symbol-value sym)) + (car (symbol-value sym)))))) + gnus-cache-active-hashtb)) ;; Mark the active hashtb as unaltered. (setq gnus-cache-active-altered nil)))