X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=elmo%2Felmo-split.el;h=db175a4c3e9371057aa1cd9fa17d707af6848a03;hb=21f27bac7391dd60d5e54c2c4c5ef1e7b5557a54;hp=70699f0f4c4a4a7a9c52b22a2f341d435de5f579;hpb=bfd5b5420e07cdd7309c451f640aeba6d1c4494f;p=elisp%2Fwanderlust.git diff --git a/elmo/elmo-split.el b/elmo/elmo-split.el index 70699f0..db175a4 100644 --- a/elmo/elmo-split.el +++ b/elmo/elmo-split.el @@ -29,13 +29,13 @@ ;; ;; (autoload 'elmo-split "elmo-split" "Split messages on the folder." t) ;; -;; A command elmo-split is provided. If you enter: +;; A command elmo-split is provided. If you enter: ;; ;; M-x elmo-split ;; ;; Messages in the `elmo-split-folder' are splitted to the folders ;; according to the definition of `elmo-split-rule'. -;; +;; (require 'elmo) @@ -43,11 +43,11 @@ (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: -\(CONDITION FOLDER [continue]\) +\(CONDITION ACTION [continue]\) 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,16 +62,27 @@ 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. +4. A symbol. When a symbol is specified, it is evaluated. -The 2nd element FOLDER is the name of the folder to split messages into. +The 2nd element ACTION is the name of the destination folder or some symbol. +If CONDITION is satisfied, the message is splitted according to this value. + +If ACTION is a string, it will be considered as the name of destination folder. +Symbol `delete' means that the substance of the message will be removed. On the +other hand, symbol `noop' is used to do nothing and keep the substance of the +message as it is. Or, if some function is specified, it will be called. When the 3rd element `continue' is specified as symbol, evaluating rules is not stopped even when the condition is satisfied. @@ -105,6 +116,15 @@ Example: (repeat (string :tag "folder name"))) :group 'elmo) +(defcustom elmo-split-default-action 'noop + "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") + (function :tag "function")) + :group 'elmo) + (defcustom elmo-split-log-coding-system 'x-ctext "A coding-system for writing log file." :type 'coding-system @@ -119,6 +139,10 @@ Example: (defvar elmo-split-match-string-internal nil "Internal variable for string matching. Don't touch this variable by hand.") +(defvar elmo-split-message-entity nil + "Buffer local variable to store mime-entity.") +(make-variable-buffer-local 'elmo-split-message-entity) + ;;; (defun elmo-split-or (buffer &rest args) (catch 'done @@ -134,6 +158,12 @@ Example: (throw 'done nil))) t)) +(defun elmo-split-> (buffer size) + (> (buffer-size buffer) size)) + +(defun elmo-split-< (buffer size) + (< (buffer-size buffer) size)) + (defun elmo-split-address-equal (buffer field value) (with-current-buffer buffer (let ((addrs (mapcar @@ -166,14 +196,27 @@ Example: (setq addrs (cdr addrs))) result))) +(defun elmo-split-fetch-decoded-field (entity field-name) + (let ((sym (intern (capitalize field-name))) + (field-body (mime-entity-fetch-field entity field-name))) + (when field-body + (mime-decode-field-body field-body sym 'plain)))) + (defun elmo-split-equal (buffer field value) (with-current-buffer buffer - (let ((field-value (std11-field-body (symbol-name field)))) + (let ((field-value (and + elmo-split-message-entity + (elmo-split-fetch-decoded-field + elmo-split-message-entity + (symbol-name field))))) (equal field-value value)))) (defun elmo-split-match (buffer field value) (with-current-buffer buffer - (let ((field-value (std11-field-body (symbol-name field)))) + (let ((field-value (and elmo-split-message-entity + (elmo-split-fetch-decoded-field + elmo-split-message-entity + (symbol-name field))))) (and field-value (when (string-match value field-value) (setq elmo-split-match-string-internal field-value)))))) @@ -206,7 +249,7 @@ Example: If prefix argument ARG is specified, do a reharsal (no harm)." (interactive "P") (unless elmo-split-rule - (error "Split rule doest not exist. Set `elmo-split-rule' first.")) + (error "Split rule does not exist. Set `elmo-split-rule' first")) (let ((folders (if (listp elmo-split-folder) elmo-split-folder (list elmo-split-folder))) @@ -235,7 +278,9 @@ If prefix argument ARG is specified, do a reharsal (no harm)." (let ((elmo-inhibit-display-retrieval-progress t) (count 0) (fcount 0) - msgs fname target-folder failure) + (default-rule `((t ,elmo-split-default-action))) + msgs action target-folder failure delete-substance + record-log log-string) (message "Splitting...") (elmo-folder-open-internal folder) (setq msgs (elmo-folder-list-messages folder)) @@ -249,53 +294,99 @@ 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)) (catch 'terminate - (dolist (rule elmo-split-rule) + (dolist (rule (append elmo-split-rule default-rule)) (setq elmo-split-match-string-internal nil) (when (elmo-split-eval (current-buffer) (car rule)) - (if elmo-split-match-string-internal - (setq fname (elmo-expand-newtext - (nth 1 rule) - elmo-split-match-string-internal)) - (setq fname (nth 1 rule))) + (if (and (stringp (nth 1 rule)) + elmo-split-match-string-internal) + (setq action (elmo-expand-newtext + (nth 1 rule) + elmo-split-match-string-internal)) + (setq action (nth 1 rule))) + ;; 1. ACTION & DELETION (unless reharsal - (setq failure nil) - (condition-case nil - (progn - (setq target-folder (elmo-make-folder fname)) - (unless (elmo-folder-exists-p target-folder) - (when - (and - (elmo-folder-creatable-p - target-folder) - (y-or-n-p - (format - "Folder %s does not exist, Create it? " - fname))) - (elmo-folder-create target-folder))) - (elmo-folder-open-internal target-folder) - (elmo-folder-append-buffer target-folder 'unread) - (elmo-folder-close-internal target-folder)) - (error (setq failure t) - (incf fcount))) - (unless failure + (setq failure nil + delete-substance nil + record-log nil + log-string nil) + (cond + ((stringp action) + (condition-case nil + (progn + (setq target-folder (elmo-make-folder action)) + (unless (elmo-folder-exists-p target-folder) + (when + (and + (elmo-folder-creatable-p target-folder) + (y-or-n-p + (format + "Folder %s does not exist, Create it? " + action))) + (elmo-folder-create target-folder))) + (elmo-folder-open-internal target-folder) + (elmo-folder-append-buffer target-folder) + (elmo-folder-close-internal target-folder)) + (error (setq failure t) + (incf fcount))) + (setq record-log t + delete-substance + (not (or failure + (eq (nth 2 rule) 'continue)))) + (incf count)) + ((eq action 'delete) + (setq record-log t + delete-substance t)) + ((eq action 'noop) + ;; do nothing + ) + ((functionp action) + (funcall action)) + (t + (error "Wrong action specified in elmo-split-rule"))) + (when delete-substance (ignore-errors - (elmo-folder-delete-messages folder (list msg)))) - (incf count)) - (elmo-split-log - (concat "From " - (nth 1 (std11-extract-address-components - (or (std11-field-body "from") ""))) - " " (or (std11-field-body "date") "") "\n" - " Subject: " - (eword-decode-string (or (std11-field-body - "subject") "")) - "\n" - (if reharsal - " Test: " - " Folder: ") - fname "/0" "\n") - reharsal) + (elmo-folder-delete-messages folder (list msg))))) + ;; 2. RECORD LOG + (when (or record-log + reharsal) + (elmo-split-log + (concat "From " + (nth 1 (std11-extract-address-components + (or (std11-field-body "from") ""))) + " " (or (std11-field-body "date") "") "\n" + " Subject: " + (eword-decode-string (or (std11-field-body + "subject") "")) + "\n" + (if reharsal + (cond + ((stringp action) + (concat " Test: " action "\n")) + ((eq action 'delete) + " Test: /dev/null\n") + ((eq action 'noop) + " Test: do nothing\n") + ((function action) + (format " Test: function:%s\n" + (prin1-to-string action))) + (t + " ERROR: wrong action specified\n")) + (cond + (failure + (concat " FAILED: " action "\n")) + ((stringp action) + (concat " Folder: " action "\n")) + ((eq action 'delete) + " Deleted\n") + (log-string + log-string) + (t + (debug))))) + reharsal)) + ;; 3. CONTINUATION CHECK (unless (eq (nth 2 rule) 'continue) (throw 'terminate nil)))))) (elmo-progress-notify 'elmo-split))) @@ -303,6 +394,7 @@ If prefix argument ARG is specified, do a reharsal (no harm)." (elmo-progress-clear 'elmo-split)) (cons count fcount))) -(provide 'elmo-split) +(require 'product) +(product-provide (provide 'elmo-split) (require 'elmo-version)) ;;; elmo-split.el ends here