* wl-spam.el (wl-summary-register-as-spam-region)
[elisp/wanderlust.git] / wl / wl-spam.el
index a9d810e..8cb870f 100644 (file)
   "Spam configuration for wanderlust."
   :group 'wl)
 
-(defcustom wl-spam-folder-name "+spam"
+(defcustom wl-spam-folder "+spam"
   "*Spam folder."
   :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)
 Append this value to `wl-summary-mark-action-list' by `wl-spam-setup'.
 
 See `wl-summary-mark-action-list' for the detail of element."
-  :type '(repeat (string :tag "Temporary mark")
-                (symbol :tag "Set mark function")
-                (symbol :tag "Unset mark function")
-                (symbol :tag "Exec function")
-                (symbol :tag "Face symbol")
-                (string :tag "Document string"))
+  :type '(repeat (list
+                 (string :tag "Temporary mark")
+                 (symbol :tag "Action name")
+                 (symbol :tag "Argument function")
+                 (symbol :tag "Set mark function")
+                 (symbol :tag "Exec function")
+                 (symbol :tag "Face symbol")
+                 (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-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)
              wl-spam-auto-check-marks)))
 
 (defsubst wl-spam-map-spam-messages (folder numbers function &rest args)
-  (let ((total (length numbers)))
-    (message "Checking spam...")
-    (elmo-with-progress-display (> total elmo-display-progress-threshold)
-       (elmo-spam-check-spam total "Checking spam...")
-      (dolist (number (elmo-spam-list-spam-messages (elmo-spam-processor)
-                                                   folder
-                                                   numbers))
-       (apply function number args)))
-    (message "Checking spam...done")))
+  (elmo-with-progress-display (elmo-spam-check-spam (length numbers))
+      "Checking spam"
+    (dolist (number (elmo-spam-list-spam-messages (elmo-spam-processor)
+                                                 folder
+                                                 numbers))
+      (apply function number args))))
+
+(defun wl-spam-apply-partitions (folder partitions function msg)
+  (when partitions
+    (let ((total 0))
+      (dolist (partition partitions)
+       (setq total (+ total (length (cdr partition)))))
+      (elmo-with-progress-display (elmo-spam-register total) msg
+       (dolist (partition partitions)
+         (funcall function folder (cdr partition) (car partition)))))))
 
 (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
-                                       numbers))
-    (message "Registering spam...done")))
+  (elmo-with-progress-display (elmo-spam-register (length numbers))
+      "Registering spam"
+    (elmo-spam-register-spam-messages (elmo-spam-processor)
+                                     folder
+                                     numbers)))
 
 (defun wl-spam-register-good-messages (folder numbers)
-  (let ((total (length numbers)))
-    (message "Registering good...")
-    (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
-                                       numbers))
-    (message "Registering good...done")))
+  (elmo-with-progress-display (elmo-spam-register (length numbers))
+      "Registering good"
+    (elmo-spam-register-good-messages (elmo-spam-processor)
+                                     folder
+                                     numbers)))
 
 (defun wl-spam-save-status (&optional force)
   (interactive "P")
-  (let ((processor (elmo-spam-processor)))
-    (when (or force (elmo-spam-modified-p processor))
+  (let ((processor (elmo-spam-processor (not force))))
+    (when (or force
+             (and processor (elmo-spam-modified-p processor)))
       (elmo-spam-save-status processor))))
 
 ;; insinuate into summary mode
@@ -172,21 +206,48 @@ See `wl-summary-mark-action-list' for the detail of element."
 
 (eval-when-compile
   ;; Avoid compile warnings
-  (defalias-maybe 'wl-summary-spam 'ignore))
+  (defalias-maybe 'wl-summary-spam 'ignore)
+  (defalias-maybe 'wl-summary-unmark-spam 'ignore))
 
 (defun wl-summary-test-spam (&optional folder number)
   (interactive)
   (let ((folder (or folder wl-summary-buffer-elmo-folder))
        (number (or number (wl-summary-message-number)))
        spam)
-    (message "Cheking spam...")
-    (when (setq spam (elmo-spam-message-spam-p (elmo-spam-processor)
-                                              folder number))
-      (wl-summary-spam number))
-    (message "Cheking spam...done")
+    (message "Checking spam...")
+    (if (setq spam (elmo-spam-message-spam-p (elmo-spam-processor)
+                                            folder number))
+       (wl-summary-spam number)
+      (wl-summary-unmark-spam number))
+    (message "Checking spam...done")
     (when (interactive-p)
       (message "No: %d is %sa spam message." number (if spam "" "not ")))))
 
