X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-cache.el;h=6ef161cbbdce3b39a6a46ad9b1cb58f9a22d7693;hb=1a96d7bf660263f25557962103bc0ec2495d1d07;hp=ab12b0ec7e7b4514efd49cb2a96de9c9a5ac5cbc;hpb=deb61c4878b446b32f609182fa87aa4d2d65b914;p=gnus

diff --git a/lisp/gnus-cache.el b/lisp/gnus-cache.el
index ab12b0ec7..6ef161cbb 100644
--- a/lisp/gnus-cache.el
+++ b/lisp/gnus-cache.el
@@ -25,11 +25,15 @@
 
 ;;; Code:
 
+(require 'gnus-load)
+(require 'gnus-int)
+(require 'gnus-range)
+(require 'gnus-sum)
+(require 'gnus-start)
 (require 'gnus)
-(eval-when-compile (require 'cl))
 
 (defvar gnus-cache-directory
-  (concat (file-name-as-directory gnus-article-save-directory) "cache/")
+  (nnheader-concat gnus-directory "cache/")
   "*The directory where cached articles will be stored.")
 
 (defvar gnus-cache-active-file 
@@ -52,6 +56,7 @@ variable to \"^nnml\".")
 
 ;;; Internal variables.
 
+(defvar gnus-cache-removable-articles nil)
 (defvar gnus-cache-buffer nil)
 (defvar gnus-cache-active-hashtb nil)
 (defvar gnus-cache-active-altered nil)
@@ -66,9 +71,15 @@ variable to \"^nnml\".")
 
 (defun gnus-cache-open ()
   "Initialize the cache."
-  (gnus-cache-read-active))
+  (when (or (file-exists-p gnus-cache-directory)
+	    (and gnus-use-cache
+		 (not (eq gnus-use-cache 'passive))))
+    (gnus-cache-read-active)))
 
-(gnus-add-shutdown 'gnus-cache-close 'gnus)
+(condition-case ()
+    (gnus-add-shutdown 'gnus-cache-close 'gnus)
+  ;; Complexities of byte-compiling makes this kludge necessary.  Eeek.
+  (error nil))
 
 (defun gnus-cache-close ()
   "Shut down the cache."
@@ -91,7 +102,8 @@ variable to \"^nnml\".")
 	    (if (> (buffer-size) 0)
 		;; non-empty overview, write it out
 		(progn
-		  (gnus-make-directory (file-name-directory overview-file))
+		  (unless (file-exists-p (file-name-directory overview-file))
+		    (make-directory (file-name-directory overview-file) t))
 		  (write-region (point-min) (point-max)
 				overview-file nil 'quietly))
 	      ;; empty overview file, remove it
@@ -116,11 +128,11 @@ variable to \"^nnml\".")
 	     (vectorp headers))	; 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 group article)))
+      (let ((result (nnvirtual-find-group-art 
+		     (gnus-group-real-name group) article)))
 	(setq group (car result)
-	      article (cdr result)
 	      headers (copy-sequence headers))
-	(aset headers 0 article)))
+	(mail-header-set-number headers (cdr result))))
     (let ((number (mail-header-number headers))
 	  file dir)
       (when (and (> number 0)		; Reffed article.
@@ -130,17 +142,17 @@ variable to \"^nnml\".")
 		     (gnus-cache-member-of-class
 		      gnus-cache-enter-articles ticked dormant unread))
 		 (not (file-exists-p (setq file (gnus-cache-file-name
-						 group article)))))
+						 group number)))))
 	;; Possibly create the cache directory.
-	(or (file-exists-p (setq dir (file-name-directory file)))
-	    (gnus-make-directory dir))
+	(unless (file-exists-p (setq dir (file-name-directory file)))
+	  (make-directory dir t))
 	;; Save the article in the cache.
 	(if (file-exists-p file)
 	    t				; The article already is saved.
 	  (save-excursion
 	    (set-buffer nntp-server-buffer)
 	    (let ((gnus-use-cache nil))
-	      (gnus-request-article-this-buffer article group))
+	      (gnus-request-article-this-buffer number group))
 	    (when (> (buffer-size) 0)
 	      (write-region (point-min) (point-max) file nil 'quiet)
 	      (gnus-cache-change-buffer group)
@@ -178,7 +190,7 @@ variable to \"^nnml\".")
 	      ;; Update the active info.
 	      (set-buffer gnus-summary-buffer)
 	      (gnus-cache-update-active group number)
-	      (push number gnus-newsgroup-cached)
+	      (push article gnus-newsgroup-cached)
 	      (gnus-summary-update-secondary-mark article))
 	    t))))))
 
