X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fgnus-cache.el;h=7b5eb4929b2d12462dd2d1a97d33b06189f295c7;hp=aa377cdea53758b5f12e88eeae5d1191b56b9a4a;hb=c881c2e5d77a85b1a0d46785ffc3e10228c78175;hpb=125d88b46ad2efa065f06d5dac37a245b488985a diff --git a/lisp/gnus-cache.el b/lisp/gnus-cache.el index aa377cdea..7b5eb4929 100644 --- a/lisp/gnus-cache.el +++ b/lisp/gnus-cache.el @@ -1,6 +1,7 @@ ;;; gnus-cache.el --- cache interface for Gnus -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 -;; Free Software Foundation, Inc. + +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, +;; 2004, 2005, 2006 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news @@ -19,8 +20,8 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; Commentary: @@ -123,8 +124,7 @@ it's not cached." (overview-file (gnus-cache-file-name (car gnus-cache-buffer) ".overview"))) ;; write the overview only if it was modified - (when (and (buffer-live-p buffer) - (buffer-modified-p buffer)) + (when (and (buffer-live-p buffer) (buffer-modified-p buffer)) (with-current-buffer buffer (if (> (buffer-size) 0) ;; Non-empty overview, write it to a file. @@ -242,12 +242,10 @@ it's not cached." (defun gnus-cache-possibly-remove-articles-1 () "Possibly remove some of the removable articles." (when (gnus-cache-fully-p gnus-newsgroup-name) - (let ((articles gnus-cache-removable-articles) - (cache-articles gnus-newsgroup-cached) - article) + (let ((cache-articles gnus-newsgroup-cached)) (gnus-cache-change-buffer gnus-newsgroup-name) - (while articles - (when (memq (setq article (pop articles)) cache-articles) + (dolist (article gnus-cache-removable-articles) + (when (memq article cache-articles) ;; The article was in the cache, so we see whether we are ;; supposed to remove it from the cache. (gnus-cache-possibly-remove-article @@ -331,9 +329,8 @@ it's not cached." If not given a prefix, use the process marked articles instead. Returns the list of articles entered." (interactive "P") - (let ((articles (gnus-summary-work-articles n)) - article out) - (while (setq article (pop articles)) + (let (out) + (dolist (article (gnus-summary-work-articles n)) (gnus-summary-remove-process-mark article) (if (natnump article) (when (gnus-cache-possibly-enter-article @@ -354,17 +351,15 @@ If not given a prefix, use the process marked articles instead. Returns the list of articles removed." (interactive "P") (gnus-cache-change-buffer gnus-newsgroup-name) - (let ((articles (gnus-summary-work-articles n)) - article out) - (while articles - (setq article (pop articles)) + (let (out) + (dolist (article (gnus-summary-work-articles n)) (gnus-summary-remove-process-mark article) (when (gnus-cache-possibly-remove-article article nil nil nil t) (when gnus-newsgroup-agentized (let ((alist (gnus-agent-load-alist gnus-newsgroup-name))) (unless (cdr (assoc article alist)) (setq gnus-newsgroup-undownloaded - (gnus-add-to-sorted-list + (gnus-add-to-sorted-list gnus-newsgroup-undownloaded article))))) (push article out)) (gnus-summary-update-download-mark article) @@ -428,6 +423,7 @@ Returns the list of articles removed." (and (not unread) (not ticked) (not dormant) (memq 'read class)))) (defun gnus-cache-file-name (group article) + (setq group (gnus-group-decoded-name group)) (expand-file-name (if (stringp article) article (int-to-string article)) (file-name-as-directory @@ -495,7 +491,7 @@ Returns the list of articles removed." articles) (when (file-exists-p dir) (setq articles - (sort (mapcar (lambda (name) (string-to-int name)) + (sort (mapcar (lambda (name) (string-to-number name)) (directory-files dir nil "^[0-9]+$" t)) '<)) ;; Update the cache active file, just to synch more. @@ -544,24 +540,23 @@ Returns the list of articles removed." (defun gnus-cache-braid-heads (group cached) (let ((cache-buf (gnus-get-buffer-create " *gnus-cache*"))) - (save-excursion - (set-buffer cache-buf) + (with-current-buffer cache-buf (erase-buffer)) (set-buffer nntp-server-buffer) (goto-char (point-min)) - (while cached + (dolist (entry cached) (while (and (not (eobp)) (looking-at "2.. +\\([0-9]+\\) ") (< (progn (goto-char (match-beginning 1)) (read (current-buffer))) - (car cached))) + entry)) (search-forward "\n.\n" nil 'move)) (beginning-of-line) (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)))) + (insert-file-contents (gnus-cache-file-name group entry))) (goto-char (point-min)) (insert "220 ") (princ (car cached) (current-buffer)) @@ -571,8 +566,7 @@ Returns the list of articles removed." (forward-char -1) (insert ".") (set-buffer nntp-server-buffer) - (insert-buffer-substring cache-buf) - (setq cached (cdr cached))) + (insert-buffer-substring cache-buf)) (kill-buffer cache-buf))) ;;;###autoload @@ -689,20 +683,19 @@ If LOW, update the lower bound instead." ;; Separate articles from all other files and directories. (while files (if (string-match "^[0-9]+$" (file-name-nondirectory (car files))) - (push (string-to-int (file-name-nondirectory (pop files))) nums) + (push (string-to-number (file-name-nondirectory (pop files))) nums) (push (pop files) alphs))) ;; If we have nums, then this is probably a valid group. (when (setq nums (sort nums '<)) (gnus-sethash group (cons (car nums) (gnus-last-element nums)) gnus-cache-active-hashtb)) ;; Go through all the other files. - (while alphs - (when (and (file-directory-p (car alphs)) + (dolist (file alphs) + (when (and (file-directory-p file) (not (string-match "^\\." - (file-name-nondirectory (car alphs))))) + (file-name-nondirectory file)))) ;; We descend directories. - (gnus-cache-generate-active (car alphs))) - (setq alphs (cdr alphs))) + (gnus-cache-generate-active file))) ;; Write the new active file. (when top (gnus-cache-write-active t) @@ -740,9 +733,11 @@ If GROUP is non-nil, also cater to `gnus-cacheable-groups' and ;;;###autoload (defun gnus-cache-rename-group (old-group new-group) - "Rename OLD-GROUP as NEW-GROUP. Always updates the cache, even when -disabled, as the old cache files would corrupt gnus when the cache was -next enabled. Depends upon the caller to determine whether group renaming is supported." + "Rename OLD-GROUP as NEW-GROUP. +Always updates the cache, even when disabled, as the old cache +files would corrupt Gnus when the cache was next enabled. It +depends on the caller to determine whether group renaming is +supported." (let ((old-dir (gnus-cache-file-name old-group "")) (new-dir (gnus-cache-file-name new-group ""))) (gnus-rename-file old-dir new-dir t)) @@ -752,9 +747,12 @@ next enabled. Depends upon the caller to determine whether group renaming is sup (let ((no-save gnus-cache-active-hashtb)) (unless gnus-cache-active-hashtb (gnus-cache-read-active)) - (let* ((old-group-hash-value (gnus-gethash old-group gnus-cache-active-hashtb)) - (new-group-hash-value (gnus-gethash new-group gnus-cache-active-hashtb)) - (delta (or old-group-hash-value new-group-hash-value))) + (let* ((old-group-hash-value + (gnus-gethash old-group gnus-cache-active-hashtb)) + (new-group-hash-value + (gnus-gethash new-group gnus-cache-active-hashtb)) + (delta + (or old-group-hash-value new-group-hash-value))) (gnus-sethash new-group old-group-hash-value gnus-cache-active-hashtb) (gnus-sethash old-group nil gnus-cache-active-hashtb) @@ -764,11 +762,13 @@ next enabled. Depends upon the caller to determine whether group renaming is sup ;;;###autoload (defun gnus-cache-delete-group (group) - "Delete GROUP. Always updates the cache, even when -disabled, as the old cache files would corrupt gnus when the cache was -next enabled. Depends upon the caller to determine whether group deletion is supported." + "Delete GROUP from the cache. +Always updates the cache, even when disabled, as the old cache +files would corrupt gnus when the cache was next enabled. +Depends upon the caller to determine whether group deletion is +supported." (let ((dir (gnus-cache-file-name group ""))) - (gnus-delete-file dir)) + (gnus-delete-directory dir)) (gnus-cache-delete-group-total-fetched-for group) @@ -847,16 +847,17 @@ next enabled. Depends upon the caller to determine whether group deletion is sup (defun gnus-cache-total-fetched-for (group &optional no-inhibit) "Get total disk space used by the cache for the specified GROUP." - (unless gnus-cache-total-fetched-hashtb - (setq gnus-cache-total-fetched-hashtb (gnus-make-hashtable 1024))) - - (let* ((entry (gnus-gethash group gnus-cache-total-fetched-hashtb))) - (if entry - (apply '+ entry) - (let ((gnus-cache-inhibit-update-total-fetched-for (not no-inhibit))) - (+ - (gnus-cache-update-overview-total-fetched-for group nil) - (gnus-cache-update-file-total-fetched-for group nil)))))) + (unless (equal group "dummy.group") + (unless gnus-cache-total-fetched-hashtb + (setq gnus-cache-total-fetched-hashtb (gnus-make-hashtable 1024))) + + (let* ((entry (gnus-gethash group gnus-cache-total-fetched-hashtb))) + (if entry + (apply '+ entry) + (let ((gnus-cache-inhibit-update-total-fetched-for (not no-inhibit))) + (+ + (gnus-cache-update-overview-total-fetched-for group nil) + (gnus-cache-update-file-total-fetched-for group nil))))))) (provide 'gnus-cache)