+(defun wl-summary-test-spam-messages (folder numbers &rest args)
+  (elmo-with-progress-display (elmo-spam-check-spam (length numbers))
+      "Checking spam"
+    (let* ((spams (elmo-spam-list-spam-messages (elmo-spam-processor)
+                                               folder
+                                               numbers))
+          (goods (car (elmo-list-diff numbers spams))))
+      (dolist (number spams)
+       (wl-summary-spam number args))
+      (dolist (number goods)
+       (wl-summary-unmark-spam number)))))
+
+(defun wl-summary-test-spam-region (beg end)
+  (interactive "r")
+  (let ((numbers (wl-summary-collect-numbers-region beg end)))
+    (cond (numbers
+          (wl-summary-test-spam-messages wl-summary-buffer-elmo-folder
+                                         numbers))
+         ((interactive-p)
+          (message "No message to test.")))))
+
+(defun wl-thread-test-spam (&optional arg)
+  (interactive "P")
+  (wl-thread-call-region-func 'wl-summary-test-spam-region arg))
+
 (defun wl-summary-mark-spam (&optional all)
   "Set spam mark to messages which is spam classification."
   (interactive "P")
@@ -211,6 +272,19 @@ See `wl-summary-mark-action-list' for the detail of element."
       (wl-spam-register-spam-messages wl-summary-buffer-elmo-folder
                                      (list number)))))
 
+(defun wl-summary-register-as-spam-region (beg end)
+  (interactive "r")
+  (let ((numbers (wl-summary-collect-numbers-region beg end)))
+    (cond (numbers
+          (wl-spam-register-spam-messages wl-summary-buffer-elmo-folder
+                                          numbers))
+         ((interactive-p)
+          (message "No message to register as spam.")))))
+
+(defun wl-thread-register-as-spam (&optional arg)
+  (interactive "P")
+  (wl-thread-call-region-func 'wl-summary-register-as-spam-region arg))
+
 (defun wl-summary-register-as-spam-all ()
   (interactive)
   (wl-spam-register-spam-messages wl-summary-buffer-elmo-folder
@@ -235,6 +309,19 @@ See `wl-summary-mark-action-list' for the detail of element."
       (wl-spam-register-good-messages wl-summary-buffer-elmo-folder
                                      (list number)))))
 
+(defun wl-summary-register-as-good-region (beg end)
+  (interactive "r")
+  (let ((numbers (wl-summary-collect-numbers-region beg end)))
+    (cond (numbers
+          (wl-spam-register-good-messages wl-summary-buffer-elmo-folder
+                                          numbers))
+         ((interactive-p)
+          (message "No message to register as good.")))))
+
+(defun wl-thread-register-as-good (&optional arg)
+  (interactive "P")
+  (wl-thread-call-region-func 'wl-summary-register-as-good-region arg))
+
 (defun wl-summary-register-as-good-all ()
   (interactive)
   (wl-spam-register-good-messages wl-summary-buffer-elmo-folder
@@ -259,49 +346,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)))
-    (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"))
+  (let ((folder wl-summary-buffer-elmo-folder))
+    (wl-folder-confirm-existence (wl-folder-get-elmo-folder wl-spam-folder))
+    (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-name
-                                       "Refiling spam...")))
+                                       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)
-       (message "Registering spam...")
-       (setq total (+ (length spam-list) (length good-list)))
-       (elmo-with-progress-display (> total elmo-display-progress-threshold)
-           (elmo-spam-register total "Registering spam...")
-         (when spam-list
-           (elmo-spam-register-spam-messages processor folder spam-list
-                                             (eq domain 'good)))
-         (when good-list
-           (elmo-spam-register-good-messages processor folder good-list
-                                             (eq domain 'spam))))
-       (message "Registering spam...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)))
 
@@ -309,22 +396,21 @@ See `wl-summary-mark-action-list' for the detail of element."
   (let ((original (wl-message-get-original-buffer))
        (number wl-message-buffer-cur-number)
        spam)
-    (message "Cheking spam...")
-    (when (elmo-spam-buffer-spam-p (elmo-spam-processor) original)
+    (message "Checking spam...")
+    (when (setq spam (elmo-spam-buffer-spam-p (elmo-spam-processor) original))
       (with-current-buffer wl-message-buffer-cur-summary-buffer
        (wl-summary-spam number)))
-    (message "Cheking spam...done")
-    (when (interactive-p)
-      (message "No: %d is %sa spam message." number (if spam "" "not ")))))
+    (message "Checking spam...done")
+    (message "No: %d is %sa spam message." number (if spam "" "not "))))
 
 (defun wl-refile-guess-by-spam (entity)
   (when (elmo-spam-message-spam-p (elmo-spam-processor)
                                  wl-summary-buffer-elmo-folder
                                  (elmo-message-entity-number entity))
-    wl-spam-folder-name))
+    wl-spam-folder))
 
 (defun wl-spam-setup ()
-  (add-hook 'wl-summary-prepared-hook #'wl-summary-auto-check-spam)
+  (add-hook 'wl-summary-sync-updated-hook #'wl-summary-auto-check-spam)
   (let ((actions wl-summary-mark-action-list)
        action)
     (while actions
@@ -346,6 +432,24 @@ See `wl-summary-mark-action-list' for the detail of element."
                  wl-summary-skip-mark-list))))
   (define-key wl-summary-mode-map "k" wl-summary-spam-map)
   (define-key
+    wl-summary-mode-map "rkm" 'wl-summary-spam-region)
+  (define-key
+    wl-summary-mode-map "rkc" 'wl-summary-test-spam-region)
+  (define-key
+    wl-summary-mode-map "rks" 'wl-summary-register-as-spam-region)
+  (define-key
+    wl-summary-mode-map "rkn" 'wl-summary-register-as-good-region)
+  (define-key
+    wl-summary-mode-map "tkm" 'wl-thread-spam)
+  (define-key
+    wl-summary-mode-map "tkc" 'wl-thread-test-spam)
+  (define-key
+    wl-summary-mode-map "tks" 'wl-thread-register-as-spam)
+  (define-key
+    wl-summary-mode-map "tkn" 'wl-thread-register-as-good)
+  (define-key
+    wl-summary-mode-map "mk" 'wl-summary-target-mark-spam)
+  (define-key
     wl-summary-mode-map "ms" 'wl-summary-target-mark-register-as-spam)
   (define-key
     wl-summary-mode-map "mn" 'wl-summary-target-mark-register-as-good))