X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-cache.el;h=6431c81f481203a9d7d732854dfa927e0824bb8c;hb=f344bd14c4b7e73add97d561de63bb7d85ab6571;hp=a59526ef80b917739581261b25d3b3a2120b2904;hpb=ea459fd72ec9b5035d85cf5fbbd107945dfd9594;p=gnus diff --git a/lisp/gnus-cache.el b/lisp/gnus-cache.el index a59526ef8..6431c81f4 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, 1996, 1997, 1998, 1999, 2000, 2001 +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -179,7 +179,8 @@ it's not cached." (when (> (buffer-size) 0) (let ((coding-system-for-write gnus-cache-coding-system)) (gnus-write-buffer file)) - (setq headers (nnheader-parse-head t)) + (nnheader-remove-body) + (setq headers (nnheader-parse-naked-head)) (mail-header-set-number headers number) (gnus-cache-change-buffer group) (set-buffer (cdr gnus-cache-buffer)) @@ -206,7 +207,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)))))) @@ -336,7 +338,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." @@ -361,23 +363,20 @@ 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) '>)) - (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)))) + (let ((gnus-verbose (max 6 gnus-verbose))) + (if (not gnus-newsgroup-cached) + (gnus-message 3 "No cached articles for this group") + (gnus-summary-goto-subjects gnus-newsgroup-cached)))) (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. @@ -463,10 +462,11 @@ Returns the list of articles removed." (when (or (looking-at (concat (int-to-string number) "\t")) (search-forward (concat "\n" (int-to-string number) "\t") (point-max) t)) - (delete-region (progn (beginning-of-line) (point)) - (progn (forward-line 1) (point))))) - (setq gnus-newsgroup-cached - (delq article gnus-newsgroup-cached)) + (gnus-delete-line))) + (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))) @@ -480,9 +480,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) @@ -506,13 +510,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 (gnus-point-at-bol) + 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")) @@ -534,20 +538,20 @@ Returns the list of articles removed." (car cached))) (search-forward "\n.\n" nil 'move)) (beginning-of-line) - (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)))) - (goto-char (point-min)) - (insert "220 ") - (princ (car cached) (current-buffer)) - (insert " Article retrieved.\n") - (search-forward "\n\n" nil 'move) - (delete-region (point) (point-max)) - (forward-char -1) - (insert ".")) + (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)))) + (goto-char (point-min)) + (insert "220 ") + (princ (car cached) (current-buffer)) + (insert " Article retrieved.\n") + (search-forward "\n\n" nil 'move) + (delete-region (point) (point-max)) + (forward-char -1) + (insert ".") + (set-buffer nntp-server-buffer) (insert-buffer-substring cache-buf) (setq cached (cdr cached))) (kill-buffer cache-buf))) @@ -711,7 +715,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)