;;; 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:
(delete-directory (file-name-directory overview-file))
(error)))
- (gnus-cache-update-overview-total-fetched-for (car gnus-cache-buffer)
- overview-file)))
+ (gnus-cache-update-overview-total-fetched-for
+ (car gnus-cache-buffer) overview-file)))
;; Kill the buffer -- it's either unmodified or saved.
(gnus-kill-buffer buffer)
(setq gnus-cache-buffer nil))))
(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)
+ (let ((number article)
+ file headers lines-chars)
;; If this is a virtual group, we find the real group.
(when (gnus-virtual-group-p group)
(let ((result (nnvirtual-find-group-art
(let ((coding-system-for-write gnus-cache-coding-system))
(gnus-write-buffer file)
(gnus-cache-update-file-total-fetched-for group file))
+ (setq lines-chars (nnheader-get-lines-and-char))
(nnheader-remove-body)
(setq headers (nnheader-parse-naked-head))
(mail-header-set-number headers number)
+ (mail-header-set-lines headers (car lines-chars))
+ (mail-header-set-chars headers (cadr lines-chars))
(gnus-cache-change-buffer group)
(set-buffer (cdr gnus-cache-buffer))
(goto-char (point-max))
(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)
(provide 'gnus-cache)
+;;; arch-tag: 05a79442-8c58-4e65-bd0a-3cbb1b89a33a
;;; gnus-cache.el ends here
projects / gnus / blobdiff