;;; 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 <larsi@gnus.org>
;; Keywords: news
;; 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:
(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.
(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
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
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)
(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
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.
(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))
(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
;; 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)
;;;###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))
(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)
;;;###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)
(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)
projects / gnus / blobdiff