X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;ds=sidebyside;f=wl%2Fwl-expire.el;h=bf32cf1c11107bed4782385ea58fa30f6efebcf6;hb=8a81d3a3caef0f94f9721361a749f0b6429f30ce;hp=003c749f7ee85d49ee1da1ad4c9603e8b02be48e;hpb=1e366a559be4aec4ad4d3cf3e954b8e62a20d2f3;p=elisp%2Fwanderlust.git

diff --git a/wl/wl-expire.el b/wl/wl-expire.el
index 003c749..bf32cf1 100644
--- a/wl/wl-expire.el
+++ b/wl/wl-expire.el
@@ -1,11 +1,10 @@
-;;; wl-expire.el -- Message expire modules for Wanderlust.
+;;; wl-expire.el --- Message expire modules for Wanderlust.
 
-;; Copyright 1998,1999,2000 Masahiro MURATA <muse@ba2.so-net.ne.jp>
-;;                          Yuuichi Teranishi <teranisi@gohome.org>
+;; Copyright (C) 1998,1999,2000 Masahiro MURATA <muse@ba2.so-net.ne.jp>
+;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
 
 ;; Author: Masahiro MURATA <muse@ba2.so-net.ne.jp>
 ;; Keywords: mail, net news
-;; Time-stamp: <00/03/14 19:34:13 teranisi>
 
 ;; This file is part of Wanderlust (Yet Another Message Interface on Emacsen).
 
@@ -26,11 +25,12 @@
 ;;
 
 ;;; Commentary:
