X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=wl%2Fwl-expire.el;h=f3f20b362278c252d2c2ccc1a441c151d1edae39;hb=36ac88ff2e3ef1701174641f5b085f1041fe4b66;hp=755221f07a1ff8479d78a1e5e0c49122ebeec555;hpb=8b003dd16e3d4a1f0d29b5fcd0f57a2ee294f967;p=elisp%2Fwanderlust.git diff --git a/wl/wl-expire.el b/wl/wl-expire.el index 755221f..f3f20b3 100644 --- a/wl/wl-expire.el +++ b/wl/wl-expire.el @@ -1,4 +1,4 @@ -;;; wl-expire.el -- Message expire modules for Wanderlust. +;;; wl-expire.el --- Message expire modules for Wanderlust. ;; Copyright (C) 1998,1999,2000 Masahiro MURATA ;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi @@ -25,7 +25,7 @@ ;; ;;; Commentary: -;; +;; (require 'wl-summary) (require 'wl-thread) @@ -49,12 +49,12 @@ (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) @@ -146,7 +146,7 @@ refile-list dst-folder msgdb - nil nil t + t copy preserve-number nil @@ -182,7 +182,7 @@ If REFILE-LIST includes reserve mark message, so copy." (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 + (error "%s: create folder failed" (elmo-folder-name-internal dst-folder))) (while (setq msg (wl-pop msglist)) (unless (wl-expire-msg-p msg mark-alist) @@ -202,12 +202,11 @@ If REFILE-LIST includes reserve mark message, so copy." refile-list dst-folder msgdb - nil nil t + t copy-reserve-message preserve-number nil - wl-expire-add-seen-list - )) + wl-expire-add-seen-list)) (error "Expire: move msgs to %s failed" (elmo-folder-name-internal dst-folder))) (wl-expire-append-log (elmo-folder-name-internal folder) @@ -498,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 @@ -658,7 +744,7 @@ Refile to archive folder followed message date." (setq ret-val (wl-summary-expire folder (not update-msgdb))) (if update-msgdb (progn - (wl-summary-save-view 'keep) + (wl-summary-save-view) (elmo-folder-commit wl-summary-buffer-elmo-folder)) (if ret-val (wl-folder-check-entity entity)))))))))) @@ -735,9 +821,12 @@ Refile to archive folder followed message date." archives func args dst-folder archive-list) (if arg (let ((wl-default-spec (char-to-string - (car (rassq 'archive elmo-folder-type-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 @@ -778,7 +867,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