Synch to No Gnus 200503230048.
[elisp/gnus.git-] / lisp / gnus-cache.el
index 1d5a81b..a2ee72e 100644 (file)
@@ -143,8 +143,8 @@ it's not cached."
                (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))))
@@ -155,7 +155,8 @@ it's not cached."
             (numberp article)
             (> article 0)              ; This might be a dummy article.
             (vectorp headers))
-    (let ((number article) file)
+    (let ((number article)
+         file 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
@@ -185,9 +186,12 @@ it's not cached."
              (gnus-write-buffer-as-coding-system
               gnus-cache-write-file-coding-system 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))
@@ -240,12 +244,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
@@ -329,9 +331,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
@@ -353,10 +354,8 @@ 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
@@ -427,6 +426,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
@@ -542,35 +542,32 @@ 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)
-      (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
@@ -694,13 +691,12 @@ If LOW, update the lower bound instead."
       (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)
@@ -766,7 +762,7 @@ next enabled. Depends upon the caller to determine whether group renaming is sup
 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)