-;; 
+;;
 
 (require 'wl-summary)
 (require 'wl-thread)
 (require 'wl-folder)
+(require 'elmo)
 
 ;;; Code:
 
@@ -44,16 +44,17 @@
 (defvar wl-expired-alist-file-name "expired-alist")
 (defvar wl-expired-log-alist nil)
 (defvar wl-expired-log-alist-file-name "expired-log")
+(defvar wl-expire-test nil)	;; for debug (no execute)
 
 (defun wl-expired-alist-load ()
   (elmo-object-load (expand-file-name
 		     wl-expired-alist-file-name
-		     elmo-msgdb-dir)))
+		     elmo-msgdb-directory)))
 
 (defun wl-expired-alist-save (&optional alist)
   (elmo-object-save (expand-file-name
 		     wl-expired-alist-file-name
-		     elmo-msgdb-dir)
+		     elmo-msgdb-directory)
 		    (or alist wl-expired-alist)))
 
 (defsubst wl-expire-msg-p (msg-num mark-alist)
@@ -69,7 +70,7 @@
 	((eq wl-summary-expire-reserve-marks 'none)
 	 t)
 	(t
-	 (error "invalid marks: %s" wl-summary-expire-reserve-marks))))
+	 (error "Invalid marks: %s" wl-summary-expire-reserve-marks))))
 
 (defmacro wl-expire-make-sortable-date (date)
   (` (timezone-make-sortable-date
@@ -87,183 +88,193 @@
       (wl-expire-make-sortable-date datevec)
       (wl-expire-make-sortable-date key-datevec)))))
 
-(defun wl-expire-delete-reserve-marked-msgs-from-list (msgs mark-alist)
+;; New functions to avoid accessing to the msgdb directly.
+(defsubst wl-expire-message-p (folder number)
+  "Return non-nil when a message in the FOLDER with NUMBER can be expired."
+  (cond ((consp wl-summary-expire-reserve-marks)
+	 (let ((mark (wl-summary-message-mark folder number)))
+	   (not (or (member mark wl-summary-expire-reserve-marks)
+		    (and wl-summary-buffer-disp-msg
+			 (eq number wl-summary-buffer-current-msg))))))
+	((eq wl-summary-expire-reserve-marks 'all)
+	 (not (or (wl-summary-message-mark folder number)
+		  (and wl-summary-buffer-disp-msg
+		       (eq number wl-summary-buffer-current-msg)))))
+	((eq wl-summary-expire-reserve-marks 'none)
+	 t)
+	(t
+	 (error "Invalid marks: %s" wl-summary-expire-reserve-marks))))
+
+(defun wl-expire-delete-reserved-messages (msgs folder)
+  "Delete a number from NUMBERS when a message with the number is reserved."
   (let ((dlist msgs))
     (while dlist
-      (unless (wl-expire-msg-p (car dlist) mark-alist)
+      (unless (wl-expire-message-p folder (car dlist))
 	(setq msgs (delq (car dlist) msgs)))
       (setq dlist (cdr dlist)))
     msgs))
+;; End New functions.
 
-(defun wl-expire-delete (folder delete-list msgdb &optional no-reserve-marks)
+(defun wl-expire-delete (folder delete-list &optional no-reserve-marks)
   "Delete message for expire."
   (unless no-reserve-marks
     (setq delete-list
-	  (wl-expire-delete-reserve-marked-msgs-from-list
-	   delete-list (elmo-msgdb-get-mark-alist msgdb))))
+	  (wl-expire-delete-reserved-messages delete-list folder)))
   (when delete-list
-   (let ((mess
-	 (format "Expiring (delete) %s msgs..."
-		 (length delete-list))))
-    (message "%s" mess)
-    (if (elmo-delete-msgs folder
-			  delete-list
-			  msgdb)
-	(progn
-	  (elmo-msgdb-delete-msgs folder
-				  delete-list
-				  msgdb
-				  t)
-	  (wl-expire-append-log folder delete-list nil 'delete)
-	  (message "%s" (concat mess "done")))
-      (error (concat mess "failed!")))))
+    (let ((mess
+	   (format "Expiring (delete) %s msgs..."
+		   (length delete-list))))
+      (message "%s" mess)
+      (if (elmo-folder-move-messages folder delete-list 'null)
+	  (progn
+	    (wl-expire-append-log
+	     (elmo-folder-name-internal folder)
+	     delete-list nil 'delete)
+	    (message "%sdone" mess))
+	(error "%sfailed!" mess))))
   (cons delete-list (length delete-list)))
 
-(defun wl-expire-refile (folder refile-list msgdb dst-folder
+(defun wl-expire-refile (folder refile-list dst-folder
 				&optional no-reserve-marks preserve-number copy)
   "Refile message for expire. If COPY is non-nil, copy message."
-  (when (not (string= folder dst-folder))
+  (when (not (string= (elmo-folder-name-internal folder) dst-folder))
     (unless no-reserve-marks
       (setq refile-list
-	    (wl-expire-delete-reserve-marked-msgs-from-list
-	     refile-list (elmo-msgdb-get-mark-alist msgdb))))
+	    (wl-expire-delete-reserved-messages refile-list folder)))
     (when refile-list
-     (let* ((doingmes (if copy
-			 "Copying %s"
-		       "Expiring (move %s)"))
-	   (mess (format (concat doingmes " %s msgs...")
-			 dst-folder (length refile-list))))
-      (message "%s" mess)
-      (unless (or (elmo-folder-exists-p dst-folder)
-		  (elmo-create-folder dst-folder))
-	(error "%s: create folder failed" dst-folder))
-      (if wl-expire-add-seen-list
-	  (elmo-msgdb-add-msgs-to-seen-list 
-	   dst-folder
-	   refile-list
-	   msgdb 
-	   (concat wl-summary-important-mark
-		   wl-summary-read-uncached-mark)))
-      (if (elmo-move-msgs folder
-			  refile-list
-			  dst-folder
-			  msgdb
-			  nil nil t
-			  copy
-			  preserve-number)
-	  (progn
-	    (wl-expire-append-log folder refile-list dst-folder (if copy 'copy 'move))
-	    (message "%s" (concat mess "done")))
-	(error (concat mess "failed!")))))
+      (let* ((doingmes (if copy
+			   "Copying %s"
+			 "Expiring (move %s)"))
+	     (dst-folder (wl-folder-get-elmo-folder dst-folder))
+	     (mess (format (concat doingmes " %s msgs...")
+			   (elmo-folder-name-internal dst-folder)
+			   (length refile-list))))
+	(message "%s" mess)
+	(if wl-expire-test
+	    nil
+	  (unless (or (elmo-folder-exists-p dst-folder)
+		      (elmo-folder-create dst-folder))
+	    (error "%s: create folder failed"
+		   (elmo-folder-name-internal dst-folder)))
+	  (if (elmo-folder-move-messages folder
+					 refile-list
+					 dst-folder
+					 copy
+					 preserve-number)
+	      (progn
+		(wl-expire-append-log
+		 (elmo-folder-name-internal folder)
+		 refile-list
+		 (elmo-folder-name-internal dst-folder)
+		 (if copy 'copy 'move))
+		(message "%sdone" mess))
+	    (error "%sfailed!" mess)))))
     (cons refile-list (length refile-list))))
 
 (defun wl-expire-refile-with-copy-reserve-msg
-  (folder refile-list msgdb dst-folder
+  (folder refile-list dst-folder
 	  &optional no-reserve-marks preserve-number copy)
   "Refile message for expire.
 If REFILE-LIST includes reserve mark message, so copy."
-  (when (not (string= folder dst-folder))
+  (when (not (string= (elmo-folder-name-internal folder) dst-folder))
     (let ((msglist refile-list)
-	  (mark-alist (elmo-msgdb-get-mark-alist msgdb))
-	  (number-alist (elmo-msgdb-get-number-alist msgdb))
+	  (dst-folder (wl-folder-get-elmo-folder dst-folder))
 	  (ret-val t)
 	  (copy-reserve-message)
 	  (copy-len 0)
 	  msg msg-id)
       (message "Expiring (move %s) %s msgs..."
-	       dst-folder (length refile-list))
-      (unless (or (elmo-folder-exists-p dst-folder)
-		  (elmo-create-folder dst-folder))
-	(error "%s: create folder failed" dst-folder))
-      (while (setq msg (wl-pop msglist))
-	(unless (wl-expire-msg-p msg mark-alist)
-	  (setq msg-id (cdr (assq msg number-alist)))
-	  (if (assoc msg-id wl-expired-alist)
-	      ;; reserve mark message already refiled or expired
-	      (setq refile-list (delq msg refile-list))
-	    ;; reserve mark message not refiled
-	    (wl-append wl-expired-alist (list (cons msg-id dst-folder)))
-	    (setq copy-reserve-message t))))
-      (when refile-list
-	(if wl-expire-add-seen-list
-	    (elmo-msgdb-add-msgs-to-seen-list 
-	     dst-folder
-	     refile-list
-	     msgdb 
-	     (concat wl-summary-important-mark
-		     wl-summary-read-uncached-mark)))
-	(unless
-	    (setq ret-val
-		  (elmo-move-msgs folder
-				  refile-list
-				  dst-folder
-				  msgdb
-				  nil nil t
-				  copy-reserve-message
-				  preserve-number))
-	  (error "expire: move msgs to %s failed" dst-folder))
-	(wl-expire-append-log folder refile-list dst-folder
-			   (if copy-reserve-message 'copy 'move))
-	(setq copy-len (length refile-list))
-	(when copy-reserve-message
-	  (setq refile-list
-		(wl-expire-delete-reserve-marked-msgs-from-list
-		 refile-list 
-		 mark-alist))
-	  (when refile-list 
-	   (if (setq ret-val
-		    (elmo-delete-msgs folder
-				      refile-list
-				      msgdb))
-	      (progn
-		(elmo-msgdb-delete-msgs folder
-					refile-list
-					msgdb
-					t)
-		(wl-expire-append-log folder refile-list nil 'delete))))))
-      (let ((mes (format "Expiring (move %s) %s msgs..."
-			 dst-folder (length refile-list))))
-	(if ret-val
-	    (message (concat mes "done"))
-	  (error (concat mes "failed!"))))
+	       (elmo-folder-name-internal dst-folder) (length refile-list))
+      (if wl-expire-test
+	  (setq copy-len (length refile-list))
+	(unless (or (elmo-folder-exists-p dst-folder)
+		  (elmo-folder-create dst-folder))
+	(error "%s: create folder failed" (elmo-folder-name-internal
+					   dst-folder)))
+	(while (setq msg (wl-pop msglist))
+	  (unless (wl-expire-message-p folder msg)
+	    (setq msg-id (elmo-message-field folder msg 'message-id))
+	    (if (assoc msg-id wl-expired-alist)
+		;; reserve mark message already refiled or expired
+		(setq refile-list (delq msg refile-list))
+	      ;; reserve mark message not refiled
+	      (wl-append wl-expired-alist (list 
+					   (cons msg-id
+						 (elmo-folder-name-internal
+						  dst-folder))))
+	      (setq copy-reserve-message t))))
+	(when refile-list
+	  (unless
+	      (setq ret-val
+		    (elmo-folder-move-messages folder
+					       refile-list
+					       dst-folder
+					       copy-reserve-message
+					       preserve-number))
+	    (error "Expire: move msgs to %s failed"
+		   (elmo-folder-name-internal dst-folder)))
+	  (wl-expire-append-log (elmo-folder-name-internal folder)
+				refile-list
+				(elmo-folder-name-internal dst-folder)
+				(if copy-reserve-message 'copy 'move))
+	  (setq copy-len (length refile-list))
+	  (when copy-reserve-message
+	    (setq refile-list
+		  (wl-expire-delete-reserved-messages refile-list folder))
+	    (when refile-list
+	      (if (setq ret-val
+			(elmo-folder-move-messages folder refile-list 'null))
+		  (progn
+		    (wl-expire-append-log
+		     (elmo-folder-name-internal folder)
+		     refile-list nil 'delete))))))
+	(let ((mes (format "Expiring (move %s) %s msgs..."
+			   (elmo-folder-name-internal dst-folder)
+			   (length refile-list))))
+	  (if ret-val
+	      (message "%sdone" mes)
+	    (error "%sfailed!" mes))))
       (cons refile-list copy-len))))
 
-(defun wl-expire-archive-get-folder (src-folder &optional fmt)
-  "Get archive folder name from src-folder."
-  (let* ((spec (elmo-folder-get-spec src-folder))
-	 (fmt (or fmt wl-expire-archive-folder-name-fmt))
+(defun wl-expire-archive-get-folder (src-folder &optional fmt dst-folder-arg)
+  "Get archive folder name from SRC-FOLDER."
+  (let* ((fmt (or fmt wl-expire-archive-folder-name-fmt))
+	 (src-folde-name (substring
+			  (elmo-folder-name-internal src-folder)
+			  (length (elmo-folder-prefix-internal src-folder))))
 	 (archive-spec (char-to-string
-			(car (rassq 'archive elmo-spec-alist))))
+			(car (rassq 'archive elmo-folder-type-alist))))
 	 dst-folder-base dst-folder-fmt prefix)
-    (cond ((eq (car spec) 'localdir)
-	   (setq dst-folder-base (concat archive-spec (nth 1 spec))))
-	  ((stringp (nth 1 spec))
+    (cond (dst-folder-arg
+	   (setq dst-folder-base (concat archive-spec dst-folder-arg)))
+	  ((eq (elmo-folder-type-internal src-folder) 'localdir)
 	   (setq dst-folder-base
-		 (elmo-concat-path (format "%s%s" archive-spec (car spec))
-				   (nth 1 spec))))
+		 (concat archive-spec src-folde-name)))
 	  (t
 	   (setq dst-folder-base
-		 (elmo-concat-path (format "%s%s" archive-spec (car spec))
-				   (elmo-replace-msgid-as-filename 
-				    src-folder)))))
+		 (elmo-concat-path
+		  (format "%s%s" archive-spec (elmo-folder-type-internal
+					       src-folder))
+		  src-folde-name))))
     (setq dst-folder-fmt (format fmt
 				 dst-folder-base
 				 wl-expire-archive-folder-type))
     (setq dst-folder-base (format "%s;%s"
 				  dst-folder-base
 				  wl-expire-archive-folder-type))
-    (when (and wl-expire-archive-folder-prefix
-	       (stringp (nth 1 spec)))
+    (when wl-expire-archive-folder-prefix
       (cond ((eq wl-expire-archive-folder-prefix 'short)
-	     (setq prefix (file-name-nondirectory (nth 1 spec))))
+	     (setq prefix (file-name-nondirectory
+			   src-folde-name)))
 	    (t
-	     (setq prefix (nth 1 spec))))
+	     (setq prefix src-folde-name)))
       (setq dst-folder-fmt (concat dst-folder-fmt ";" prefix))
       (setq dst-folder-base (concat dst-folder-base ";" prefix)))
     (cons dst-folder-base dst-folder-fmt)))
 
 (defsubst wl-expire-archive-get-max-number (dst-folder-base &optional regexp)
-  (let ((files (reverse (sort (elmo-list-folders dst-folder-base)
+  (let ((files (reverse (sort (elmo-folder-list-subfolders
+			       (elmo-make-folder dst-folder-base))
 			      'string<)))
 	(regexp (or regexp wl-expire-archive-folder-num-regexp))
 	filenum in-folder)
@@ -271,19 +282,23 @@ If REFILE-LIST includes reserve mark message, so copy."
       (while files
 	(when (string-match regexp (car files))
 	  (setq filenum (elmo-match-string 1 (car files)))
-	  (setq in-folder (elmo-max-of-folder (car files)))
+	  (setq in-folder (elmo-folder-status
+			   (wl-folder-get-elmo-folder (car files))))
 	  (throw 'done (cons in-folder filenum)))
 	(setq files (cdr files))))))
 
 (defun wl-expire-archive-number-delete-old (dst-folder-base
-					    preserve-number msgs mark-alist
+					    preserve-number msgs folder
 					    &optional no-confirm regexp file)
   (let ((len 0) (max-num 0)
 	folder-info dels)
     (if (or (and file (setq folder-info
-			    (cons (elmo-max-of-folder file) nil)))
-	    (setq folder-info (wl-expire-archive-get-max-number dst-folder-base
-								regexp)))
+			    (cons (elmo-folder-status
+				   (wl-folder-get-elmo-folder file))
+				  nil)))
+	    (setq folder-info (wl-expire-archive-get-max-number
+			       dst-folder-base
+			       regexp)))
 	(progn
 	  (setq len (cdar folder-info))
 	  (when preserve-number
@@ -292,10 +307,10 @@ If REFILE-LIST includes reserve mark message, so copy."
 	    (while (and msgs (>= max-num (car msgs)))
 	      (wl-append dels (list (car msgs)))
 	      (setq msgs (cdr msgs)))
-	    (setq dels (wl-expire-delete-reserve-marked-msgs-from-list
-			dels mark-alist))
+	    (setq dels (wl-expire-delete-reserved-messages dels folder))
 	    (unless (and dels
-			 (or (or no-confirm (not wl-expire-delete-oldmsg-confirm))
+			 (or (or no-confirm (not
+					     wl-expire-delete-oldmsg-confirm))
 			     (progn
 			       (if (eq major-mode 'wl-summary-mode)
 				   (wl-thread-jump-to-msg (car dels)))
@@ -305,13 +320,19 @@ If REFILE-LIST includes reserve mark message, so copy."
 	  (list msgs dels max-num (cdr folder-info) len))
       (list msgs dels 0 "0" 0))))
 
-(defun wl-expire-archive-number1 (folder delete-list msgdb
-					 &optional preserve-number no-delete)
+(defun wl-expire-archive-number1 (folder delete-list
+				  &optional preserve-number dst-folder-arg
+					    no-delete)
   "Standard function for `wl-summary-expire'.
 Refile to archive folder followed message number."
   (let* ((elmo-archive-treat-file t)	;; treat archive folder as a file.
+	 (dst-folder-expand (and dst-folder-arg
+				 (wl-expand-newtext
+				  dst-folder-arg
+				  (elmo-folder-name-internal folder))))
 	 (dst-folder-fmt (funcall
-			  wl-expire-archive-get-folder-func folder))
+			  wl-expire-archive-get-folder-function
+			  folder nil dst-folder-expand))
 	 (dst-folder-base (car dst-folder-fmt))
 	 (dst-folder-fmt (cdr dst-folder-fmt))
 	 (refile-func (if no-delete
@@ -322,11 +343,11 @@ Refile to archive folder followed message number."
 	 deleted-list ret-val)
     (setq tmp (wl-expire-archive-number-delete-old
 	       dst-folder-base preserve-number delete-list
-	       (elmo-msgdb-get-mark-alist msgdb)
+	       folder
 	       no-delete))
     (when (and (not no-delete)
 	       (setq dels (nth 1 tmp)))
-      (wl-append deleted-list (car (wl-expire-delete folder dels msgdb))))
+      (wl-append deleted-list (car (wl-expire-delete folder dels))))
     (setq delete-list (car tmp))
     (catch 'done
       (while t
@@ -340,7 +361,7 @@ Refile to archive folder followed message number."
 	  (and (setq ret-val
 		     (funcall
 		      refile-func
-		      folder arcmsg-list msgdb dst-folder t preserve-number
+		      folder arcmsg-list dst-folder t preserve-number
 		      no-delete))
 	       (wl-append deleted-list (car ret-val)))
 	  (setq arcmsg-list nil))
@@ -348,16 +369,21 @@ Refile to archive folder followed message number."
 	    (throw 'done t))
 	(wl-append arcmsg-list (list msg))
 	(setq prev-arcnum arcnum)))
-    deleted-list
-    ))
+    deleted-list))
 
