From: teranisi Date: Fri, 12 Jul 2002 00:36:22 +0000 (+0000) Subject: * elmo-split.el: New file. X-Git-Tag: elmo-mark-root~58 X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=5da2bf331f62a50df8ca604b9da5e0276201740a;p=elisp%2Fwanderlust.git * elmo-split.el: New file. * elmo-imap4.el (elmo-folder-append-buffer): Set flag as empty explicitly. --- diff --git a/elmo/ChangeLog b/elmo/ChangeLog index 0686c48..6d4d6f0 100644 --- a/elmo/ChangeLog +++ b/elmo/ChangeLog @@ -1,5 +1,10 @@ 2002-07-12 Yuuichi Teranishi + * elmo-split.el: New file. + + * elmo-imap4.el (elmo-folder-append-buffer): Set flag as empty + explicitly. + * elmo-version.el (elmo-version): Up to 2.9.14. * elmo-util.el (elmo-expand-newtext): New function (renamed from diff --git a/elmo/elmo-imap4.el b/elmo/elmo-imap4.el index 6ca9d5a..d907e49 100644 --- a/elmo/elmo-imap4.el +++ b/elmo/elmo-imap4.el @@ -2487,7 +2487,7 @@ If optional argument REMOVE is non-nil, remove FLAG." "append " (elmo-imap4-mailbox (elmo-imap4-folder-mailbox-internal folder)) - (if unread " " " (\\Seen) ") + (if unread " () " " (\\Seen) ") (elmo-imap4-buffer-literal send-buffer)))) (kill-buffer send-buffer)) result) diff --git a/elmo/elmo-split.el b/elmo/elmo-split.el new file mode 100644 index 0000000..ec14c01 --- /dev/null +++ b/elmo/elmo-split.el @@ -0,0 +1,293 @@ +;;; elmo-split.el --- Split messages according to the user defined rules. + +;; Copyright (C) 2002 Yuuichi Teranishi + +;; Author: Yuuichi Teranishi +;; Keywords: mail, net news + +;; This file is part of ELMO (Elisp Library for Message Orchestration). + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. +;; + +;;; Commentary: +;; +;; Put following lines on your .emacs. +;; +;; (autoload 'elmo-split "elmo-split" "Split messages on the folder." t) +;; +;; 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) + +;;; Code: +(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]\) + +The 1st element CONDITION is a sexp which consists of following. + +1. Functions which accept argument FIELD-NAME and VALUE. +FIELD-NAME is a symbol of the field name. + +`equal' ... True if the field value equals to VALUE. + Case of the letters are ignored. +`match' ... True if the field value matches to VALUE. + VALUE can contain \\& and \\N which will substitute + from matching \\(\\) patterns in the previous VALUE. +`address-equal' ... True if one of the addresses in the field equals to + VALUE. Case of the letters are ignored. +`address-match' ... True if one of the addresses in the field matches to + VALUE. + VALUE can contain \\& and \\N which will substitute + from matching \\(\\) patterns in the previous VALUE. + +2. 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. + +When a symbol is specified, it is evaluated. + +The 2nd element FOLDER is the name of the folder to split messages into. + +When the 3rd element `continue' is specified as symbol, evaluating rules is +not stopped even when the condition is satisfied. + +Example: + +\(setq elmo-split-rule + ;; Messages from spammers are stored in `+junk' + '(((or (address-equal from \"i.am@spammer\") + (address-equal from \"dull-work@dull-boy\") + (address-equal from \"death-march@software\") + (address-equal from \"ares@aon.at\") + (address-equal from \"get-money@richman\")) + \"+junk\") + ;; Messages from mule mailing list are stored in `%mule' + ((equal x-ml-name \"mule\") \"%mule\") + ;; Messages from wanderlust mailing list are stored in `%wanderlust' + ;; and continue evaluating following rules. + ((equal x-ml-name \"wanderlust\") \"%wanderlust\" continue) + ;; Messages from DoCoMo user are stored in `+docomo-{username}'. + ((match from \"\\\\(.*\\\\)@docomo\\\\.ne\\\\.jp\") + \"+docomo-\\\\1\") + ;; Unmatched mails goes to `+inbox'. + (t \"+inbox\")))" + :group 'elmo + :type 'sexp) + +(defcustom elmo-split-folder "%inbox" + "Target folder for splitting." + :type 'string + :group 'elmo) + +(defcustom elmo-split-log-coding-system 'x-ctext + "A coding-system for writing log file." + :type 'coding-system + :group 'elmo) + +(defcustom elmo-split-log-file "~/.elmo/split-log" + "The file name of the split log." + :type 'file + :group 'elmo) + +;;; +(defvar elmo-split-match-string-internal nil + "Internal variable for string matching. Don't touch this variable by hand.") + +;;; +(defun elmo-split-or (buffer &rest args) + (catch 'done + (dolist (arg args) + (if (elmo-split-eval buffer arg) + (throw 'done t))) + nil)) + +(defun elmo-split-and (buffer &rest args) + (catch 'done + (dolist (arg args) + (unless (not (elmo-split-eval buffer arg)) + (throw 'done nil))) + t)) + +(defun elmo-split-address-equal (buffer field value) + (with-current-buffer buffer + (let ((addrs (mapcar + 'std11-address-string + (std11-parse-addresses-string + (std11-field-body (symbol-name field))))) + (case-fold-search t) + result) + (while addrs + (when (string-match (concat "^" + (regexp-quote value) + "$") (car addrs)) + (setq addrs nil + result t)) + (setq addrs (cdr addrs))) + result))) + +(defun elmo-split-address-match (buffer field value) + (with-current-buffer buffer + (let ((addrs (mapcar + 'std11-address-string + (std11-parse-addresses-string + (std11-field-body (symbol-name field))))) + result) + (while addrs + (when (string-match value (car addrs)) + (setq elmo-split-match-string-internal (car addrs) + addrs nil + result t)) + (setq addrs (cdr addrs))) + result))) + +(defun elmo-split-equal (buffer field value) + (with-current-buffer buffer + (let ((field-value (std11-field-body (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)))) + (and field-value + (when (string-match value field-value) + (setq elmo-split-match-string-internal field-value)))))) + +(defun elmo-split-eval (buffer sexp) + (cond + ((consp sexp) + (apply (intern (concat "elmo-split-" (symbol-name (car sexp)))) + buffer + (cdr sexp))) + ((stringp sexp) + (std11-field-body sexp)) + (t (eval sexp)))) + +(defun elmo-split-log (message reharsal) + (with-current-buffer (get-buffer-create "*elmo-split*") + (goto-char (point-max)) + (let ((start (point)) + (coding-system-for-write elmo-split-log-coding-system)) + (insert message) + (if reharsal + (progn + (pop-to-buffer (current-buffer)) + (sit-for 0)) + (write-region start (point) elmo-split-log-file t 'no-msg))))) + +;;;###autoload +(defun elmo-split (&optional arg) + "Split messages in the `elmo-split-folder' according to `elmo-split-rule'. +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) + (count 0) + (fcount 0) + msgs fname target-folder failure) + (message "Splitting...") + (elmo-folder-open-internal folder) + (setq msgs (elmo-folder-list-messages folder)) + (elmo-progress-set 'elmo-split (length msgs) "Splitting...") + (unwind-protect + (progn + (with-temp-buffer + (dolist (msg msgs) + (erase-buffer) + (when (ignore-errors + (elmo-message-fetch folder msg + (elmo-make-fetch-strategy 'entire) + nil (current-buffer) 'unread)) + (catch 'terminate + (dolist (rule elmo-split-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))) + (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 + (ignore-errors + (elmo-folder-delete-messages folder (list msg))) + (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" + " Folder: " fname "/0" "\n") + reharsal) + (incf count)) + (unless (eq (nth 2 rule) 'continue) + (throw 'terminate nil))))))) + (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)))))) + +(provide 'elmo-split) + +;;; elmo-split.el ends here