* elmo-util.el (elmo-file-field-primitive-condition-match): Fixed

[elisp/wanderlust.git] / wl / wl-expire.el

diff --git a/wl/wl-expire.el b/wl/wl-expire.el
index 973306f..178dab0 100644 (file)
--- a/wl/wl-expire.el
+++ b/wl/wl-expire.el
@@ -1,7 +1,7 @@
 ;;; 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
@@ -68,7 +68,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
@@ -137,10 +137,10 @@
                  (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 
+         (elmo-msgdb-add-msgs-to-seen-list
           dst-folder
           refile-list
-          msgdb 
+          msgdb
           (concat wl-summary-important-mark
                   wl-summary-read-uncached-mark)))
       (if (elmo-move-msgs folder
@@ -185,10 +185,10 @@ If REFILE-LIST includes reserve mark message, so copy."
            (setq copy-reserve-message t))))
       (when refile-list
        (if wl-expire-add-seen-list
-           (elmo-msgdb-add-msgs-to-seen-list 
+           (elmo-msgdb-add-msgs-to-seen-list
             dst-folder
             refile-list
-            msgdb 
+            msgdb
             (concat wl-summary-important-mark
                     wl-summary-read-uncached-mark)))
        (unless
@@ -200,16 +200,16 @@ If REFILE-LIST includes reserve mark message, so copy."
                                  nil nil t
                                  copy-reserve-message
                                  preserve-number))
-         (error "expire: move msgs to %s failed" dst-folder))
+         (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 
+                refile-list
                 mark-alist))
-         (when refile-list 
+         (when refile-list
           (if (setq ret-val
                    (elmo-delete-msgs folder
                                      refile-list
@@ -228,7 +228,7 @@ If REFILE-LIST includes reserve mark message, so copy."
       (cons refile-list copy-len))))
 
 (defun wl-expire-archive-get-folder (src-folder &optional fmt)
-  "Get archive folder name from src-folder."
+  "Get archive folder name from SRC-FOLDER."
   (let* ((spec (elmo-folder-get-spec src-folder))
         (fmt (or fmt wl-expire-archive-folder-name-fmt))
         (archive-spec (char-to-string
@@ -243,7 +243,7 @@ If REFILE-LIST includes reserve mark message, so copy."
          (t
           (setq dst-folder-base
                 (elmo-concat-path (format "%s%s" archive-spec (car spec))
-                                  (elmo-replace-msgid-as-filename 
+                                  (elmo-replace-msgid-as-filename
                                    src-folder)))))
     (setq dst-folder-fmt (format fmt
                                 dst-folder-base
@@ -465,17 +465,34 @@ Refile to archive folder followed message date."
     deleted-list
     ))
 
+(defun wl-expire-hide (folder hide-list msgdb &optional no-reserve-marks)
+  "Hide message for expire."
+  (unless no-reserve-marks
+    (setq hide-list
+         (wl-expire-delete-reserve-marked-msgs-from-list
+          hide-list (elmo-msgdb-get-mark-alist msgdb))))
+  (let ((mess (format "Hiding %s msgs..." (length hide-list))))
+    (message mess)
+    (elmo-msgdb-delete-msgs folder hide-list msgdb t)
+    (elmo-msgdb-append-to-killed-list folder hide-list)
+    (elmo-msgdb-save folder msgdb)
+    (message (concat mess "done"))
+    (cons hide-list (length hide-list))))
+
 (defsubst wl-expire-folder-p (folder)
+  "Return non-nil, when FOLDER matched `wl-expire-alist'."
   (wl-get-assoc-list-value wl-expire-alist folder))
 
 (defun wl-summary-expire (&optional folder-name notsummary nolist)
+  ""
   (interactive)
   (let ((folder (or folder-name wl-summary-buffer-folder-name))
        (alist wl-expire-alist)
+       (deleting-info "Expiring...")
        expires)
     (when (and (or (setq expires (wl-expire-folder-p folder))
                   (progn (and (interactive-p)
-                              (message "no match %s in wl-expire-alist" 
+                              (message "no match %s in wl-expire-alist"
                                        folder))
                          nil))
               (or (not (interactive-p))
@@ -514,7 +531,7 @@ Refile to archive folder followed message date."
                  (setq msgs (cdr msgs))))))
           ((eq val-type 'date)
            (let* ((overview (elmo-msgdb-get-overview msgdb))
-                  (key-date (elmo-date-get-offset-datevec 
+                  (key-date (elmo-date-get-offset-datevec
                              (timezone-fix-time (current-time-string)
                                                 (current-time-zone) nil)
                              value t)))
@@ -535,10 +552,16 @@ Refile to archive folder followed message date."
            (setq delete-list
                  (cond ((eq rm-type nil) nil)
                        ((eq rm-type 'remove)
+                        (setq deleting-info "Deleting...")
                         (car (wl-expire-delete folder delete-list msgdb)))
                        ((eq rm-type 'trash)
+                        (setq deleting-info "Deleting...")
                         (car (wl-expire-refile folder delete-list msgdb wl-trash-folder)))
+                       ((eq rm-type 'hide)
+                        (setq deleting-info "Hiding...")
+                        (car (wl-expire-hide folder delete-list msgdb)))
                        ((stringp rm-type)
+                        (setq deleting-info "Refiling...")
                         (car (wl-expire-refile folder delete-list msgdb rm-type)))
                        ((fboundp rm-type)
                         (apply rm-type (append (list folder delete-list msgdb)
@@ -546,7 +569,7 @@ Refile to archive folder followed message date."
                        (t
                         (error "%s: invalid type" rm-type))))
            (when (and (not notsummary) delete-list)
-             (wl-summary-delete-messages-on-buffer 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)
@@ -718,11 +741,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)))
        (kill-buffer tmp-buf)))))
 
-(provide 'wl-expire)
+(require 'product)
+(product-provide (provide 'wl-expire) (require 'wl-version))
 
 ;;; wl-expire.el ends here