;;; 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 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Tatsuya Ichikawa <t-ichi@po.shiojiri.ne.jp>
;; 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)
- (save-excursion
- (set-buffer cache-buf)
- (erase-buffer)
- (let ((nnheader-file-coding-system gnus-cache-coding-system))
- (nnheader-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 "."))
- (insert-buffer-substring cache-buf)
- (setq cached (cdr cached)))
+ (set-buffer cache-buf)
+ (erase-buffer)
+ (let ((nnheader-file-coding-system gnus-cache-coding-system))
+ (nnheader-insert-file-contents (gnus-cache-file-name group entry)))
+ (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))
(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)
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)
projects / elisp / gnus.git- / blobdiff