*** empty log message ***
[gnus] / lisp / gnus-cache.el
index 6121992..d1f8290 100644 (file)
@@ -1,7 +1,7 @@
 ;;; gnus-cache.el --- cache interface for Gnus
-;; Copyright (C) 1995,96,97 Free Software Foundation, Inc.
+;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc.
 
-;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: news
 
 ;; This file is part of GNU Emacs.
@@ -25,6 +25,8 @@
 
 ;;; Code:
 
+(eval-when-compile (require 'cl))
+
 (require 'gnus)
 (require 'gnus-int)
 (require 'gnus-range)
 (eval-when-compile
   (require 'gnus-sum))
 
-(defgroup gnus-cache nil
-  "Cache interface."
-  :group 'gnus)
-
-(defcustom gnus-cache-directory
-  (nnheader-concat gnus-directory "cache/")
-  "*The directory where cached articles will be stored."
-  :group 'gnus-cache
-  :type 'directory)
-
 (defcustom gnus-cache-active-file
   (concat (file-name-as-directory gnus-cache-directory) "active")
   "*The cache active file."
@@ -255,15 +247,13 @@ variable to \"^nnml\"."
 
 (defun gnus-cache-possibly-alter-active (group active)
   "Alter the ACTIVE info for GROUP to reflect the articles in the cache."
-  (when (equal group "no.norsk") (error "hie"))
   (when gnus-cache-active-hashtb
     (let ((cache-active (gnus-gethash group gnus-cache-active-hashtb)))
-      (and cache-active
-          (< (car cache-active) (car active))
-          (setcar active (car cache-active)))
-      (and cache-active
-          (> (cdr cache-active) (cdr active))
-          (setcdr active (cdr cache-active))))))
+      (when cache-active
+       (when (< (car cache-active) (car active))
+         (setcar active (car cache-active)))
+       (when (> (cdr cache-active) (cdr active))
+         (setcdr active (cdr cache-active)))))))
 
 (defun gnus-cache-retrieve-headers (articles group &optional fetch-old)
   "Retrieve the headers for ARTICLES in GROUP."
@@ -316,10 +306,10 @@ variable to \"^nnml\"."
 If not given a prefix, use the process marked articles instead.
 Returns the list of articles entered."
   (interactive "P")
-  (gnus-set-global-variables)
   (let ((articles (gnus-summary-work-articles n))
        article out)
     (while (setq article (pop articles))
+      (gnus-summary-remove-process-mark article)
       (if (natnump article)
          (when (gnus-cache-possibly-enter-article
                 gnus-newsgroup-name article
@@ -327,7 +317,6 @@ Returns the list of articles entered."
                 nil nil nil t)
            (push article out))
        (gnus-message 2 "Can't cache article %d" article))
-      (gnus-summary-remove-process-mark article)
       (gnus-summary-update-secondary-mark article))
     (gnus-summary-next-subject 1)
     (gnus-summary-position-point)
@@ -338,15 +327,14 @@ Returns the list of articles entered."
 If not given a prefix, use the process marked articles instead.
 Returns the list of articles removed."
   (interactive "P")
-  (gnus-set-global-variables)
   (gnus-cache-change-buffer gnus-newsgroup-name)
   (let ((articles (gnus-summary-work-articles n))
        article out)
     (while articles
       (setq article (pop articles))
+      (gnus-summary-remove-process-mark article)
       (when (gnus-cache-possibly-remove-article article nil nil nil t)
        (push article out))
-      (gnus-summary-remove-process-mark article)
       (gnus-summary-update-secondary-mark article))
     (gnus-summary-next-subject 1)
     (gnus-summary-position-point)
@@ -359,13 +347,16 @@ Returns the list of articles removed."
 (defun gnus-summary-insert-cached-articles ()
   "Insert all the articles cached for this group into the current buffer."
   (interactive)
-  (let ((cached gnus-newsgroup-cached)
+  (let ((cached (sort (copy-sequence gnus-newsgroup-cached) '<))
        (gnus-verbose (max 6 gnus-verbose)))
     (unless cached
-      (error "No cached articles for this group"))
+      (gnus-message 3 "No cached articles for this group"))
     (while cached
       (gnus-summary-goto-subject (pop cached) t))))
 
+(defalias 'gnus-summary-limit-include-cached
+  'gnus-summary-insert-cached-articles)
+
 ;;; Internal functions.
 
 (defun gnus-cache-change-buffer (group)
@@ -408,12 +399,14 @@ Returns the list of articles removed."
                ;; Translate the first colon into a slash.
                (when (string-match ":" group)
                  (aset group (match-beginning 0) ?/))
-               (nnheader-replace-chars-in-string group ?. ?/)))))
+               (nnheader-replace-chars-in-string group ?. ?/)))
+           t))
          (if (stringp article) article (int-to-string article))))
 
 (defun gnus-cache-update-article (group article)
   "If ARTICLE is in the cache, remove it and re-enter it."
-  (when (gnus-cache-possibly-remove-article article nil nil nil t)
+  (gnus-cache-change-buffer group)
+  (when (gnus-cache-possibly-remove-article article nil nil nil t)    
     (let ((gnus-use-cache nil))
       (gnus-cache-possibly-enter-article
        gnus-newsgroup-name article (gnus-summary-article-header article)
@@ -452,13 +445,20 @@ Returns the list of articles removed."
 
 (defun gnus-cache-articles-in-group (group)
   "Return a sorted list of cached articles in GROUP."
-  (let ((dir (file-name-directory (gnus-cache-file-name group 1))))
+  (let ((dir (file-name-directory (gnus-cache-file-name group 1)))
+       articles)
     (when (file-exists-p dir)
-      (sort (mapcar (lambda (name) (string-to-int name))
-                   (directory-files dir nil "^[0-9]+$" t))
-           '<))))
-
-(defun gnus-cache-braid-nov (group cached)
+      (setq articles
+           (sort (mapcar (lambda (name) (string-to-int name))
+                         (directory-files dir nil "^[0-9]+$" t))
+                 '<))
+      ;; Update the cache active file, just to synch more.
+      (when articles
+       (gnus-cache-update-active group (car articles) t)
+       (gnus-cache-update-active group (car (last articles))))
+      articles)))
+
+(defun gnus-cache-braid-nov (group cached &optional file)
   (let ((cache-buf (get-buffer-create " *gnus-cache*"))
        beg end)
     (gnus-cache-save-buffers)
@@ -466,7 +466,7 @@ Returns the list of articles removed."
       (set-buffer cache-buf)
       (buffer-disable-undo (current-buffer))
       (erase-buffer)
-      (insert-file-contents (gnus-cache-file-name group ".overview"))
+      (insert-file-contents (or file (gnus-cache-file-name group ".overview")))
       (goto-char (point-min))
       (insert "\n")
       (goto-char (point-min)))
@@ -539,22 +539,22 @@ $ emacs -batch -l ~/.emacs -l gnus -f gnus-jog-cache"
     (gnus)
     ;; Go through all groups...
     (gnus-group-mark-buffer)
-    (gnus-group-universal-argument
-     nil nil
-     (lambda ()
-       (interactive)
-       (gnus-summary-read-group (gnus-group-group-name) nil t)
-       ;; ... and enter the articles into the cache.
-       (when (eq major-mode 'gnus-summary-mode)
-        (gnus-uu-mark-buffer)
-        (gnus-cache-enter-article)
-        (kill-buffer (current-buffer)))))))
+    (gnus-group-iterate nil
+      (lambda (group)
+       (let (gnus-auto-select-next)
+         (gnus-summary-read-group group nil t)
+         ;; ... and enter the articles into the cache.
+         (when (eq major-mode 'gnus-summary-mode)
+           (gnus-uu-mark-buffer)
+           (gnus-cache-enter-article)
+           (kill-buffer (current-buffer))))))))
 
 (defun gnus-cache-read-active (&optional force)
   "Read the cache active file."
   (gnus-make-directory gnus-cache-directory)
-  (if (not (and (file-exists-p gnus-cache-active-file)
-               (or force (not gnus-cache-active-hashtb))))
+  (if (or (not (file-exists-p gnus-cache-active-file))
+         (not (zerop (nth 7 (file-attributes gnus-cache-active-file))))
+         force)
       ;; There is no active file, so we generate one.
       (gnus-cache-generate-active)
     ;; We simply read the active file.
@@ -608,8 +608,9 @@ If LOW, update the lower bound instead."
          (if top
              ""
            (string-match
-            (concat "^" (file-name-as-directory
-                         (expand-file-name gnus-cache-directory)))
+            (concat "^" (regexp-quote
+                         (file-name-as-directory
+                          (expand-file-name gnus-cache-directory))))
             (directory-file-name directory))
            (nnheader-replace-chars-in-string
             (substring (directory-file-name directory) (match-end 0))