elmo/elmo-split.el

   1 ;;; elmo-split.el --- Split messages according to the user defined rules.
   2
   3 ;; Copyright (C) 2002 Yuuichi Teranishi <teranisi@gohome.org>
   4
   5 ;; Author: Yuuichi Teranishi <teranisi@gohome.org>
   6 ;; Keywords: mail, net news
   7
   8 ;; This file is part of ELMO (Elisp Library for Message Orchestration).
   9
  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)
  13 ;; any later version.
  14 ;;
  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.
  19 ;;
  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.
  24 ;;
  25
  26 ;;; Commentary:
  27 ;;
  28 ;; Put following lines on your .emacs.
  29 ;;
  30 ;; (autoload 'elmo-split "elmo-split" "Split messages on the folder." t)
  31 ;;
  32 ;; A command elmo-split is provided. If you enter:
  33 ;;
  34 ;; M-x elmo-split
  35 ;;
  36 ;; Messages in the `elmo-split-folder' are splitted to the folders
  37 ;; according to the definition of `elmo-split-rule'.
  38 ;;
  39
  40 (require 'elmo)
  41
  42 ;;; Code:
  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]\)
  47
  48 The 1st element CONDITION is a sexp which consists of following.
  49
  50 1. Functions which accept argument FIELD-NAME and VALUE.
  51 FIELD-NAME is a symbol of the field name.
  52
  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
  61                         VALUE.
  62                         VALUE can contain \\& and \\N which will substitute
  63                         from matching \\(\\) patterns in the previous VALUE.
  64
  65 2. Functions which accept any number of arguments.
  66
  67 `or'                ... True if one of the argument returns true.
  68 `and'               ... True if all of the arguments return true.
  69
  70 3. A symbol.
  71
  72 When a symbol is specified, it is evaluated.
  73
  74 The 2nd element FOLDER is the name of the folder to split messages into.
  75
  76 When the 3rd element `continue' is specified as symbol, evaluating rules is
  77 not stopped even when the condition is satisfied.
  78
  79 Example:
  80
  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\"))
  88          \"+junk\")
  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\")
  96          \"+docomo-\\\\1\")
  97         ;; Unmatched mails goes to `+inbox'.
  98         (t \"+inbox\")))"
  99   :group 'elmo
 100   :type 'sexp)
 101
 102 (defcustom elmo-split-folder "%inbox"
 103   "Target folder for splitting."
 104   :type 'string
 105   :group 'elmo)
 106
 107 (defcustom elmo-split-log-coding-system 'x-ctext
 108   "A coding-system for writing log file."
 109   :type 'coding-system
 110   :group 'elmo)
 111
 112 (defcustom elmo-split-log-file "~/.elmo/split-log"
 113   "The file name of the split log."
 114   :type 'file
 115   :group 'elmo)
 116
 117 ;;;
 118 (defvar elmo-split-match-string-internal nil
 119   "Internal variable for string matching.  Don't touch this variable by hand.")
 120
 121 ;;;
 122 (defun elmo-split-or (buffer &rest args)
 123   (catch 'done
 124     (dolist (arg args)
 125       (if (elmo-split-eval buffer arg)
 126           (throw 'done t)))
 127     nil))
 128
 129 (defun elmo-split-and (buffer &rest args)
 130   (catch 'done
 131     (dolist (arg args)
 132       (unless (not (elmo-split-eval buffer arg))
 133         (throw 'done nil)))
 134     t))
 135
 136 (defun elmo-split-address-equal (buffer field value)
 137   (with-current-buffer buffer
 138     (let ((addrs (mapcar
 139                   'std11-address-string
 140                   (std11-parse-addresses-string
 141                    (std11-field-body (symbol-name field)))))
 142           (case-fold-search t)
 143           result)
 144       (while addrs
 145         (when (string-match (concat "^"
 146                                     (regexp-quote value)
 147                                     "$") (car addrs))
 148           (setq addrs nil
 149                 result t))
 150         (setq addrs (cdr addrs)))
 151       result)))
 152
 153 (defun elmo-split-address-match (buffer field value)
 154   (with-current-buffer buffer
 155     (let ((addrs (mapcar
 156                   'std11-address-string
 157                   (std11-parse-addresses-string
 158                    (std11-field-body (symbol-name field)))))
 159           result)
 160       (while addrs
 161         (when (string-match value (car addrs))
 162           (setq elmo-split-match-string-internal (car addrs)
 163                 addrs nil
 164                 result t))
 165         (setq addrs (cdr addrs)))
 166       result)))
 167
 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))))
 172
 173 (defun elmo-split-match (buffer field value)
 174   (with-current-buffer buffer
 175     (let ((field-value (std11-field-body (symbol-name field))))
 176       (and field-value
 177            (when (string-match value field-value)
 178              (setq elmo-split-match-string-internal field-value))))))
 179
 180 (defun elmo-split-eval (buffer sexp)
 181   (cond
 182    ((consp sexp)
 183     (apply (intern (concat "elmo-split-" (symbol-name (car sexp))))
 184            buffer
 185            (cdr sexp)))
 186    ((stringp sexp)
 187     (std11-field-body sexp))
 188    (t (eval sexp))))
 189
 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))
 195       (insert message)
 196       (if reharsal
 197           (progn
 198             (pop-to-buffer (current-buffer))
 199             (sit-for 0))
 200         (write-region start (point) elmo-split-log-file t 'no-msg)))))
 201
 202 ;;;###autoload
 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)."
 206   (interactive "P")
 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)
 211         (reharsal arg)
 212         (count 0)
 213         (fcount 0)
 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...")
 219     (unwind-protect
 220         (progn
 221           (with-temp-buffer
 222             (dolist (msg msgs)
 223               (erase-buffer)
 224               (when (ignore-errors
 225                       (elmo-message-fetch folder msg
 226                                           (elmo-make-fetch-strategy 'entire)
 227                                           nil (current-buffer) 'unread))
 228                 (catch 'terminate
 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
 234                                        (nth 1 rule)
 235                                        elmo-split-match-string-internal))
 236                         (setq fname (nth 1 rule)))
 237                       (unless reharsal
 238                         (setq failure nil)
 239                         (condition-case nil
 240                             (progn
 241                               (setq target-folder (elmo-make-folder fname))
 242                               (unless (elmo-folder-exists-p target-folder)
 243                                 (when
 244                                     (and
 245                                      (elmo-folder-creatable-p
 246                                       target-folder)
 247                                      (y-or-n-p
 248                                       (format
 249                                        "Folder %s does not exist, Create it? "
 250                                        fname)))
 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)
 256                                  (incf fcount)))
 257                         (unless failure
 258                           (ignore-errors
 259                             (elmo-folder-delete-messages folder (list msg)))
 260                           (elmo-split-log
 261                            (concat "From "
 262                                    (nth 1 (std11-extract-address-components
 263                                            (or (std11-field-body "from") "")))
 264                                    "  " (or (std11-field-body "date") "") "\n"
 265                                    " Subject: "
 266                                    (eword-decode-string (or (std11-field-body
 267                                                              "subject") ""))
 268                                    "\n"
 269                                    "  Folder: " fname "/0" "\n")
 270                            reharsal)
 271                           (incf count))
 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)
 278     (message
 279      (concat
 280       (cond
 281        ((eq count 0)
 282         "No message is splitted")
 283        ((eq count 1)
 284         "1 message is splitted")
 285        (t
 286         (format "%d messages are splitted" count)))
 287       (if (eq fcount 0)
 288           "."
 289         (format " (%d failure)." fcount))))))
 290
 291 (provide 'elmo-split)
 292
 293 ;;; elmo-split.el ends here