* wl-util.el (wl-filter-associations): New function.

* wl-spam.el (wl-spam-undecided-folder-list): New user option.
(wl-spam-ignored-folder-list): Ditto.
(wl-spam-ignored-folder-regexp-list): Set default value as nil.
(wl-spam-string-member-p): New function.
(wl-spam-domain): Use it.
(wl-spam-split-numbers): New function.
(wl-spam-apply-partitions): Ditto.
(wl-spam-register-spam-messages): Use `folder' instead of
`wl-summary-buffer-elmo-folder'.
(wl-spam-register-good-messages): Ditto.
(wl-summary-exec-action-spam): Decide a domain by real folder of
message.
(wl-summary-exec-action-refile-with-register): Likewise.

* elmo-util.el (elmo-string-member): Allow symbol element in list.

diff --git a/elmo/ChangeLog b/elmo/ChangeLog
index 46560b4..fa03d9f 100644 (file)
--- a/elmo/ChangeLog
+++ b/elmo/ChangeLog
@@ -1,3 +1,7 @@
+2005-12-10  Hiroya Murata  <lapis-lazuli@pop06.odn.ne.jp>
+
+       * elmo-util.el (elmo-string-member): Allow symbol element in list.
+
 2005-11-26  Hiroya Murata  <lapis-lazuli@pop06.odn.ne.jp>
 
        * elmo-search.el (elmo-make-search-engine): Use prefix

