Synch with Oort Gnus.
authoryamaoka <yamaoka>
Thu, 24 Oct 2002 12:08:20 +0000 (12:08 +0000)
committeryamaoka <yamaoka>
Thu, 24 Oct 2002 12:08:20 +0000 (12:08 +0000)
lisp/ChangeLog
lisp/gnus-agent.el

index 7f961ad..e5a060c 100644 (file)
@@ -1,3 +1,18 @@
+2002-10-23  Kai Gro\e,A_\e(Bjohann  <kai.grossjohann@uni-duisburg.de>
+
+       * gnus-agent.el (gnus-agent-fetched-headers): New variable,
+       contains range of headers that have been fetched by the agent
+       already.  Compare gnus-agent-article-alist.
+       (gnus-agent-file-header-cache): Like
+       gnus-agent-file-loading-cache, but for gnus-agent-fetched-headers.
+       (gnus-agent-fetch-headers): Improve comment.  Revert to old
+       seen/recent logic.
+       Remember which headers have been fetched before and don't fetch
+       them again the next time round.
+       (gnus-agent-load-fetched-headers) 
+       (gnus-agent-save-fetched-headers): New functions, for remembering
+       which headers have been fetched before.
+
 2002-10-23  Katsumi Yamaoka  <yamaoka@jpl.org>
 
        * lpath.el: Remove useless bindings.
index 9d2a897..024d873 100644 (file)
@@ -163,6 +163,7 @@ If this is `ask' the hook will query the user."
 (defvar gnus-agent-history-buffers nil)
 (defvar gnus-agent-buffer-alist nil)
 (defvar gnus-agent-article-alist nil)
+(defvar gnus-agent-fetched-headers nil)
 (defvar gnus-agent-group-alist nil)
 (defvar gnus-category-alist nil)
 (defvar gnus-agent-current-history nil)
@@ -174,6 +175,7 @@ If this is `ask' the hook will query the user."
 (defvar gnus-agent-send-mail-function nil)
 (defvar gnus-agent-file-coding-system 'raw-text)
 (defvar gnus-agent-file-loading-cache nil)
+(defvar gnus-agent-file-header-cache nil)
 
 (defvar gnus-agent-auto-agentize-methods '(nntp nnimap)
   "Initially, all servers from these methods are agentized.
@@ -1126,11 +1128,21 @@ This can be added to `gnus-select-article-hook' or
                                     gnus-agent-large-newsgroup)
                                  0)
                             articles)))
-    ;; Add article with marks to list of article headers we want to fetch.
+    ;; Add article with marks to list of article headers we want to
+    ;; fetch.  We don't want to fetch all the seen articles, and we
+    ;; don't want do fetch the recent ones, though.
     (dolist (arts (gnus-info-marks (gnus-get-info group)))
-      (unless (memq (car arts) '(unseen recent))
+      (unless (memq (car arts) '(seen recent))
        (setq articles (gnus-range-add articles (cdr arts)))))
     (setq articles (sort (gnus-uncompress-sequence articles) '<))
+    ;; Note which headers are fetched, and don't fetch those again.
+    (gnus-agent-load-fetched-headers group)
+    (let ((new-fetched (gnus-range-add gnus-agent-fetched-headers
+                                      articles))
+         (new-articles (gnus-list-range-difference
+                        articles gnus-agent-fetched-headers)))
+      (gnus-agent-save-fetched-headers group new-fetched)
+      (setq articles new-articles))
     ;; Remove known articles.
     (when (gnus-agent-load-alist group)
       ;; Remove articles marked as downloaded.
@@ -1262,6 +1274,24 @@ This can be added to `gnus-select-article-hook' or
       (princ gnus-agent-article-alist (current-buffer))
       (insert "\n"))))
 
+(defun gnus-agent-load-fetched-headers (group)
+  "Load ranges of fetched headers for GROUP."
+  (setq gnus-agent-fetched-headers
+       (gnus-cache-file-contents
+        (gnus-agent-article-name ".fetched" group)
+        'gnus-agent-file-header-cache
+        'gnus-agent-read-file)))
+
+(defun gnus-agent-save-fetched-headers (group range)
+  "Save ranges of fetched headers for GROUP.
+This range includes nonexisting articles."
+  (let ((file-name-coding-system nnmail-pathname-coding-system)
+       print-level print-length)
+    (setq gnus-agent-fetched-headers range)
+    (with-temp-file (gnus-agent-article-name ".fetched" group)
+      (princ gnus-agent-fetched-headers (current-buffer))
+      (insert "\n"))))
+
 (defun gnus-agent-article-name (article group)
   (expand-file-name (if (stringp article) article (string-to-number article))
                    (file-name-as-directory