;;
;; (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)
:type 'sexp)
(defcustom elmo-split-folder "%inbox"
- "Target folder for splitting."
- :type 'string
+ "Target folder or list of folders for splitting."
+ :type '(choice (string :tag "folder name")
+ (repeat (string :tag "folder name")))
:group 'elmo)
(defcustom elmo-split-log-coding-system 'x-ctext
(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
(dolist (arg args)
(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))))))
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."))
- (let ((folder (elmo-make-folder elmo-split-folder))
- (elmo-inhibit-display-retrieval-progress t)
- (reharsal arg)
+ (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)))
+ (count 0)
+ (fcount 0)
+ ret)
+ (dolist (folder folders)
+ (setq ret (elmo-split-subr (elmo-make-folder folder) arg)
+ count (+ count (car ret))
+ fcount (+ fcount (cdr ret))))
+ (run-hooks 'elmo-split-hook)
+ (message
+ (concat
+ (cond
+ ((eq count 0)
+ "No message is splitted")
+ ((eq count 1)
+ "1 message is splitted")
+ (t
+ (format "%d messages are splitted" count)))
+ (if (eq fcount 0)
+ "."
+ (format " (%d failure)." fcount))))))
+
+(defun elmo-split-subr (folder &optional reharsal)
+ (let ((elmo-inhibit-display-retrieval-progress t)
(count 0)
(fcount 0)
msgs fname target-folder failure)
(elmo-message-fetch folder msg
(elmo-make-fetch-strategy 'entire)
nil (current-buffer) 'unread))
+ (setq elmo-split-message-entity (mime-parse-buffer))
(catch 'terminate
(dolist (rule elmo-split-rule)
(setq elmo-split-match-string-internal nil)
(progn
(setq target-folder (elmo-make-folder fname))
(unless (elmo-folder-exists-p target-folder)
- (when
+ (when
(and
(elmo-folder-creatable-p
target-folder)
(elmo-progress-notify 'elmo-split)))
(elmo-folder-close-internal folder))
(elmo-progress-clear 'elmo-split))
- (run-hooks 'elmo-split-hook)
- (message
- (concat
- (cond
- ((eq count 0)
- "No message is splitted")
- ((eq count 1)
- "1 message is splitted")
- (t
- (format "%d messages are splitted" count)))
- (if (eq fcount 0)
- "."
- (format " (%d failure)." fcount))))))
+ (cons count fcount)))
-(provide 'elmo-split)
+(require 'product)
+(product-provide (provide 'elmo-split) (require 'elmo-version))
;;; elmo-split.el ends here