@@ -195,7 +207,7 @@ variable to \"^nnml\".")
 	  ga)
       (while arts
 	(when (setq ga (nnvirtual-find-group-art
-			gnus-newsgroup-name (pop arts)))
+			(gnus-group-real-name gnus-newsgroup-name) (pop arts)))
 	  (let ((gnus-cache-removable-articles (list (cdr ga)))
 		(gnus-newsgroup-name (car ga)))
 	    (gnus-cache-possibly-remove-articles-1)))))
@@ -233,13 +245,14 @@ variable to \"^nnml\".")
 
 (defun gnus-cache-possibly-alter-active (group active)
   "Alter the ACTIVE info for GROUP to reflect the articles in the cache."
-  (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 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))))))
 
 (defun gnus-cache-retrieve-headers (articles group &optional fetch-old)
   "Retrieve the headers for ARTICLES in GROUP."
@@ -367,23 +380,34 @@ Returns the list of articles removed."
 	  (file-name-as-directory
 	   (if (gnus-use-long-file-name 'not-cache)
 	       group 
-	     (let ((group (concat group "")))
-	       (if (string-match ":" group)
-		   (aset group (match-beginning 0) ?/))
+	     (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)
-    (gnus-cache-possibly-enter-article 
-     gnus-newsgroup-name article (gnus-summary-article-header article)
-     nil nil nil t)))
+    (let ((gnus-use-cache nil))
+      (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 
 						   &optional force)
   "Possibly remove ARTICLE from the cache."
-  (let ((file (gnus-cache-file-name gnus-newsgroup-name article)))
+  (let ((group gnus-newsgroup-name)
+	(number article)
+	file)
+    ;; If this is a virtual group, we find the real group.
+    (when (gnus-virtual-group-p group)
+      (let ((result (nnvirtual-find-group-art 
+		     (gnus-group-real-name group) article)))
+	(setq group (car result)
+	      number (cdr result))))
+    (setq file (gnus-cache-file-name group number))
     (when (and (file-exists-p file)
 	       (or force
 		   (gnus-cache-member-of-class
@@ -392,8 +416,8 @@ Returns the list of articles removed."
 	(delete-file file)
 	(set-buffer (cdr gnus-cache-buffer))
 	(goto-char (point-min))
-	(if (or (looking-at (concat (int-to-string article) "\t"))
-		(search-forward (concat "\n" (int-to-string article) "\t")
+	(if (or (looking-at (concat (int-to-string number) "\t"))
+		(search-forward (concat "\n" (int-to-string number) "\t")
 				(point-max) t))
 	    (delete-region (progn (beginning-of-line) (point))
 			   (progn (forward-line 1) (point)))))
@@ -500,6 +524,8 @@ Returns the list of articles removed."
 
 (defun gnus-cache-read-active (&optional force)
   "Read the cache active file."
+  (unless (file-exists-p gnus-cache-directory)
+    (make-directory gnus-cache-directory t))
   (if (not (and (file-exists-p gnus-cache-active-file)
 		(or force (not gnus-cache-active-hashtb))))
       ;; There is no active file, so we generate one.
@@ -528,7 +554,8 @@ Returns the list of articles removed."
 			   (symbol-name sym) (cdr (symbol-value sym))
 			   (car (symbol-value sym))))))
        gnus-cache-active-hashtb)
-      (gnus-make-directory (file-name-directory gnus-cache-active-file))
+      (unless (file-exists-p (file-name-directory gnus-cache-active-file))
+	(make-directory (file-name-directory gnus-cache-active-file) t))
       (write-region 
        (point-min) (point-max) gnus-cache-active-file nil 'silent))
     ;; Mark the active hashtb as unaltered.