1 ;;; elmo-split.el --- Split messages according to the user defined rules.
3 ;; Copyright (C) 2002 Yuuichi Teranishi <teranisi@gohome.org>
5 ;; Author: Yuuichi Teranishi <teranisi@gohome.org>
6 ;; Keywords: mail, net news
8 ;; This file is part of ELMO (Elisp Library for Message Orchestration).
10 ;; This program is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2, or (at your option)
15 ;; This program is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA.
28 ;; Put following lines on your .emacs.
30 ;; (autoload 'elmo-split "elmo-split" "Split messages on the folder." t)
32 ;; A command elmo-split is provided. If you enter:
36 ;; Messages in the `elmo-split-folder' are splitted to the folders
37 ;; according to the definition of `elmo-split-rule'.
43 (defcustom elmo-split-rule nil
44 "Split rule for the command `elmo-split'.
45 The format of this variable is a list of RULEs which has form like:
46 \(CONDITION FOLDER [continue]\)
48 The 1st element CONDITION is a sexp which consists of following.
50 1. Functions which accept argument FIELD-NAME and VALUE.
51 FIELD-NAME is a symbol of the field name.
53 `equal' ... True if the field value equals to VALUE.
54 Case of the letters are ignored.
55 `match' ... True if the field value matches to VALUE.
56 VALUE can contain \\& and \\N which will substitute
57 from matching \\(\\) patterns in the previous VALUE.
58 `address-equal' ... True if one of the addresses in the field equals to
59 VALUE. Case of the letters are ignored.
60 `address-match' ... True if one of the addresses in the field matches to
62 VALUE can contain \\& and \\N which will substitute
63 from matching \\(\\) patterns in the previous VALUE.
65 2. Functions which accept any number of arguments.
67 `or' ... True if one of the argument returns true.
68 `and' ... True if all of the arguments return true.
72 When a symbol is specified, it is evaluated.
74 The 2nd element FOLDER is the name of the folder to split messages into.
76 When the 3rd element `continue' is specified as symbol, evaluating rules is
77 not stopped even when the condition is satisfied.
81 \(setq elmo-split-rule
82 ;; Messages from spammers are stored in `+junk'
83 '(((or (address-equal from \"i.am@spammer\")
84 (address-equal from \"dull-work@dull-boy\")
85 (address-equal from \"death-march@software\")
86 (address-equal from \"ares@aon.at\")
87 (address-equal from \"get-money@richman\"))
89 ;; Messages from mule mailing list are stored in `%mule'
90 ((equal x-ml-name \"mule\") \"%mule\")
91 ;; Messages from wanderlust mailing list are stored in `%wanderlust'
92 ;; and continue evaluating following rules.
93 ((equal x-ml-name \"wanderlust\") \"%wanderlust\" continue)
94 ;; Messages from DoCoMo user are stored in `+docomo-{username}'.
95 ((match from \"\\\\(.*\\\\)@docomo\\\\.ne\\\\.jp\")
97 ;; Unmatched mails goes to `+inbox'.
102 (defcustom elmo-split-folder "%inbox"
103 "Target folder for splitting."
107 (defcustom elmo-split-log-coding-system 'x-ctext
108 "A coding-system for writing log file."
112 (defcustom elmo-split-log-file "~/.elmo/split-log"
113 "The file name of the split log."
118 (defvar elmo-split-match-string-internal nil
119 "Internal variable for string matching. Don't touch this variable by hand.")
122 (defun elmo-split-or (buffer &rest args)
125 (if (elmo-split-eval buffer arg)
129 (defun elmo-split-and (buffer &rest args)
132 (unless (not (elmo-split-eval buffer arg))
136 (defun elmo-split-address-equal (buffer field value)
137 (with-current-buffer buffer
139 'std11-address-string
140 (std11-parse-addresses-string
141 (std11-field-body (symbol-name field)))))
145 (when (string-match (concat "^"
150 (setq addrs (cdr addrs)))
153 (defun elmo-split-address-match (buffer field value)
154 (with-current-buffer buffer
156 'std11-address-string
157 (std11-parse-addresses-string
158 (std11-field-body (symbol-name field)))))
161 (when (string-match value (car addrs))
162 (setq elmo-split-match-string-internal (car addrs)
165 (setq addrs (cdr addrs)))
168 (defun elmo-split-equal (buffer field value)
169 (with-current-buffer buffer
170 (let ((field-value (std11-field-body (symbol-name field))))
171 (equal field-value value))))
173 (defun elmo-split-match (buffer field value)
174 (with-current-buffer buffer
175 (let ((field-value (std11-field-body (symbol-name field))))
177 (when (string-match value field-value)
178 (setq elmo-split-match-string-internal field-value))))))
180 (defun elmo-split-eval (buffer sexp)
183 (apply (intern (concat "elmo-split-" (symbol-name (car sexp))))
187 (std11-field-body sexp))
190 (defun elmo-split-log (message reharsal)
191 (with-current-buffer (get-buffer-create "*elmo-split*")
192 (goto-char (point-max))
193 (let ((start (point))
194 (coding-system-for-write elmo-split-log-coding-system))
198 (pop-to-buffer (current-buffer))
200 (write-region start (point) elmo-split-log-file t 'no-msg)))))
203 (defun elmo-split (&optional arg)
204 "Split messages in the `elmo-split-folder' according to `elmo-split-rule'.
205 If prefix argument ARG is specified, do a reharsal (no harm)."
207 (unless elmo-split-rule
208 (error "Split rule doest not exist. Set `elmo-split-rule' first."))
209 (let ((folder (elmo-make-folder elmo-split-folder))
210 (elmo-inhibit-display-retrieval-progress t)
214 msgs fname target-folder failure)
215 (message "Splitting...")
216 (elmo-folder-open-internal folder)
217 (setq msgs (elmo-folder-list-messages folder))
218 (elmo-progress-set 'elmo-split (length msgs) "Splitting...")
225 (elmo-message-fetch folder msg
226 (elmo-make-fetch-strategy 'entire)
227 nil (current-buffer) 'unread))
229 (dolist (rule elmo-split-rule)
230 (setq elmo-split-match-string-internal nil)
231 (when (elmo-split-eval (current-buffer) (car rule))
232 (if elmo-split-match-string-internal
233 (setq fname (elmo-expand-newtext
235 elmo-split-match-string-internal))
236 (setq fname (nth 1 rule)))
241 (setq target-folder (elmo-make-folder fname))
242 (unless (elmo-folder-exists-p target-folder)
245 (elmo-folder-creatable-p
249 "Folder %s does not exist, Create it? "
251 (elmo-folder-create target-folder)))
252 (elmo-folder-open-internal target-folder)
253 (elmo-folder-append-buffer target-folder 'unread)
254 (elmo-folder-close-internal target-folder))
255 (error (setq failure t)
259 (elmo-folder-delete-messages folder (list msg)))
262 (nth 1 (std11-extract-address-components
263 (or (std11-field-body "from") "")))
264 " " (or (std11-field-body "date") "") "\n"
266 (eword-decode-string (or (std11-field-body
269 " Folder: " fname "/0" "\n")
272 (unless (eq (nth 2 rule) 'continue)
273 (throw 'terminate nil)))))))
274 (elmo-progress-notify 'elmo-split)))
275 (elmo-folder-close-internal folder))
276 (elmo-progress-clear 'elmo-split))
277 (run-hooks 'elmo-split-hook)
282 "No message is splitted")
284 "1 message is splitted")
286 (format "%d messages are splitted" count)))
289 (format " (%d failure)." fcount))))))
291 (provide 'elmo-split)
293 ;;; elmo-split.el ends here