diff --git a/elmo/elmo-util.el b/elmo/elmo-util.el
index ff7ba62..be16dc3 100644 (file)
--- a/elmo/elmo-util.el
+++ b/elmo/elmo-util.el
@@ -1319,11 +1319,14 @@ But if optional argument AUTO is non-nil, DEFAULT is returned."
 
 (defun elmo-string-member (string slist)
   (catch 'found
-    (while slist
-      (if (and (stringp (car slist))
-              (string= string (car slist)))
-         (throw 'found t))
-      (setq slist (cdr slist)))))
+    (dolist (element slist)
+      (cond ((null element))
+           ((stringp element)
+            (when (string= string element)
+              (throw 'found t)))
+           ((symbolp element)
+            (when (string= string (symbol-value element))
+              (throw 'found t)))))))
 
 (static-cond ((fboundp 'member-ignore-case)
        (defalias 'elmo-string-member-ignore-case 'member-ignore-case))

diff --git a/wl/ChangeLog b/wl/ChangeLog
index 37003d5..d11d07c 100644 (file)
--- a/wl/ChangeLog
+++ b/wl/ChangeLog
@@ -1,3 +1,21 @@
+2005-12-10  Hiroya Murata  <lapis-lazuli@pop06.odn.ne.jp>
+
+       * wl-util.el (wl-filter-associations): New function.
+
+       * wl-spam.el (wl-spam-undecided-folder-list): New user option.
+       (wl-spam-ignored-folder-list): Ditto.
+       (wl-spam-ignored-folder-regexp-list): Set default value as nil.
+       (wl-spam-string-member-p): New function.
+       (wl-spam-domain): Use it.
+       (wl-spam-split-numbers): New function.
+       (wl-spam-apply-partitions): Ditto.
+       (wl-spam-register-spam-messages): Use `folder' instead of
+       `wl-summary-buffer-elmo-folder'.
+       (wl-spam-register-good-messages): Ditto.
+       (wl-summary-exec-action-spam): Decide a domain by real folder of
+       message.
+       (wl-summary-exec-action-refile-with-register): Likewise.
+
 2005-11-12  Hiroya Murata  <lapis-lazuli@pop06.odn.ne.jp>
 
        * wl-e21.el (wl-e21-find-image): New function.

diff --git a/wl/wl-spam.el b/wl/wl-spam.el
index 8bb5494..dbff5e8 100644 (file)
--- a/wl/wl-spam.el
+++ b/wl/wl-spam.el
@@ -46,15 +46,28 @@
   :type 'string
   :group 'wl-spam)
 
+(defcustom wl-spam-undecided-folder-list nil
+  "*List of folder name which is contained undecided domain.
+If an element is symbol, use symbol-value instead."
+  :type '(repeat (choice (string :tag "Folder name")
+                        (variable :tag "Variable")))
+  :group 'wl-spam)
+
 (defcustom wl-spam-undecided-folder-regexp-list '("inbox")
   "*List of folder regexp which is contained undecided domain."
   :type '(repeat (regexp :tag "Folder Regexp"))
   :group 'wl-spam)
 
-(defcustom wl-spam-ignored-folder-regexp-list
-  (list (regexp-opt (list wl-draft-folder
-                         wl-trash-folder
-                         wl-queue-folder)))
+(defcustom wl-spam-ignored-folder-list '(wl-draft-folder
+                                        wl-trash-folder
+                                        wl-queue-folder)
+  "*List of folder name which is contained ignored domain.
+If an element is symbol, use symbol-value instead."
+  :type '(repeat (choice (string :tag "Folder name")
+                        (variable :tag "Variable")))
+  :group 'wl-spam)
+
+(defcustom wl-spam-ignored-folder-regexp-list nil
   "*List of folder regexp which is contained ignored domain."
   :type '(repeat (regexp :tag "Folder Regexp"))
   :group 'wl-spam)
@@ -104,18 +117,36 @@ See `wl-summary-mark-action-list' for the detail of element."
                  (string :tag "Document string")))
   :group 'wl-spam)
 
+(defsubst wl-spam-string-member-p (string list regexp-list)
+  (or (wl-string-member string list)
+      (wl-string-match-member string regexp-list)))
+
 (defun wl-spam-domain (folder-name)
   (cond ((string= folder-name wl-spam-folder)
         'spam)
-       ((wl-string-match-member folder-name
-                                wl-spam-undecided-folder-regexp-list)
+       ((wl-spam-string-member-p folder-name
+                                 wl-spam-undecided-folder-list
+                                 wl-spam-undecided-folder-regexp-list)
         'undecided)
-       ((wl-string-match-member folder-name
-                                wl-spam-ignored-folder-regexp-list)
+       ((wl-spam-string-member-p folder-name
+                                 wl-spam-ignored-folder-list
+                                 wl-spam-ignored-folder-regexp-list)
         'ignore)
        (t
         'good)))
 
+(defun wl-spam-split-numbers (folder numbers)
+  (let (alist)
+    (dolist (number numbers)
+      (let* ((domain (wl-spam-domain
+                     (elmo-folder-name-internal
+                      (elmo-message-folder folder number))))
+            (cell (assq domain alist)))
+       (if cell
+           (setcdr cell (cons number (cdr cell)))
+         (setq alist (cons (list domain number) alist)))))
+    alist))
+
 (defsubst wl-spam-auto-check-message-p (folder number)
   (or (eq wl-spam-auto-check-marks 'all)
       (member (wl-summary-message-mark folder number)
@@ -132,13 +163,25 @@ See `wl-summary-mark-action-list' for the detail of element."
        (apply function number args)))
     (message "Checking spam...done")))
 
+(defun wl-spam-apply-partitions (folder partitions function msg)
+  (when partitions
+    (let ((total 0))
+      (dolist (partition partitions)
+       (setq total (+ total (length (cdr partition)))))
+      (message msg)
+      (elmo-with-progress-display (> total elmo-display-progress-threshold)
+         (elmo-spam-register total msg)
+       (dolist (partition partitions)
+         (funcall function folder (cdr partition) (car partition))))
+      (message (concat msg "done")))))
+
 (defun wl-spam-register-spam-messages (folder numbers)
   (let ((total (length numbers)))
     (message "Registering spam...")
     (elmo-with-progress-display (> total elmo-display-progress-threshold)
        (elmo-spam-register total "Registering spam...")
       (elmo-spam-register-spam-messages (elmo-spam-processor)
-                                       wl-summary-buffer-elmo-folder
+                                       folder
                                        numbers))
     (message "Registering spam...done")))
 
@@ -148,7 +191,7 @@ See `wl-summary-mark-action-list' for the detail of element."
     (elmo-with-progress-display (> total elmo-display-progress-threshold)
        (elmo-spam-register total "Registering good...")
       (elmo-spam-register-good-messages (elmo-spam-processor)
-                                       wl-summary-buffer-elmo-folder
+                                       folder
                                        numbers))
     (message "Registering good...done")))
 
@@ -272,55 +315,49 @@ See `wl-summary-mark-action-list' for the detail of element."
     (wl-summary-mark-spam)))
 
 (defun wl-summary-exec-action-spam (mark-list)
-  (let ((domain (wl-spam-domain (elmo-folder-name-internal
-                                wl-summary-buffer-elmo-folder)))
-       (total (length mark-list)))
+  (let ((folder wl-summary-buffer-elmo-folder))
     (wl-folder-confirm-existence (wl-folder-get-elmo-folder wl-spam-folder))
-    (when (memq domain '(undecided good))
-      (message "Registering spam...")
-      (elmo-with-progress-display (> total elmo-display-progress-threshold)
-         (elmo-spam-register total "Registering spam...")
-       (elmo-spam-register-spam-messages (elmo-spam-processor)
-                                         wl-summary-buffer-elmo-folder
-                                         (mapcar #'car mark-list)
-                                         (eq domain 'good)))
-      (message "Registering spam...done"))
+    (wl-spam-apply-partitions
+     folder
+     (wl-filter-associations
+      '(undecided good)
+      (wl-spam-split-numbers folder (mapcar #'car mark-list)))
+     (lambda (folder numbers domain)
+       (elmo-spam-register-spam-messages (elmo-spam-processor)
+                                        folder numbers
+                                        (eq domain 'good)))
+     "Registering spam...")
     (wl-summary-move-mark-list-messages mark-list
                                        wl-spam-folder
                                        "Refiling spam...")))
 
 (defun wl-summary-exec-action-refile-with-register (mark-list)
-  (let* ((processor (elmo-spam-processor))
-        (folder wl-summary-buffer-elmo-folder)
-        (domain (wl-spam-domain (elmo-folder-name-internal folder)))
-        spam-list good-list total)
-    (unless (eq domain 'ignore)
-      (dolist (info mark-list)
-       (case (wl-spam-domain (nth 2 info))
-         (spam
-          (setq spam-list (cons (car info) spam-list)))
-         (good
-          (setq good-list (cons (car info) good-list)))))
-      (case domain
-       (spam (setq spam-list nil))
-       (good (setq good-list nil)))
-      (when (or spam-list good-list)
-       (when spam-list
-         (setq total (length spam-list))
-         (message "Registering spam...")
-         (elmo-with-progress-display (> total elmo-display-progress-threshold)
-             (elmo-spam-register total "Registering spam...")
-           (elmo-spam-register-spam-messages processor folder spam-list
-                                             (eq domain 'good)))
-         (message "Registering spam...done"))
-       (when good-list
-         (setq total (length good-list))
-         (message "Registering good...")
-         (elmo-with-progress-display (> total elmo-display-progress-threshold)
-             (elmo-spam-register total "Registering good...")
-           (elmo-spam-register-good-messages processor folder good-list
-                                             (eq domain 'spam)))
-         (message "Registering good...done"))))
+  (let ((folder wl-summary-buffer-elmo-folder)
+       spam-list good-list)
+    (dolist (info mark-list)
+      (case (wl-spam-domain (nth 2 info))
+       (spam
+        (setq spam-list (cons (car info) spam-list)))
+       (good
+        (setq good-list (cons (car info) good-list)))))
+    (wl-spam-apply-partitions
+     folder
+     (wl-filter-associations '(undecided good)
+                            (wl-spam-split-numbers folder spam-list))
+     (lambda (folder numbers domain)
+       (elmo-spam-register-spam-messages (elmo-spam-processor)
+                                        folder numbers
+                                        (eq domain 'good)))
+     "Registering spam...")
+    (wl-spam-apply-partitions
+     folder
+     (wl-filter-associations '(undecided spam)
+                            (wl-spam-split-numbers folder good-list))
+     (lambda (folder numbers domain)
+       (elmo-spam-register-good-messages (elmo-spam-processor)
+                                        folder numbers
+                                        (eq domain 'spam)))
+     "Registering good...")
     ;; execute refile messages
     (wl-summary-exec-action-refile mark-list)))
 

diff --git a/wl/wl-util.el b/wl/wl-util.el
index 0156bee..f3eb0af 100644 (file)
--- a/wl/wl-util.el
+++ b/wl/wl-util.el
@@ -336,6 +336,14 @@ changing the value of `foo'."
     (setq keys (cdr keys)))
   alist)
 
+(defun wl-filter-associations (keys alist)
+  (let (entry result)
+    (while keys
+      (when (setq entry (assq (car keys) alist))
+       (setq result (cons entry result)))
+      (setq keys (cdr keys)))
+    result))
+
 (defun wl-inverse-alist (keys alist)
   "Inverse ALIST, copying.
 Return an association list represents the inverse mapping of ALIST,