-(defun wl-expire-archive-number2 (folder delete-list msgdb
-					 &optional preserve-number no-delete)
+(defun wl-expire-archive-number2 (folder delete-list
+				  &optional preserve-number dst-folder-arg
+					    no-delete)
   "Standard function for `wl-summary-expire'.
 Refile to archive folder followed the number of message in one archive folder."
   (let* ((elmo-archive-treat-file t)	;; treat archive folder as a file.
+	 (dst-folder-expand (and dst-folder-arg
+				 (wl-expand-newtext
+				  dst-folder-arg
+				  (elmo-folder-name-internal folder))))
 	 (dst-folder-fmt (funcall
-			  wl-expire-archive-get-folder-func folder))
+			  wl-expire-archive-get-folder-function
+			  folder nil dst-folder-expand))
 	 (dst-folder-base (car dst-folder-fmt))
 	 (dst-folder-fmt (cdr dst-folder-fmt))
 	 (refile-func (if no-delete
@@ -369,11 +395,11 @@ Refile to archive folder followed the number of message in one archive folder."
 	 deleted-list ret-val)
     (setq tmp (wl-expire-archive-number-delete-old
 	       dst-folder-base preserve-number delete-list
-	       (elmo-msgdb-get-mark-alist msgdb)
+	       folder
 	       no-delete))
     (when (and (not no-delete)
 	       (setq dels (nth 1 tmp)))
-      (wl-append deleted-list (car (wl-expire-delete folder dels msgdb))))
+      (wl-append deleted-list (car (wl-expire-delete folder dels))))
     (setq delete-list (car tmp)
 	  filenum (string-to-int (nth 3 tmp))
 	  len (nth 4 tmp)
@@ -389,7 +415,7 @@ Refile to archive folder followed the number of message in one archive folder."
 	    (and (setq ret-val
 		       (funcall
 			refile-func
-			folder arcmsg-list msgdb dst-folder t preserve-number
+			folder arcmsg-list dst-folder t preserve-number
 			no-delete))
 		 (wl-append deleted-list (car ret-val)))
 	    (setq arc-len (+ arc-len (cdr ret-val))))
@@ -403,20 +429,23 @@ Refile to archive folder followed the number of message in one archive folder."
 	(if (null msg)
 	    (throw 'done t))
 	(wl-append arcmsg-list (list msg))))
-    deleted-list
-    ))
+    deleted-list))
 
