From: teranisi <teranisi>
Date: Mon, 10 Dec 2001 11:40:17 +0000 (+0000)
Subject: 2001-10-30  Nishimoto Masaki <nishimoto@gaju.org>
X-Git-Tag: wl-2_8-root~70
X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=b30519142c934095b6a46366d4ead917e4cf5c85;p=elisp%2Fwanderlust.git

2001-10-30  Nishimoto Masaki <nishimoto@gaju.org>

	* wl-expire.el (wl-expire-localdir-date-folder-name-fmt): New variable.
	(wl-expire-localdir-get-folder-function): New user option.
	(wl-expire-localdir-get-folder): New function.
	(wl-expire-localdir-date): Ditto.
---

diff --git a/wl/ChangeLog b/wl/ChangeLog
index 3a55c87..a9033c0 100644
--- a/wl/ChangeLog
+++ b/wl/ChangeLog
@@ -1,3 +1,10 @@
+2001-10-30  Nishimoto Masaki <nishimoto@gaju.org>
+
+	* wl-expire.el (wl-expire-localdir-date-folder-name-fmt): New variable.
+	(wl-expire-localdir-get-folder-function): New user option.
+	(wl-expire-localdir-get-folder): New function.
+	(wl-expire-localdir-date): Ditto.
+
 2001-12-10  TAKAHASHI Kaoru  <kaoru@kaisei.org>
 
 	* wl-folder.el (wl-folder-check-one-entity): Fixed car of return
diff --git a/wl/wl-expire.el b/wl/wl-expire.el
index 9af4fde..5852fd5 100644
--- a/wl/wl-expire.el
+++ b/wl/wl-expire.el
@@ -497,6 +497,93 @@ Refile to archive folder followed message date."
       (setq arcmsg-alist (cdr arcmsg-alist)))
     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)))
+
+(defun wl-expire-localdir-date (folder delete-list msgdb
+				       &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* ((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-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-msgdb-overview-entity-get-date
+		  (assoc (cdr (assq msg number-alist)) overview)))
+      (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 msgdb dst-folder t preserve-number
+		  no-delete))
+	   (wl-append deleted-list (car ret-val)))
+      (setq arcmsg-alist (cdr arcmsg-alist)))
+    deleted-list))
+
 (defun wl-expire-hide (folder hide-list msgdb &optional no-reserve-marks)
   "Hide message for expire."
   (unless no-reserve-marks