X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=elmo%2Felmo-split.el;h=0de97b02f85d58e9d1903bfab3eb2e2d9bd53c3c;hb=88d92346ec94d9f4c094659671c0c591c00d3bbd;hp=d86e2c0e55de083a2508b293d53a959d7a77b88b;hpb=647b9a648baa8f58423fcf7480a8932c1bfc01b1;p=elisp%2Fwanderlust.git

diff --git a/elmo/elmo-split.el b/elmo/elmo-split.el
index d86e2c0..0de97b0 100644
--- a/elmo/elmo-split.el
+++ b/elmo/elmo-split.el
@@ -37,9 +37,14 @@
 ;; according to the definition of `elmo-split-rule'.
 ;;
 
+;;; Code:
+(eval-when-compile (require 'cl))
 (require 'elmo)
 
-;;; Code:
+(eval-when-compile
+  ;; Avoid compile warnings
+  (require 'elmo-spam))
+
 (defcustom elmo-split-rule nil
   "Split rule for the command `elmo-split'.
 The format of this variable is a list of RULEs which has form like:
@@ -47,7 +52,7 @@ The format of this variable is a list of RULEs which has form like:
 
 The 1st element CONDITION is a sexp which consists of following.
 
-1. Functions which accept argument FIELD-NAME and VALUE.
+1. Functions which accept arguments FIELD-NAME and VALUE.
 FIELD-NAME is a symbol of the field name.
 
 `equal'             ... True if the field value equals to VALUE.
@@ -62,12 +67,25 @@ FIELD-NAME is a symbol of the field name.
                         VALUE can contain \\& and \\N which will substitute
                         from matching \\(\\) patterns in the previous VALUE.
 
-2. Functions which accept any number of arguments.
+2. Functions which accept an argument SIZE, SIZE is some number.
+
+`<'                 ... True if the size of the message is less than SIZE.
+`>'                 ... True if the size of the message is greater than SIZE.
+
+3. Functions which accept any number of arguments.
 
 `or'                ... True if one of the argument returns true.
 `and'               ... True if all of the arguments return true.
 
-3. A symbol.
+`spam-p'            ... True if contents of the message is guessed as spam.
+                        Rest arguments are property list which consists
+                        following.
+
+                        `:register' ... If this value is non-nil,
+                                        Register according to
+                                        the classification.
+
+5. A symbol.
 
 When a symbol is specified, it is evaluated.
 
@@ -112,7 +130,8 @@ Example:
   :group 'elmo)
 
 (defcustom elmo-split-default-action 'noop
-  "Default action for messages which pass all rules."
+  "Default action for messages which pass all rules.
+It can be some ACTION as in `elmo-split-rule'."
   :type '(choice (const :tag "do not touch" noop)
 		 (const :tag "delete" delete)
 		 (string :tag "folder name")
@@ -205,6 +224,12 @@ Example:
 			 (symbol-name field)))))
       (equal field-value value))))
 
+(defun elmo-split-spam-p (buffer &rest plist)
+  (require 'elmo-spam)
+  (elmo-spam-buffer-spam-p (elmo-spam-processor)
+			   buffer
+			   (plist-get plist :register)))
+
 (defun elmo-split-match (buffer field value)
   (with-current-buffer buffer
     (let ((field-value (and elmo-split-message-entity
@@ -266,7 +291,8 @@ If prefix argument ARG is specified, do a reharsal (no harm)."
 	(format "%d messages are splitted" count)))
       (if (eq fcount 0)
 	  "."
-	(format " (%d failure)." fcount))))))
+	(format " (%d failure)." fcount))))
+    count))
 
 (defun elmo-split-subr (folder &optional reharsal)
   (let ((elmo-inhibit-display-retrieval-progress t)
@@ -274,7 +300,7 @@ If prefix argument ARG is specified, do a reharsal (no harm)."
 	(fcount 0)
 	(default-rule `((t ,elmo-split-default-action)))
 	msgs action target-folder failure delete-substance
-	record-log log-string)
+	record-log log-string flags)
     (message "Splitting...")
     (elmo-folder-open-internal folder)
     (setq msgs (elmo-folder-list-messages folder))
@@ -288,7 +314,12 @@ If prefix argument ARG is specified, do a reharsal (no harm)."
 		      (elmo-message-fetch folder msg
 					  (elmo-make-fetch-strategy 'entire)
 					  nil (current-buffer) 'unread))
+		(run-hooks 'elmo-split-fetch-hook)
 		(setq elmo-split-message-entity (mime-parse-buffer))
+		(setq flags (elmo-message-flags
+			     folder
+			     msg
+			     (elmo-msgdb-get-message-id-from-buffer)))
 		(catch 'terminate
 		  (dolist (rule (append elmo-split-rule default-rule))
 		    (setq elmo-split-match-string-internal nil)
@@ -320,7 +351,10 @@ If prefix argument ARG is specified, do a reharsal (no harm)."
 					 action)))
 				    (elmo-folder-create target-folder)))
 				(elmo-folder-open-internal target-folder)
-				(elmo-folder-append-buffer target-folder 'unread)
+				(setq failure (not
+					       (elmo-folder-append-buffer
+						target-folder
+						flags)))
 				(elmo-folder-close-internal target-folder))
 			    (error (setq failure t)
 				   (incf fcount)))
@@ -364,7 +398,7 @@ If prefix argument ARG is specified, do a reharsal (no harm)."
 				       "  Test: do nothing\n")
 				      ((function action)
 				       (format "  Test: function:%s\n"
-					       (symbol-name action)))
+					       (prin1-to-string action)))
 				      (t
 				       "  ERROR: wrong action specified\n"))
 				   (cond