ルールに基づいて指定したメアドにメールを転送する処理は出来た
(*1)……けど、別の問題が。
転送したメールを移動させるフォルダをあらかじめ指定しておき、自動転送処理したメールは指定したフォルダに移動させるか、あるいは転送したメールのメッセージIDを記憶しておいて、転送したメールはそのままにしておいて、次回の自動転送処理の時に記憶しておいたメッセージIDを持つメールは自動転送処理から除外するか、どちらがいいだろう
どちらにもメリット、デメリットがあるなぁ……
とりあえず、メッセージIDを記憶しておいた方が楽そうだから、転送済みメールのメッセージIDを記憶しておいて移動とかはせずに、記憶しておいたメッセージIDを持つメールは転送処理からは除外する方向で詰めてみよう
;;; -*- MODE: Lisp; Package: EDITOR; -*-
;;;
;;; kamail-transfer.l
;;;
;;; by LKPTeam
;;;
(provide "kamail/kamail-transfer")
(in-package "kamail")
(defvar *kamail-rule-transfer-file-name* "TransRules"
"転送ルールの定義ファイル名")
(defvar *kamail-rule-transfer-file*
(merge-pathnames *kamail-rule-transfer-file-name* *kamail-data-file-path*))
(defvar *kamail-transfer-rules* nil
"転送ルールの定義リスト")
(defvar *kamail-forward-from* nil
"転送時のFROM欄")
(defvar *kamail-transfer-msgid-list-file-name* "TransMsgId"
"転送済みメールのメッセージIDの保存ファイル名")
(defvar *kamail-transfer-msgid-list-file*
(merge-pathnames *kamail-transfer-msgid-list-file-name* *kamail-data-file-path*))
(defvar *kamail-transfer-msgid-list* nil)
(defvar *kamail-auto-transfer-always-copy* nil)
(defun kamail-transfer-check-msgid (msgid)
(when (car (member msgid *kamail-transfer-msgid-list* :test 'string-equal))
(return-from kamail-transfer-check-msgid t))
(push msgid *kamail-transfer-msgid-list*)
nil)
(defun kamail-read-transfer-msgid-list ()
(let (filename line list)
(message "Loading transfer message id list ...")
(setq *kamail-transfer-msgid-list* nil)
(setq filename *kamail-transfer-msgid-list-file*)
(when (file-exist-p filename)
(with-open-file (s filename :direction :input)
(while (setq line (read s nil))
(push line list))))
(setq *kamail-transfer-msgid-list* (reverse list))
(message "Loading transfer message id list ... done.")))
(defun kamail-write-transfer-msgid-list ()
(let (filename word)
(message "Saving transfer message id list ...")
(setq filename *kamail-transfer-msgid-list-file*)
(with-open-file (s filename :direction :output
:if-does-not-exist :create)
(dolist (word *kamail-transfer-msgid-list*)
(format s "~S~%" word))
(message "Saving transfer message id list ... done."))))
(defun kamail-read-transfer-rules ()
(interactive)
(let (filename
line
list)
(message "Loading transfer rules ...")
(setq *kamail-transfer-rules* nil)
(setq filename *kamail-rule-transfer-file*)
(when (file-exist-p filename)
(with-open-file (s filename
:direction :input)
(while (setq line (read s nil))
(push line list))))
(setq *kamail-transfer-rules* (reverse list))
(message "Loading rules ... done.")))
(defun kamail-write-transfer-rules ()
(let (filename
word)
(message "Saving rules ...")
(setq filename *kamail-rule-transfer-file*)
(with-open-file (s filename
:direction :output
:if-does-not-exist :create)
(dolist (word *kamail-transfer-rules*)
(format s "~S~%" word))
(message "Saving rules ... done."))))
(defun kamail-add-transfer-rule (dest field content)
(push (list dest field content) *kamail-transfer-rules*)
(kamail-write-transfer-rules))
(defun kamail-mail-transfer-p ()
(let ((status (kamail-status-get)))
(unless status
(return-from kamail-mail-transfer-p))
(cond ((char= status *kamail-status-char-unseen*)
*kamail-transfer-unseen-mail*)
((char= status *kamail-status-char-need-reply*)
*kamail-transfer-need-reply-mail*)
(t
t)
)))
(defun kamail-apply-transfer-rules (&optional copy)
(interactive)
(setq copy (or copy *kamail-auto-transfer-always-copy*))
(save-excursion
(goto-char (point-min))
(while (not (or (eolp) (eobp)))
(let (num transfer)
(setq num (kamail-summary-getnum))
(when num
(when (kamail-mail-transfer-p)
(setq transfer (kamail-study-transfer-rules (parse-integer num)))
(when transfer
(let ((confirm *kamail-send-always-confirm*))
(kamail-view-mail)
(kamail-transfer-forward transfer)
(when confirm
(setq *kamail-send-always-confirm* nil))
(kamail-transfer-create-and-send-buffer t)
(when confirm
(setq *kamail-send-always-confirm* t))
(kamail-select-window-summary)))))
(unless (forward-line 1)
(return))))
))
(defun kamail-study-transfer-rules (num)
(let (header msgid dest)
(when (setq header (kamail-summary-header num))
(setq dest (kamail-study-transfer-header-rule header))
(when (and dest
(setq msgid (get-header-value "message-id" header))
(not (kamail-transfer-check-msgid msgid)))
(return-from kamail-study-transfer-rules dest))
(return-from kamail-study-transfer-rules nil))))
(defun kamail-study-transfer-header-rule (header &optional from)
(setq from (or from *kamail-folder-current*))
;(message-box (format nil "~S" (list header from)))
(when header
(dolist (x *kamail-transfer-rules*)
(let ((dest (car x))
(field (nth 1 x))
(content (nth 2 x))
targ)
(setq targ (get-header-value field header))
(when (and targ
(string-match content targ))
(return-from kamail-study-transfer-header-rule dest))))))
(defun kamail-transfer-forward (tofw)
(interactive)
(let ((buffer (selected-buffer))
(hash (header-to-alist))
ref id to to-name osubject subject date from ng group cc oto occ)
(and (kamail-mail-status-forwarded)
(kamail-summary-status-forwarded))
(kamail-create-draft-buffer)
(switch-to-buffer *kamail-buffer-draft*)
(setq kamail-draft-reply-header hash)
(multiple-value-setq (osubject id from oto occ date ref ng)
(kamail-draft-header-values hash))
(setq to tofw)
(setq to-name (get-header-value to *kamail-address-alist*))
(when to-name
(setq to (format nil "~A <~A>" to-name to))
)
(setq subject (concat "Fw: " osubject))
(kamail-draft-format-header *kamail-forward-from*
to cc subject ng nil ref)
(insert (kamail-format-header-string hash
*kamail-forward-header-format*))
(when *kamail-forward-footer-format*
(save-excursion
(insert (kamail-format-header-string hash
*kamail-forward-footer-format*))))
(when *kamail-signature-auto-insert*
(kamail-insert-signature))
(kamail-cite-body nil
(buffer-name buffer))
))
(defun kamail-transfer-create-and-send-buffer (&optional quit)
(interactive)
(set-buffer-modified-p nil)
(kamail-create-send-buffer)
(and (kamail-send-buffer *kamail-sent-folder*)
quit
(kamail-draft-return-buffer)))
(defun kamail-transfer-add-rule ()
(interactive)
(let ((header (header-to-alist))
dest
field
value)
(setq dest
(completing-read "Foward to: "
*kamail-address-alist*
:must-match t))
(setq field (completing-read "Field: "
header
:must-match t))
(setq value (read-string "Regexp: "
:default (or (get-header-value (string-downcase field)
header)
"")))
(kamail-add-transfer-rule dest field value)
))
(define-key *kamail-view-map* '(#\C-c #\. #\a) 'kamail-transfer-add-rule)
(define-key *kamail-list-map* '(#\C-c #\. #\t) 'kamail-apply-transfer-rules)
(define-key *kamail-list-map* '(#\C-c #\. #\r) 'kamail-read-transfer-rules)
どれもこれも既存の関数をコピーして少しだけ改変した物ばかりだけど(笑)
これをsite-lisp/kamailディレクトリ以下にkamail-transfer.lとして追加。makefileにも追加しておけばkamail-makeで一括でバイトコンパイルされるから便利かも。それから~/Kamail/.kamailに以下を追加
(require "kamail/kamail-transfer")
(setq *kamail-forward-from* "LKPteam <ykaltenative@mue.biglobe.ne.jp>")
(add-hook '*kamail-mode-hook* 'kamail-read-transfer-rules)
(add-hook '*kamail-mode-hook* 'kamail-read-transfer-msgid-list)
(add-hook '*kamail-exit-hook* 'kamail-write-transfer-msgid-list)
*kamail-forward-from*のメアドは適当に自分ので置き換えね
転送ルールの定義ファイルの書式は振り分けルールの定義ファイルと一緒。ルールの追加も一緒で、転送したいメールを表示させた状態でC-c . aで転送先、条件を適用するヘッダフィールド、条件の内容を正規表現で、という感じで指定。あとはサマリウィンドウでC-c . tを押せばサマリの中のメールを順番にスキャンしていって、転送ルールに引っかかったメールを転送する
これであとは~/Kamail/.kamailあたりにInboxにあるメールを自動でスキャンする設定を書いて、それの処理の中にkamail-apply-transfer-rulesを追加しておけば、自動転送の完了、と
ちなみにうちでは
(defun kamail-auto-folder-check ()
(interactive)
(save-window-excursion
(set-window *kamail-window-folder*)
(set-buffer *kamail-buffer-folder*)
;;; Inboxを指定
(goto-line 2)
(kamail-folder-status-this)
(goto-bol)
(if (not (looking-for "(0)"))
(progn
(kamail-select-folder-this)
;;; 自動転送
(kamail-apply-transfer-rules)
(kamail-list-reload t)
(kamail-auto-refile t)
(call-process "bash -c '~/bsfilter --auto-update --spam-cutoff 0.592 --imap --imap-fetch-unseen --imap-fetch-unflagged --insert-flag --insert-probability inbox'" :show :minimize :wait t)
(kamail-list-reload t)
(kamail-auto-refile t)
(kamail-close-folder)
(when (and *kamail-using-soundfile*)
(PlaySound soundfile 0 #x00020000))
(kamail-folder-status-all))))
(refresh-screen))
(setq *kamail-imap4-folder-auto-check-interval* 1800)
(setq *kamail-using-soundfile* t)
(start-timer *kamail-imap4-folder-auto-check-interval* 'kamail-auto-folder-check)
(add-hook '*kamail-exit-hook* '(lambda () (stop-timer 'kamail-auto-folder-check)))
こんな設定で、自動振り分け処理の中に自動転送処理を組み込んでみたりしています。kamail-auto-refileが2度あるのは、一度目の振り分けで振り分けられるメールを先に振り分けておいてから、残ったメールをbsfilterでチェック、スパム判定になったメールを二度目の振り分けでジャンクメールフォルダへ、という処理をしているから
さて、機能を追加
(*2)して一段落したし、エロげーするか(^^;