-(defun wl-expire-archive-date (folder delete-list msgdb
-				      &optional preserve-number no-delete)
+(defun wl-expire-archive-date (folder delete-list
+			       &optional preserve-number dst-folder-arg
+					 no-delete)
   "Standard function for `wl-summary-expire'.
 Refile to archive folder followed message date."
   (let* ((elmo-archive-treat-file t)	;; treat archive folder as a file.
-	 (number-alist (elmo-msgdb-get-number-alist msgdb))
-	 (overview (elmo-msgdb-get-overview msgdb))
+	 (dst-folder-expand (and dst-folder-arg
+				 (wl-expand-newtext
+				  dst-folder-arg
+				  (elmo-folder-name-internal folder))))
 	 (dst-folder-fmt (funcall
-			  wl-expire-archive-get-folder-func
+			  wl-expire-archive-get-folder-function
 			  folder
 			  wl-expire-archive-date-folder-name-fmt
+			  dst-folder-expand
 			  ))
 	 (dst-folder-base (car dst-folder-fmt))
 	 (dst-folder-fmt (cdr dst-folder-fmt))
@@ -428,16 +457,15 @@ Refile to archive folder followed message date."
 	 deleted-list ret-val)
     (setq tmp (wl-expire-archive-number-delete-old
 	       dst-folder-base preserve-number delete-list
-	       (elmo-msgdb-get-mark-alist msgdb)
+	       folder
 	       no-delete
 	       wl-expire-archive-date-folder-num-regexp))
     (when (and (not no-delete)
 	       (setq dels (nth 1 tmp)))
-      (wl-append deleted-list (car (wl-expire-delete folder dels msgdb))))
+      (wl-append deleted-list (car (wl-expire-delete folder dels))))
     (setq delete-list (car tmp))
     (while (setq msg (wl-pop delete-list))
-      (setq date (elmo-msgdb-overview-entity-get-date
-		  (assoc (cdr (assq msg number-alist)) overview)))
+      (setq date (elmo-message-field folder msg 'date))
       (setq time
 	    (condition-case nil
 		(timezone-fix-time date nil nil)
@@ -459,34 +487,134 @@ Refile to archive folder followed message date."
       (and (setq ret-val
 		 (funcall
 		  refile-func
-		  folder arcmsg-list msgdb dst-folder t preserve-number
+		  folder arcmsg-list dst-folder t preserve-number
 		  no-delete))
 	   (wl-append deleted-list (car ret-val)))
       (setq arcmsg-alist (cdr arcmsg-alist)))
-    deleted-list
-    ))
+    deleted-list))
+
+;;; wl-expire-localdir-date
+(defvar wl-expire-localdir-date-folder-name-fmt "%s/%%04d_%%02d")
+
+(defcustom wl-expire-localdir-get-folder-function
+  'wl-expire-localdir-get-folder
+  "*A function to get localdir folder name."
+  :type 'function
+  :group 'wl-expire)
+
+(defun wl-expire-localdir-get-folder (src-folder fmt dst-folder-arg)
+  "Get localdir folder name from src-folder."
+  (let* ((src-folder-name (substring
+			   (elmo-folder-name-internal src-folder)
+			   (length (elmo-folder-prefix-internal src-folder))))
+	 (dst-folder-spec (char-to-string
+			   (car (rassq 'localdir elmo-folder-type-alist))))
+	 dst-folder-base dst-folder-fmt)
+    (cond (dst-folder-arg
+	   (setq dst-folder-base (concat dst-folder-spec dst-folder-arg)))
+	  ((eq (elmo-folder-type-internal src-folder) 'localdir)
+	   (setq dst-folder-base (concat dst-folder-spec src-folder-name)))
+	  (t
+	   (setq dst-folder-base
+		 (elmo-concat-path
+		  (format "%s%s"
+			  dst-folder-spec
+			  (elmo-folder-type-internal src-folder))
+		  src-folder-name))))
+    (setq dst-folder-fmt
+	  (format fmt dst-folder-base))
+    (cons dst-folder-base dst-folder-fmt)))
 
-(defsubst wl-expire-folder-p (folder)
-  (wl-get-assoc-list-value wl-expire-alist folder))
+(defun wl-expire-localdir-date (folder delete-list
+				       &optional preserve-number dst-folder-arg
+				       no-delete)
+  "Function for `wl-summary-expire'.
+Refile to localdir folder by message date.
+ex. +ml/wl/1999_11/, +ml/wl/1999_12/."
+  (let* ((dst-folder-expand (and dst-folder-arg
+				 (wl-expand-newtext
+				  dst-folder-arg
+				  (elmo-folder-name-internal folder))))
+	 (dst-folder-fmt (funcall
+			  wl-expire-localdir-get-folder-function
+			  folder
+			  wl-expire-localdir-date-folder-name-fmt
+			  dst-folder-expand))
+	 (dst-folder-base (car dst-folder-fmt))
+	 (dst-folder-fmt (cdr dst-folder-fmt))
+	 (refile-func (if no-delete
+			  'wl-expire-refile
+			'wl-expire-refile-with-copy-reserve-msg))
+	 tmp dels dst-folder date time
+	 msg arcmsg-alist arcmsg-list
+	 deleted-list ret-val)
+    (while (setq msg (wl-pop delete-list))
+      (setq date (elmo-message-field folder msg 'date))
+      (setq time
+	    (condition-case nil
+		(timezone-fix-time date nil nil)
+	      (error [0 0 0 0 0 0 0])))
+      (if (= (aref time 1) 0)	;; if (month == 0)
+	  (aset time 0 0))	;;    year = 0
+      (setq dst-folder (format dst-folder-fmt
+			       (aref time 0);; year
+			       (aref time 1);; month
+			       ))
+      (setq arcmsg-alist
+	    (wl-append-assoc-list
+	     dst-folder
+	     msg
+	     arcmsg-alist)))
+    (while arcmsg-alist
+      (setq dst-folder (caar arcmsg-alist))
+      (setq arcmsg-list (cdar arcmsg-alist))
+      (and (setq ret-val
+		 (funcall
+		  refile-func
+		  folder arcmsg-list dst-folder t preserve-number
+		  no-delete))
+	   (wl-append deleted-list (car ret-val)))
+      (setq arcmsg-alist (cdr arcmsg-alist)))
+    deleted-list))
 
-(defun wl-summary-expire (&optional folder-name notsummary nolist)
+(defun wl-expire-hide (folder hide-list &optional no-reserve-marks)
+  "Hide message for expire."
+  (unless no-reserve-marks
+    (setq hide-list
+	  (wl-expire-delete-reserved-messages hide-list folder)))
+  (let ((mess (format "Hiding %s msgs..." (length hide-list))))
+    (message "%s" mess)
+    (elmo-folder-detach-messages folder hide-list)
+    (elmo-folder-kill-messages folder hide-list)
+    (elmo-folder-commit folder)
+    (message "%sdone" mess)
+    (cons hide-list (length hide-list))))
+
+(defsubst wl-expire-folder-p (entity)
+  "Return non-nil, when ENTITY matched `wl-expire-alist'."
+  (wl-get-assoc-list-value wl-expire-alist entity))
+
+(defsubst wl-archive-folder-p (entity)
+  "Return non-nil, when ENTITY matched `wl-archive-alist'."
+  (wl-get-assoc-list-value wl-archive-alist entity))
+
+(defun wl-summary-expire (&optional folder notsummary nolist)
+  ""
   (interactive)
-  (let ((folder (or folder-name wl-summary-buffer-folder-name))
-	(alist wl-expire-alist)
+  (let ((folder (or folder wl-summary-buffer-elmo-folder))
+	(deleting-info "Expiring...")
 	expires)
-    (when (and (or (setq expires (wl-expire-folder-p folder))
+    (when (and (or (setq expires (wl-expire-folder-p
+				  (elmo-folder-name-internal folder)))
 		   (progn (and (interactive-p)
-			       (message "no match %s in wl-expire-alist" 
-					folder))
+			       (message "no match %s in wl-expire-alist"
+					(elmo-folder-name-internal folder)))
 			  nil))
 	       (or (not (interactive-p))
-		   (y-or-n-p (format "Expire %s? " folder))))
-      (let* ((msgdb (or wl-summary-buffer-msgdb
-			(elmo-msgdb-load folder)))
-	     (number-alist (elmo-msgdb-get-number-alist msgdb))
-	     (mark-alist (elmo-msgdb-get-mark-alist msgdb))
-	     expval rm-type val-type value more args
-	     delete-list)
+		   (y-or-n-p (format "Expire %s? " (elmo-folder-name-internal
+						    folder)))))
+      (let* (expval rm-type val-type value more args
+		    delete-list)
 	(save-excursion
 	  (setq expval (car expires)
 		rm-type (nth 1 expires)
@@ -499,68 +627,80 @@ Refile to archive folder followed message date."
 	   ((eq val-type nil))
 	   ((eq val-type 'number)
 	    (let* ((msgs (if (not nolist)
-			     (elmo-list-folder folder)
-			   (mapcar 'car number-alist)))
+			     (elmo-folder-list-messages folder)
+			   (elmo-folder-list-messages folder 'visible
+						      'in-msgdb)))
 		   (msglen (length msgs))
 		   (more (or more (1+ value)))
 		   count)
 	      (when (>= msglen more)
 		(setq count (- msglen value))
 		(while (and msgs (> count 0))
-		  (when (assq (car msgs) number-alist) ;; don't expire new message
+		  (when (elmo-message-entity folder (car msgs))
+		    ;; don't expire new message
 		    (wl-append delete-list (list (car msgs)))
 		    (when (or (not wl-expire-number-with-reserve-marks)
-			      (wl-expire-msg-p (car msgs) mark-alist))
+			      (wl-expire-message-p folder (car msgs)))
 		      (setq count (1- count))))
 		  (setq msgs (cdr msgs))))))
 	   ((eq val-type 'date)
-	    (let* ((overview (elmo-msgdb-get-overview msgdb))
-		   (key-date (elmo-date-get-offset-datevec 
+	    (let* ((key-date (elmo-date-get-offset-datevec
 			      (timezone-fix-time (current-time-string)
 						 (current-time-zone) nil)
 			      value t)))
-	      (while overview
+	      (elmo-folder-do-each-message-entity (entity folder)
 		(when (wl-expire-date-p
 		       key-date
-		       (elmo-msgdb-overview-entity-get-date
-			(car overview)))
+		       (elmo-message-entity-field entity 'date))
 		  (wl-append delete-list
-			     (list (elmo-msgdb-overview-entity-get-number
-				    (car overview)))))
-		(setq overview (cdr overview)))))
+			     (list (elmo-message-entity-number entity)))))))
 	   (t
 	    (error "%s: not supported" val-type)))
 	  (when delete-list
 	    (or wl-expired-alist
 		(setq wl-expired-alist (wl-expired-alist-load)))
+	    ;; evaluate string-match for wl-expand-newtext
+	    (wl-expire-folder-p
+	     (elmo-folder-name-internal folder))
 	    (setq delete-list
 		  (cond ((eq rm-type nil) nil)
 			((eq rm-type 'remove)
-			 (car (wl-expire-delete folder delete-list msgdb)))
+			 (setq deleting-info "Deleting...")
+			 (car (wl-expire-delete folder delete-list)))
 			((eq rm-type 'trash)
-			 (car (wl-expire-refile folder delete-list msgdb wl-trash-folder)))
+			 (setq deleting-info "Deleting...")
+			 (car (wl-expire-refile folder
+						delete-list
+						wl-trash-folder)))
+			((eq rm-type 'hide)
+			 (setq deleting-info "Hiding...")
+			 (car (wl-expire-hide folder delete-list)))
 			((stringp rm-type)
-			 (car (wl-expire-refile folder delete-list msgdb rm-type)))
+			 (setq deleting-info "Refiling...")
+			 (car (wl-expire-refile folder delete-list
+						(wl-expand-newtext
+						 rm-type
+						 (elmo-folder-name-internal
+						  folder)))))
 			((fboundp rm-type)
-			 (apply rm-type (append (list folder delete-list msgdb)
+			 (apply rm-type (append (list folder delete-list)
 						args)))
 			(t
 			 (error "%s: invalid type" rm-type))))
-	    (when (and (not notsummary) delete-list)
-	      (wl-summary-delete-messages-on-buffer delete-list)
+	    (when (and (not wl-expire-test) (not notsummary) delete-list)
+	      (wl-summary-delete-messages-on-buffer delete-list deleting-info)
 	      (wl-summary-folder-info-update)
 	      (wl-summary-set-message-modified)
-	      (wl-summary-set-mark-modified)
 	      (sit-for 0)
 	      (set-buffer-modified-p nil))
 	    (wl-expired-alist-save))
 	  (run-hooks 'wl-summary-expire-hook)
 	  (if delete-list
-	      (message "Expiring %s is done" folder)
+	      (message "Expiring %s is done" (elmo-folder-name-internal
+					      folder))
 	    (and (interactive-p)
 		 (message "No expire"))))
-	delete-list
-	))))
+	delete-list))))
 
 (defun wl-folder-expire-entity (entity)
   (cond
@@ -571,25 +711,28 @@ Refile to archive folder followed message date."
 	(setq flist (cdr flist)))))
    ((stringp entity)
     (when (wl-expire-folder-p entity)
-      (let ((update-msgdb (cond
+      (let* ((folder (wl-folder-get-elmo-folder entity))
+	     (update-msgdb (cond
 			   ((consp wl-expire-folder-update-msgdb)
 			    (wl-string-match-member
 			     entity
 			     wl-expire-folder-update-msgdb))
 			   (t
 			    wl-expire-folder-update-msgdb)))
-	    (wl-summary-highlight (if (or (wl-summary-sticky-p entity)
+	    (wl-summary-highlight (if (or (wl-summary-sticky-p folder)
 					  (wl-summary-always-sticky-folder-p
-					   entity))
+					   folder))
 				      wl-summary-highlight))
 	    wl-auto-select-first ret-val)
 	(save-window-excursion
 	  (save-excursion
 	    (and update-msgdb
 		 (wl-summary-goto-folder-subr entity 'force-update nil))
-	    (setq ret-val (wl-summary-expire entity (not update-msgdb)))
+	    (setq ret-val (wl-summary-expire folder (not update-msgdb)))
 	    (if update-msgdb
-		(wl-summary-save-status 'keep)
+		(progn
+		  (wl-summary-save-view)
+		  (elmo-folder-commit wl-summary-buffer-elmo-folder))
 	      (if ret-val
 		  (wl-folder-check-entity entity))))))))))
 
@@ -597,16 +740,17 @@ Refile to archive folder followed message date."
 
 (defun wl-folder-expire-current-entity ()
   (interactive)
-  (let ((entity-name
-	 (or (wl-folder-get-folder-name-by-id
-	      (get-text-property (point) 'wl-folder-entity-id))
-	     (wl-folder-get-realname (wl-folder-folder-name)))))
+  (let ((entity-name (wl-folder-get-entity-from-buffer))
+	(type (if (wl-folder-buffer-group-p)
+		  'group
+		'folder)))
     (when (and entity-name
 	       (or (not (interactive-p))
 		   (y-or-n-p (format "Expire %s? " entity-name))))
       (wl-folder-expire-entity
        (wl-folder-search-entity-by-name entity-name
-					wl-folder-entity))
+					wl-folder-entity
+					type))
       (if (get-buffer wl-summary-buffer-name)
 	  (kill-buffer wl-summary-buffer-name))
       (message "Expiring %s is done" entity-name))))
@@ -615,79 +759,81 @@ Refile to archive folder followed message date."
 
 (defun wl-folder-archive-current-entity ()
   (interactive)
-  (let ((entity-name
-	 (or (wl-folder-get-folder-name-by-id
-	      (get-text-property (point) 'wl-folder-entity-id))
-	     (wl-folder-get-realname (wl-folder-folder-name)))))
+  (let ((entity-name (wl-folder-get-entity-from-buffer))
+	(type (if (wl-folder-buffer-group-p)
+		  'group
+		'folder)))
     (when (and entity-name
 	       (or (not (interactive-p))
 		   (y-or-n-p (format "Archive %s? " entity-name))))
       (wl-folder-archive-entity
        (wl-folder-search-entity-by-name entity-name
-					wl-folder-entity))
+					wl-folder-entity
+					type))
       (message "Archiving %s is done" entity-name))))
 
-(defun wl-archive-number1 (folder archive-list msgdb)
-  (wl-expire-archive-number1 folder archive-list msgdb t t))
+(defun wl-archive-number1 (folder archive-list &optional dst-folder-arg)
+  (wl-expire-archive-number1 folder archive-list t dst-folder-arg t))
 
-(defun wl-archive-number2 (folder archive-list msgdb)
-  (wl-expire-archive-number2 folder archive-list msgdb t t))
+(defun wl-archive-number2 (folder archive-list &optional dst-folder-arg)
+  (wl-expire-archive-number2 folder archive-list t dst-folder-arg t))
 
-(defun wl-archive-date (folder archive-list msgdb)
-  (wl-expire-archive-date folder archive-list msgdb t t))
+(defun wl-archive-date (folder archive-list &optional dst-folder-arg)
+  (wl-expire-archive-date folder archive-list t dst-folder-arg t))
 
-(defun wl-archive-folder (folder archive-list msgdb dst-folder)
+(defun wl-archive-folder (folder archive-list dst-folder)
   (let* ((elmo-archive-treat-file t)	;; treat archive folder as a file.
 	 copied-list ret-val)
     (setq archive-list
 	  (car (wl-expire-archive-number-delete-old
 		nil t archive-list
-		(elmo-msgdb-get-mark-alist msgdb)
+		folder
 		t ;; no-confirm
 		nil dst-folder)))
     (when archive-list
       (and (setq ret-val
 		 (wl-expire-refile
-		  folder archive-list msgdb dst-folder t t t)) ;; copy!!
+		  folder archive-list dst-folder t t t)) ;; copy!!
 	   (wl-append copied-list ret-val)))
-    copied-list
-    ))
+    copied-list))
 
-(defun wl-summary-archive (&optional arg folder-name notsummary nolist)
+(defun wl-summary-archive (&optional arg folder notsummary nolist)
+  ""
   (interactive "P")
-  (let* ((folder (or folder-name wl-summary-buffer-folder-name))
-	 (msgdb (or wl-summary-buffer-msgdb
-		    (elmo-msgdb-load folder)))
+  (let* ((folder (or folder wl-summary-buffer-elmo-folder))
 	 (msgs (if (not nolist)
-		   (elmo-list-folder folder)
-		 (mapcar 'car (elmo-msgdb-get-number-alist msgdb))))
+		   (elmo-folder-list-messages folder)
+		 (elmo-folder-list-messages folder 'visible 'in-msgdb)))
 	 (alist wl-archive-alist)
-	 func dst-folder archive-list)
+	 archives func args dst-folder archive-list)
     (if arg
 	(let ((wl-default-spec (char-to-string
-				(car (rassq 'archive elmo-spec-alist)))))
+				(car (rassq 'archive
+					    elmo-folder-type-alist)))))
 	  (setq dst-folder (wl-summary-read-folder
-			    (concat wl-default-spec (substring folder 1))
+			    (concat wl-default-spec
+				    (substring
+				     (elmo-folder-name-internal folder) 1))
 			    "for archive"))))
     (run-hooks 'wl-summary-archive-pre-hook)
     (if dst-folder
-	(wl-archive-folder folder msgs msgdb dst-folder)
-      (when (and (catch 'match
-		   (while alist
-		     (when (string-match (caar alist) folder)
-		       (setq func (cadar alist))
-		       (throw 'match t))
-		     (setq alist (cdr alist)))
-		   (and (interactive-p)
-			(message "No match %s in wl-archive-alist" folder))
-		   (throw 'match nil))
+	(wl-archive-folder folder msgs dst-folder)
+      (when (and (or (setq archives (wl-archive-folder-p
+				     (elmo-folder-name-internal folder)))
+		     (progn (and (interactive-p)
+				 (message "No match %s in wl-archive-alist"
+					  (elmo-folder-name-internal folder)))
+			    nil))
 		 (or (not (interactive-p))
-		     (y-or-n-p (format "Archive %s? " folder))))
+		     (y-or-n-p (format "Archive %s? "
+				       (elmo-folder-name-internal folder)))))
+	(setq func (car archives)
+	      args (cdr archives))
 	(setq archive-list
-	      (funcall func folder msgs msgdb))
+	      (apply func (append (list folder msgs) args)))
 	(run-hooks 'wl-summary-archive-hook)
 	(if archive-list
-	    (message "Archiving %s is done" folder)
+	    (message "Archiving %s is done" (elmo-folder-name-internal folder))
 	  (and (interactive-p)
 	       (message "No archive")))))))
 
@@ -699,7 +845,7 @@ Refile to archive folder followed message date."
 	(wl-folder-archive-entity (car flist))
 	(setq flist (cdr flist)))))
    ((stringp entity)
-    (wl-summary-archive nil entity t))))
+    (wl-summary-archive nil (wl-folder-get-elmo-folder entity) t))))
 
 ;; append log
 
@@ -708,7 +854,7 @@ Refile to archive folder followed message date."
     (save-excursion
       (let ((tmp-buf (get-buffer-create " *wl-expire work*"))
 	    (filename (expand-file-name wl-expired-log-alist-file-name
-					elmo-msgdb-dir)))
+					elmo-msgdb-directory)))
 	(set-buffer tmp-buf)
 	(erase-buffer)
 	(if dst-folder
@@ -719,11 +865,12 @@ Refile to archive folder followed message date."
 			  action
 			  src-folder msgs)))
 	(if (file-writable-p filename)
-	    (write-region (point-min) (point-max) 
+	    (write-region (point-min) (point-max)
 			  filename t 'no-msg)
-	  (message (format "%s is not writable." filename)))
+	  (message "%s is not writable." filename))
 	(kill-buffer tmp-buf)))))
 
-(provide 'wl-expire)
+(require 'product)
+(product-provide (provide 'wl-expire) (require 'wl-version))
 
 ;;; wl-expire.el ends here