X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=elmo%2Felmo-cache.el;h=993b7d7d2db63d6a10e9184eb4b84fbd9c4ed523;hb=49e07974f02b937af1b875c7777743f4f2db143d;hp=bb8eeac2a7f2de07c4dda9cb7161754b89ad30fd;hpb=be8d7b821412989340e00791d88ba789fa044e7e;p=elisp%2Fwanderlust.git

diff --git a/elmo/elmo-cache.el b/elmo/elmo-cache.el
index bb8eeac..993b7d7 100644
--- a/elmo/elmo-cache.el
+++ b/elmo/elmo-cache.el
@@ -1,10 +1,10 @@
 ;;; elmo-cache.el -- Cache modules for Elmo.
 
-;; Copyright 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
-;; Copyright 2000 Kenichi OKADA <okada@opaopa.org>
+;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
+;; Copyright (C) 2000 Kenichi OKADA <okada@opaopa.org>
 
 ;; Author: Yuuichi Teranishi <teranisi@gohome.org>
-;;         Kenichi OKADA <okada@opaopa.org>
+;;	Kenichi OKADA <okada@opaopa.org>
 ;; Keywords: mail, net news
 
 ;; This file is part of ELMO (Elisp Library for Message Orchestration).
@@ -47,12 +47,12 @@
   (unless (string-match elmo-cache-dirname path)
     (error "%s is not cache file!" path))
   (let (message-id)
-    (if (or (elmo-msgdb-global-mark-get 
+    (if (or (elmo-msgdb-global-mark-get
 	     (setq message-id
 		   (elmo-cache-to-msgid (file-name-nondirectory path))))
 	    (member message-id locked))
-	nil ;; Don't delete caches with mark (or locked message).
-      (if (and path 
+	nil;; Don't delete caches with mark (or locked message).
+      (if (and path
 	       (file-directory-p path))
 	  (progn
 	    (mapcar 'delete-file (directory-files path t "^[^\\.]"))
@@ -65,13 +65,13 @@
   (if msgid
       (let ((path1 (elmo-cache-get-path msgid))
 	    path2)
-	(if (and path1 
+	(if (and path1
 		 (file-exists-p path1))
 	    (if (and folder
 		     (file-directory-p path1))
-		(when (file-exists-p (setq path2 
+		(when (file-exists-p (setq path2
 					   (expand-file-name
-					    (format "%s@%s" 
+					    (format "%s@%s"
 						    number
 						    (elmo-safe-filename
 						     folder))
@@ -81,7 +81,7 @@
 		    (delete-directory path1))))))))
 
 (defun elmo-cache-read (msgid &optional folder number outbuf)
-  "Read cache contents to outbuf"
+  "Read cache contents to OUTBUF."
   (save-excursion
     (let ((path (elmo-cache-exists-p msgid folder number)))
       (when path
@@ -103,7 +103,7 @@
 
 (defun elmo-read-float-value-from-minibuffer (prompt &optional initial)
   (let ((str (read-from-minibuffer prompt initial)))
-    (cond 
+    (cond
      ((string-match "[0-9]*\\.[0-9]+" str)
       (string-to-number str))
      ((string-match "[0-9]+" str)
@@ -111,7 +111,7 @@
      (t (error "%s is not number" str)))))
 
 (defun elmo-cache-expire-by-size (&optional kbytes)
-  "Expire cache file by size. 
+  "Expire cache file by size.
 If KBYTES is kilo bytes (This value must be float)."
   (interactive)
   (let ((size (or kbytes
@@ -133,25 +133,21 @@ If KBYTES is kilo bytes (This value must be float)."
 		    (expand-file-name
 		     elmo-cache-dirname elmo-msgdb-dir)) Kbytes))
     (setq beginning total)
-    (message "Checking disk usage...done.")
+    (message "Checking disk usage...done")
     (let ((cfl (elmo-cache-get-sorted-cache-file-list))
 	  (deleted 0)
-	  oldest 
+	  oldest
 	  cur-size cur-file)
       (while (and (<= size total)
 		  (setq oldest (elmo-cache-get-oldest-cache-file-entity cfl)))
 	(setq cur-file (expand-file-name (car (cdr oldest)) (car oldest)))
-	(if (file-directory-p cur-file)
-	    (setq cur-size (elmo-disk-usage cur-file))
-	  (setq cur-size 
-		(/ (float (nth 7 (file-attributes cur-file)))
-		   Kbytes)))
+	(setq cur-size (/ (elmo-disk-usage cur-file) Kbytes))
 	(when (elmo-cache-force-delete cur-file locked)
 	  (setq count (+ count 1))
 	  (message "%d cache(s) are expired." count))
 	(setq deleted (+ deleted cur-size))
 	(setq total (- total cur-size)))
-      (message "%d cache(s) are expired from disk (%d Kbytes/%d Kbytes)." 
+      (message "%d cache(s) are expired from disk (%d Kbytes/%d Kbytes)."
 	       count deleted beginning))))
 
 (defun elmo-cache-make-file-entity (filename path)
@@ -162,11 +158,11 @@ If KBYTES is kilo bytes (This value must be float)."
 	flist firsts oldest-entity wonlist)
     (while cfl
       (setq flist (cdr (car cfl)))
-      (setq firsts (append firsts (list 
-				   (cons (car (car cfl)) 
+      (setq firsts (append firsts (list
+				   (cons (car (car cfl))
 					 (car flist)))))
       (setq cfl (cdr cfl)))
-;    (prin1 firsts)
+;;; (prin1 firsts)
     (while firsts
       (if (and (not oldest-entity)
 	       (cdr (cdr (car firsts))))
@@ -182,8 +178,8 @@ If KBYTES is kilo bytes (This value must be float)."
     oldest-entity))
 
 (defun elmo-cache-get-sorted-cache-file-list ()
-  (let ((dirs (directory-files 
-	       (expand-file-name elmo-cache-dirname elmo-msgdb-dir) 
+  (let ((dirs (directory-files
+	       (expand-file-name elmo-cache-dirname elmo-msgdb-dir)
 	       t "^[^\\.]"))
 	(i 0) num
 	elist
@@ -191,33 +187,35 @@ If KBYTES is kilo bytes (This value must be float)."
     (setq num (length dirs))
     (message "Collecting cache info...")
     (while dirs
-      (setq elist (mapcar (lambda (x) 
+      (setq elist (mapcar (lambda (x)
 			    (elmo-cache-make-file-entity x (car dirs)))
 			  (directory-files (car dirs) nil "^[^\\.]")))
       (setq ret-val (append ret-val
 			    (list (cons
 				   (car dirs)
-				   (sort 
+				   (sort
 				    elist
 				    (lambda (x y)
 				      (< (cdr x)
 					 (cdr y))))))))
-      (setq i (+ i 1))
-      (elmo-display-progress
-       'elmo-cache-get-sorted-cache-file-list "Collecting cache info..."
-       (/ (* i 100) num))
+      (when (> num elmo-display-progress-threshold)
+	(setq i (+ i 1))
+	(elmo-display-progress
+	 'elmo-cache-get-sorted-cache-file-list "Collecting cache info..."
+	 (/ (* i 100) num)))
       (setq dirs (cdr dirs)))
+    (message "Collecting cache info...done")
     ret-val))
 
 (defun elmo-cache-expire-by-age (&optional days)
   (let ((age (or (and days (int-to-string days))
 		 (and (interactive-p)
-		      (read-from-minibuffer 
+		      (read-from-minibuffer
 		       (format "Enter days (%s): "
 			       elmo-cache-expire-default-age)))
 		 (int-to-string elmo-cache-expire-default-age)))
-	(dirs (directory-files 
-	       (expand-file-name elmo-cache-dirname elmo-msgdb-dir) 
+	(dirs (directory-files
+	       (expand-file-name elmo-cache-dirname elmo-msgdb-dir)
 	       t "^[^\\.]"))
 	(locked (elmo-dop-lock-list-load))
 	(count 0)
@@ -226,7 +224,7 @@ If KBYTES is kilo bytes (This value must be float)."
 	(setq age elmo-cache-expire-default-age)
       (setq age (string-to-int age)))
     (setq curtime (current-time))
-    (setq curtime (+ (* (nth 0 curtime) 
+    (setq curtime (+ (* (nth 0 curtime)
 			(float 65536)) (nth 1 curtime)))
     (while dirs
       (let ((files (directory-files (car dirs) t "^[^\\.]"))
@@ -241,22 +239,22 @@ If KBYTES is kilo bytes (This value must be float)."
       (setq dirs (cdr dirs)))))
 
 (defun elmo-cache-save (msgid partial folder number &optional inbuf)
-  "If partial is non-nil, save current buffer (or INBUF) as partial cache."
+  "If PARTIAL is non-nil, save current buffer (or INBUF) as partial cache."
   (condition-case nil
-  (save-excursion
-    (let* ((path (if partial
-		     (elmo-cache-get-path msgid folder number)
-		   (elmo-cache-get-path msgid)))
-	   dir tmp-buf)
-      (when path 
-	(setq dir (directory-file-name (file-name-directory path)))
-	(if (not (file-exists-p dir))
-	    (elmo-make-directory dir))
-	(if inbuf (set-buffer inbuf))
-	(goto-char (point-min))
-	(as-binary-output-file (write-region (point-min) (point-max)
-					     path nil 'no-msg)))))
-  (error)))
+      (save-excursion
+	(let* ((path (if partial
+			 (elmo-cache-get-path msgid folder number)
+		       (elmo-cache-get-path msgid)))
+	       dir tmp-buf)
+	  (when path
+	    (setq dir (directory-file-name (file-name-directory path)))
+	    (if (not (file-exists-p dir))
+		(elmo-make-directory dir))
+	    (if inbuf (set-buffer inbuf))
+	    (goto-char (point-min))
+	    (as-binary-output-file (write-region (point-min) (point-max)
+						 path nil 'no-msg)))))
+    (error)))
 
 (defun elmo-cache-exists-p (msgid &optional folder number)
   "Returns the path if the cache exists."
@@ -268,8 +266,8 @@ If KBYTES is kilo bytes (This value must be float)."
 	      (if (and folder
 		       (file-directory-p path))
 		  (if (file-exists-p (setq path (expand-file-name
-						 (format "%s@%s" 
-							 (or number "") 
+						 (format "%s@%s"
+							 (or number "")
 							 (elmo-safe-filename
 							  folder))
 						 path)))
@@ -281,30 +279,36 @@ If KBYTES is kilo bytes (This value must be float)."
 (defun elmo-cache-search-all (folder condition from-msgs)
   (let* ((number-alist (elmo-msgdb-number-load
 			(elmo-msgdb-expand-path folder)))
-	 (nalist number-alist)
+	 (number-list (or from-msgs (mapcar 'car number-alist)))
 	 (num (length number-alist))
 	 cache-file
 	 ret-val
 	 case-fold-search msg
 	 percent i)
-    (setq i 0)    
-    (while nalist
-      (if (and (setq cache-file (elmo-cache-exists-p (cdr (car nalist))
-						     folder 
-						     (car (car nalist))))
-	       (elmo-file-field-condition-match cache-file condition))
-	  (setq ret-val (append ret-val (list (caar nalist)))))
-      (setq i (1+ i))
-      (setq percent (/ (* i 100) num))
-      (elmo-display-progress
-       'elmo-cache-search-all "Searching..."
-       percent)
-      (setq nalist (cdr nalist)))
+    (setq i 0)
+    (while number-alist
+      (if (and (memq (car (car number-alist)) number-list)
+	       (setq cache-file (elmo-cache-exists-p (cdr (car
+							   number-alist))
+						     folder
+						     (car (car
+							   number-alist))))
+	       (elmo-file-field-condition-match cache-file condition
+						(car (car number-alist))
+						number-list))
+	  (setq ret-val (append ret-val (list (caar number-alist)))))
+      (when (> num elmo-display-progress-threshold)
+	(setq i (1+ i))
+	(setq percent (/ (* i 100) num))
+	(elmo-display-progress
+	 'elmo-cache-search-all "Searching..."
+	 percent))
+      (setq number-alist (cdr number-alist)))
     ret-val))
 
 (defun elmo-cache-collect-sub-directories (init dir &optional recursively)
-  "Collect subdirectories under 'dir'"
-  (let ((dirs 
+  "Collect subdirectories under DIR."
+  (let ((dirs
 	 (delete (expand-file-name elmo-cache-dirname
 				   elmo-msgdb-dir)
 		 (directory-files dir t "^[^\\.]")))
@@ -313,14 +317,14 @@ If KBYTES is kilo bytes (This value must be float)."
     (setq ret-val (append init dirs))
     (while (and recursively dirs)
       (setq ret-val
-	    (elmo-cache-collect-sub-directories 
+	    (elmo-cache-collect-sub-directories
 	     ret-val
 	     (car dirs) recursively))
       (setq dirs (cdr dirs)))
     ret-val))
 
 (defun elmo-msgid-to-cache (msgid)
-  (when (and msgid 
+  (when (and msgid
 	     (string-match "<\\(.+\\)>$" msgid))
     (elmo-replace-msgid-as-filename (elmo-match-string 1 msgid))))
 
@@ -330,12 +334,12 @@ If KBYTES is kilo bytes (This value must be float)."
       (expand-file-name
        (expand-file-name
 	(if folder
-	    (format "%s/%s/%s@%s" 
+	    (format "%s/%s/%s@%s"
 		    (elmo-cache-get-path-subr msgid)
 		    msgid
 		    (or number "")
 		    (elmo-safe-filename folder))
-	  (format "%s/%s" 
+	  (format "%s/%s"
 		  (elmo-cache-get-path-subr msgid)
 		  msgid))
 	(expand-file-name elmo-cache-dirname
@@ -354,13 +358,13 @@ If KBYTES is kilo bytes (This value must be float)."
   
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; buffer cache module
+;; buffer cache module
 
 (defconst elmo-buffer-cache-name " *elmo cache*")
 
 (defvar elmo-buffer-cache nil
-  "Message cache. (old ... new) order alist with association
- ((\"folder\" message \"message-id\") . cache-buffer)")
+  "Message cache.  (old ... new) order alist.
+With association ((\"folder\" message \"message-id\") . cache-buffer).")
 
 (defmacro elmo-buffer-cache-buffer-get (entry)
   (` (cdr (, entry))))
@@ -390,7 +394,7 @@ If KBYTES is kilo bytes (This value must be float)."
     (setq elmo-buffer-cache (cdr top))))
 
 (defun elmo-buffer-cache-add (fld-msg-id)
-  "Adding (fld-msg-id . buf) to the top of \"elmo-buffer-cache\".
+  "Adding (FLD-MSG-ID . buf) to the top of `elmo-buffer-cache'.
 Returning its cache buffer."
   (let ((len (length elmo-buffer-cache))
 	(buf nil))
@@ -423,9 +427,9 @@ Returning its cache buffer."
       (setq n (1+ n))))
   (setq elmo-buffer-cache nil))
 
-;;;
-;;; cache backend by Kenichi OKADA <okada@opaopa.org>
-;;;
+;;
+;; cache backend by Kenichi OKADA <okada@opaopa.org>
+;;
 
 (defsubst elmo-cache-get-folder-directory (spec)
   (if (file-name-absolute-p (nth 1 spec))
@@ -453,14 +457,14 @@ Returning its cache buffer."
   (defsubst elmo-cache-insert-header (file)
     "Insert the header of the article."
     (let ((beg 0)
-	  insert-file-contents-pre-hook   ; To avoid autoconv-xmas...
+	  insert-file-contents-pre-hook	; To avoid autoconv-xmas...
 	  insert-file-contents-post-hook
 	  format-alist)
       (when (file-exists-p file)
 	;; Read until header separator is found.
 	(while (and (eq elmo-localdir-header-chop-length
-			(nth 1 
-			     (as-binary-input-file 
+			(nth 1
+			     (as-binary-input-file
 			      (insert-file-contents
 			       file nil beg
 			       (incf beg elmo-localdir-header-chop-length)))))
@@ -528,17 +532,18 @@ Returning its cache buffer."
 				  nil
 				new-mark)))
 	      (setq mark-alist
-		    (elmo-msgdb-mark-append 
-		     mark-alist 
+		    (elmo-msgdb-mark-append
+		     mark-alist
 		     num
 		     gmark))))
-	(setq i (1+ i))
-	(setq percent (/ (* i 100) len))
-	(elmo-display-progress
-	 'elmo-cache-msgdb-create-as-numlist "Creating msgdb..."
-	 percent)
+	(when (> len elmo-display-progress-threshold)
+	  (setq i (1+ i))
+	  (setq percent (/ (* i 100) len))
+	  (elmo-display-progress
+	   'elmo-cache-msgdb-create-as-numlist "Creating msgdb..."
+	   percent))
 	(setq numlist (cdr numlist)))
-      (message "Creating msgdb...done.")
+      (message "Creating msgdb...done")
       (list overview number-alist mark-alist))))
 
 (defalias 'elmo-cache-msgdb-create 'elmo-cache-msgdb-create-as-numlist)
@@ -557,7 +562,7 @@ Returning its cache buffer."
 		(expand-file-name
 		 (nth 1 (elmo-folder-get-spec folder))
 		 (expand-file-name elmo-cache-dirname elmo-msgdb-dir)))
-	  (if (string-match "^[+=$!]$" folder) ;; localdir, archive, localnews
+	  (if (string-match "^[+=$!]$" folder) ; localdir, archive, localnews
 	      (setq subprefix folder)
 	    (setq subprefix (concat folder elmo-path-sep)))
 	    ;; include parent
@@ -579,10 +584,10 @@ Returning its cache buffer."
   (let* ((dir (elmo-cache-get-folder-directory spec))
 	 (flist (mapcar 'file-name-nondirectory
 			(elmo-delete-if 'file-directory-p
-					(directory-files 
+					(directory-files
 					 dir t "^[^@]+@[^@]+$" t))))
 	 (folder (concat "'cache/" (nth 1 spec)))
-	 (number-alist (or (elmo-msgdb-number-load 
+	 (number-alist (or (elmo-msgdb-number-load
 			    (elmo-msgdb-expand-path folder))
 			   (list nil)))
 	 nlist)
@@ -633,10 +638,10 @@ Returning its cache buffer."
     ;; return nil if failed.
     (elmo-cache-force-delete file locked)))
 
-(defun elmo-cache-read-msg (spec number outbuf &optional set-mark)
+(defun elmo-cache-read-msg (spec number outbuf &optional msgdb unread)
   (save-excursion
     (let* ((dir (elmo-cache-get-folder-directory spec))
-	   (file (expand-file-name 
+	   (file (expand-file-name
 		  (elmo-cache-number-to-filename spec number) dir)))
       (set-buffer outbuf)
       (erase-buffer)
@@ -650,8 +655,13 @@ Returning its cache buffer."
 	       (mapcar '(lambda (msg) (elmo-cache-delete-msg spec msg locked))
 		       msgs)))))
 
-(defun elmo-cache-list-folder (spec); called by elmo-cache-search()
-  (elmo-cache-list-folder-subr spec))
+(defun elmo-cache-list-folder (spec)	; called by elmo-cache-search()
+  (let ((killed (and elmo-use-killed-list
+		     (elmo-msgdb-killed-list-load
+		      (elmo-msgdb-expand-path spec))))
+	numbers)
+    (setq numbers (elmo-cache-list-folder-subr spec))
+    (elmo-living-messages numbers killed)))
 
 (defun elmo-cache-max-of-folder (spec)
   (elmo-cache-list-folder-subr spec t))
@@ -678,16 +688,19 @@ Returning its cache buffer."
 	 (i 0) case-fold-search ret-val)
     (while msgs
       (if (elmo-file-field-condition-match
-	   (expand-file-name 
+	   (expand-file-name
 	    (elmo-msgid-to-cache
 	     (cdr (assq (car msgs) number-alist)))
 	    (elmo-cache-get-folder-directory spec))
-					    condition)
+	   condition
+	   (car msgs)
+	   msgs)
 	  (setq ret-val (cons (car msgs) ret-val)))
-      (setq i (1+ i))
-      (elmo-display-progress
-       'elmo-cache-search "Searching..."
-       (/ (* i 100) num))
+      (when (> num elmo-display-progress-threshold)
+	(setq i (1+ i))
+	(elmo-display-progress
+	 'elmo-cache-search "Searching..."
+	 (/ (* i 100) num)))
       (setq msgs (cdr msgs)))
     (nreverse ret-val)))
 
@@ -699,7 +712,7 @@ Returning its cache buffer."
 	(next-num (1+ (car (elmo-cache-list-folder-subr dst-spec t))))
 	(number-alist
 	 (elmo-msgdb-number-load
-	  (elmo-msgdb-expand-path nil src-spec))))
+	  (elmo-msgdb-expand-path src-spec))))
     (if same-number (error "Not implemented"))
     (while msgs
       (elmo-copy-file
@@ -709,7 +722,7 @@ Returning its cache buffer."
        (expand-file-name
 	(elmo-msgid-to-cache
 	 (cdr (assq (if same-number (car msgs) next-num) number-alist)))
-	 dst-dir))
+	dst-dir))
       (if (and (setq msgs (cdr msgs))
 	       (not same-number))
 	  (setq next-num (1+ next-num))))
@@ -726,14 +739,16 @@ Returning its cache buffer."
    (elmo-cache-number-to-filename spec number)
    (elmo-cache-get-folder-directory spec)))
 
-(defalias 'elmo-cache-sync-number-alist 
+(defalias 'elmo-cache-sync-number-alist
   'elmo-generic-sync-number-alist)
-(defalias 'elmo-cache-list-folder-unread 
+(defalias 'elmo-cache-list-folder-unread
   'elmo-generic-list-folder-unread)
 (defalias 'elmo-cache-list-folder-important
   'elmo-generic-list-folder-important)
 (defalias 'elmo-cache-commit 'elmo-generic-commit)
+(defalias 'elmo-cache-folder-diff 'elmo-generic-folder-diff)
 
-(provide 'elmo-cache)
+(require 'product)
+(product-provide (provide 'elmo-cache) (require 'elmo-version))
 
 ;;; elmo-cache.el ends here