X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-cache.el;h=dbd42fcdc893c5250c62be98229c9d4e2761e387;hb=b28454eed83f245c4160228b076134ce930b320a;hp=048056905a009bf7ff9916685d87c7966b69944a;hpb=aa88205ebb3cd4ade3696b2faf1d72a687cffa49;p=gnus

diff --git a/lisp/gnus-cache.el b/lisp/gnus-cache.el
index 048056905..dbd42fcdc 100644
--- a/lisp/gnus-cache.el
+++ b/lisp/gnus-cache.el
@@ -1,5 +1,5 @@
 ;;; gnus-cache.el --- cache interface for Gnus
-;; Copyright (C) 1995,96 Free Software Foundation, Inc.
+;; Copyright (C) 1995,96,97 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
 ;; Keywords: news
@@ -25,32 +25,47 @@
 
 ;;; Code:
 
-(require 'gnus-load)
+(require 'gnus)
 (require 'gnus-int)
 (require 'gnus-range)
-(require 'gnus-sum)
 (require 'gnus-start)
-(require 'gnus)
+(eval-when-compile
+  (require 'gnus-sum))
+
+(defgroup gnus-cache nil
+  "Cache interface."
+  :group 'gnus)
 
-(defvar gnus-cache-directory
+(defcustom gnus-cache-directory
   (nnheader-concat gnus-directory "cache/")
-  "*The directory where cached articles will be stored.")
+  "*The directory where cached articles will be stored."
+  :group 'gnus-cache
+  :type 'directory)
 
-(defvar gnus-cache-active-file 
+(defcustom gnus-cache-active-file
   (concat (file-name-as-directory gnus-cache-directory) "active")
-  "*The cache active file.")
+  "*The cache active file."
+  :group 'gnus-cache
+  :type 'file)
 
-(defvar gnus-cache-enter-articles '(ticked dormant)
-  "*Classes of articles to enter into the cache.")
+(defcustom gnus-cache-enter-articles '(ticked dormant)
+  "Classes of articles to enter into the cache."
+  :group 'gnus-cache
+  :type '(set (const ticked) (const dormant) (const unread) (const read)))
 
-(defvar gnus-cache-remove-articles '(read)
-  "*Classes of articles to remove from the cache.")
+(defcustom gnus-cache-remove-articles '(read)
+  "Classes of articles to remove from the cache."
+  :group 'gnus-cache
+  :type '(set (const ticked) (const dormant) (const unread) (const read)))
 
-(defvar gnus-uncacheable-groups nil
+(defcustom gnus-uncacheable-groups nil
   "*Groups that match this regexp will not be cached.
 
 If you want to avoid caching your nnml groups, you could set this
-variable to \"^nnml\".")
+variable to \"^nnml\"."
+  :group 'gnus-cache
+  :type '(choice (const :tag "off" nil)
+		 regexp))
 
 
 
@@ -76,10 +91,9 @@ variable to \"^nnml\".")
 		 (not (eq gnus-use-cache 'passive))))
     (gnus-cache-read-active)))
 
-(condition-case ()
-    (gnus-add-shutdown 'gnus-cache-close 'gnus)
-  ;; Complexities of byte-compiling makes this kludge necessary.  Eeek.
-  (error nil))
+;; Complexities of byte-compiling make this kludge necessary.  Eeek.
+(ignore-errors
+  (gnus-add-shutdown 'gnus-cache-close 'gnus))
 
 (defun gnus-cache-close ()
   "Shut down the cache."
@@ -115,7 +129,7 @@ variable to \"^nnml\".")
       (gnus-kill-buffer buffer)
       (setq gnus-cache-buffer nil))))
 
-(defun gnus-cache-possibly-enter-article 
+(defun gnus-cache-possibly-enter-article
   (group article headers ticked dormant unread &optional force)
   (when (and (or force (not (eq gnus-use-cache 'passive)))
 	     (numberp article)
@@ -124,7 +138,7 @@ variable to \"^nnml\".")
 					; This might be a dummy article.
     ;; If this is a virtual group, we find the real group.
     (when (gnus-virtual-group-p group)
-      (let ((result (nnvirtual-find-group-art 
+      (let ((result (nnvirtual-find-group-art
 		     (gnus-group-real-name group) article)))
 	(setq group (car result)
 	      headers (copy-sequence headers))
@@ -241,9 +255,10 @@ 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 
+      (and cache-active
 	   (< (car cache-active) (car active))
 	   (setcar active (car cache-active)))
       (and cache-active
@@ -252,7 +267,7 @@ variable to \"^nnml\".")
 
 (defun gnus-cache-retrieve-headers (articles group &optional fetch-old)
   "Retrieve the headers for ARTICLES in GROUP."
-  (let ((cached 
+  (let ((cached
 	 (setq gnus-newsgroup-cached (gnus-cache-articles-in-group group))))
     (if (not cached)
 	;; No cached articles here, so we just retrieve them
@@ -264,12 +279,12 @@ variable to \"^nnml\".")
 				articles))
 	    (cache-file (gnus-cache-file-name group ".overview"))
 	    type)
-	;; We first retrieve all the headers that we don't have in 
+	;; We first retrieve all the headers that we don't have in
 	;; the cache.
 	(let ((gnus-use-cache nil))
 	  (when uncached-articles
-	    (setq type (and articles 
-			    (gnus-retrieve-headers 
+	    (setq type (and articles
+			    (gnus-retrieve-headers
 			     uncached-articles group fetch-old)))))
 	(gnus-cache-save-buffers)
 	;; Then we insert the cached headers.
@@ -279,7 +294,7 @@ variable to \"^nnml\".")
 	    ;; There are no cached headers.
 	    type)
 	   ((null type)
-	    ;; There were no uncached headers (or retrieval was 
+	    ;; There were no uncached headers (or retrieval was
 	    ;; unsuccessful), so we use the cached headers exclusively.
 	    (set-buffer nntp-server-buffer)
 	    (erase-buffer)
@@ -304,12 +319,14 @@ Returns the list of articles entered."
   (gnus-set-global-variables)
   (let ((articles (gnus-summary-work-articles n))
 	article out)
-    (while articles
-      (setq article (pop articles))
-      (when (gnus-cache-possibly-enter-article 
-	     gnus-newsgroup-name article (gnus-summary-article-header article)
-	     nil nil nil t)
-	(push article out))
+    (while (setq article (pop articles))
+      (if (natnump article)
+	  (when (gnus-cache-possibly-enter-article
+		 gnus-newsgroup-name article
+		 (gnus-summary-article-header article)
+		 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)
@@ -342,7 +359,8 @@ 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 gnus-newsgroup-cached)
+	(gnus-verbose (max 6 gnus-verbose)))
     (unless cached
       (error "No cached articles for this group"))
     (while cached
@@ -368,8 +386,8 @@ Returns the list of articles removed."
       (erase-buffer)
       (let ((file (gnus-cache-file-name group ".overview")))
 	(when (file-exists-p file)
-	  (insert-file-contents file)))
-      ;; We have a fresh (empty/just loaded) buffer, 
+	  (nnheader-insert-file-contents file)))
+      ;; We have a fresh (empty/just loaded) buffer,
       ;; mark it as unmodified to save a redundant write later.
       (set-buffer-modified-p nil))))
 
@@ -383,24 +401,25 @@ Returns the list of articles removed."
 (defun gnus-cache-file-name (group article)
   (concat (file-name-as-directory gnus-cache-directory)
 	  (file-name-as-directory
-	   (if (gnus-use-long-file-name 'not-cache)
-	       group 
-	     (let ((group (nnheader-replace-chars-in-string group ?/ ?_)))
-	       ;; Translate the first colon into a slash.
-	       (when (string-match ":" group)
-		 (aset group (match-beginning 0) ?/))
-	       (nnheader-replace-chars-in-string group ?. ?/))))
+	   (nnheader-translate-file-chars
+	    (if (gnus-use-long-file-name 'not-cache)
+		group
+	      (let ((group (nnheader-replace-chars-in-string group ?/ ?_)))
+		;; Translate the first colon into a slash.
+		(when (string-match ":" group)
+		  (aset group (match-beginning 0) ?/))
+		(nnheader-replace-chars-in-string group ?. ?/)))))
 	  (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)
     (let ((gnus-use-cache nil))
-      (gnus-cache-possibly-enter-article 
+      (gnus-cache-possibly-enter-article
        gnus-newsgroup-name article (gnus-summary-article-header article)
        nil nil nil t))))
 
-(defun gnus-cache-possibly-remove-article (article ticked dormant unread 
+(defun gnus-cache-possibly-remove-article (article ticked dormant unread
 						   &optional force)
   "Possibly remove ARTICLE from the cache."
   (let ((group gnus-newsgroup-name)
@@ -408,7 +427,7 @@ Returns the list of articles removed."
 	file)
     ;; If this is a virtual group, we find the real group.
     (when (gnus-virtual-group-p group)
-      (let ((result (nnvirtual-find-group-art 
+      (let ((result (nnvirtual-find-group-art
 		     (gnus-group-real-name group) article)))
 	(setq group (car result)
 	      number (cdr result))))
@@ -520,9 +539,10 @@ $ 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 
+    (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)
@@ -542,11 +562,11 @@ $ emacs -batch -l ~/.emacs -l gnus -f gnus-jog-cache"
       (gnus-set-work-buffer)
       (insert-file-contents gnus-cache-active-file)
       (gnus-active-to-gnus-format
-       nil (setq gnus-cache-active-hashtb 
-		 (gnus-make-hashtable 
+       nil (setq gnus-cache-active-hashtb
+		 (gnus-make-hashtable
 		  (count-lines (point-min) (point-max)))))
       (setq gnus-cache-active-altered nil))))
-       
+
 (defun gnus-cache-write-active (&optional force)
   "Write the active hashtb to the active file."
   (when (or force
@@ -573,9 +593,9 @@ If LOW, update the lower bound instead."
       ;; Update the lower or upper bound.
       (if low
 	  (setcar active number)
-	(setcdr active number))
-      ;; Mark the active hashtb as altered.
-      (setq gnus-cache-active-altered t))))
+	(setcdr active number)))
+    ;; Mark the active hashtb as altered.
+    (setq gnus-cache-active-altered t)))
 
 ;;;###autoload
 (defun gnus-cache-generate-active (&optional directory)
@@ -584,14 +604,14 @@ If LOW, update the lower bound instead."
   (let* ((top (null directory))
 	 (directory (expand-file-name (or directory gnus-cache-directory)))
 	 (files (directory-files directory 'full))
-	 (group 
+	 (group
 	  (if top
 	      ""
-	    (string-match 
+	    (string-match
 	     (concat "^" (file-name-as-directory
 			  (expand-file-name gnus-cache-directory)))
 	     (directory-file-name directory))
-	    (nnheader-replace-chars-in-string 
+	    (nnheader-replace-chars-in-string
 	     (substring (directory-file-name directory) (match-end 0))
 	     ?/ ?.)))
 	 nums alphs)
@@ -628,6 +648,11 @@ If LOW, update the lower bound instead."
   (let ((nnml-generate-active-function 'identity))
     (nnml-generate-nov-databases-1 dir)))
 
+(defun gnus-cache-move-cache (dir)
+  "Move the cache tree to somewhere else."
+  (interactive "DMove the cache tree to: ")
+  (rename-file gnus-cache-directory dir))
+
 (provide 'gnus-cache)
-	      
+
 ;;; gnus-cache.el ends here