某掲示板で話題になっていたので、昔作った関数を見直してみた。
○機能
返信先のアドレスに、自分が加入している ML が含まれていると、
そのアドレス以外のアドレスを全て宛先から除外する。 削除されたアドレスは、メール本文の先頭に以下のように挿入される。
|!!! Deleted Value !!!
|To: who@example.com |Cc:
|Dcc: masutaka@example.com 自分が加入している ML は mew-subscribed-mailing-list に設定すること。 ○ソース
(defvar mew-subscribed-mailing-list '("mew-dist@mew.org" "mew-win32@mew.org") "加入している ML をリストで記述。正規表現指定不可。 nil ならどの ML にも加入していないものとする。") (defun mew-draft-restructure-header () "返信先のアドレスに、自分が加入している ML が含まれていると、 そのアドレス以外のアドレスを全て宛先から除外する。 自分が加入している ML は mew-subscribed-mailing-list に設定すること。 削除されたアドレスは、メール本文の先頭に挿入される。" (save-excursion (let ((deleted-alist)) (setq deleted-alist (mew-draft-restructure-header-internal)) (when deleted-alist (let (str deleted-list address) (setq str "### Deleted Value ###\n") (dolist (field (list mew-to: mew-cc: mew-dcc: mew-bcc:)) (setq deleted-list (assoc field deleted-alist)) (when deleted-list (setq str (concat str field " " (mapconcat 'format (cdr deleted-list) ", ") "\n")))) (setq str (concat str "\n")) (mew-header-goto-body) (insert str)))))) (defun mew-draft-restructure-header-internal () "To:, Cc:, Bcc:, Dcc: から不要なアドレスを削除し、 削除したフィールドの名前と値をリストで返す。 To: が空になった場合は、Cc: のアドレスを To: に置き換える。" (let (subscribed-ml-exist deleted-alist) (catch 'loop (dolist (field (list mew-to: mew-cc:)) (dolist (address (mew-header-parse-address-list (list field))) ;; 加入している ML があった場合は即座にループから抜ける。 (if (mew-member-case-equal address mew-subscribed-mailing-list) (throw 'loop (setq subscribed-ml-exist t)))))) (when subscribed-ml-exist ;; To と Cc から mew-subscribed-mailing-list 以外のアドレスを削除し、 ;; Bcc と Dcc は自分のアドレスを削除する。 (setq deleted-alist `(,@(mew-draft-restructure-to-cc) ,@(mew-draft-restructure-bcc-dcc))) ;; To が空になっていたら、Cc を To にしてしまおう。 (unless (mew-header-parse-address-list (list mew-to:)) (let ((cc (mew-header-parse-address-list (list mew-cc:)))) (mew-header-delete-lines (list mew-to: mew-cc:)) (mew-header-insert mew-to: (mapconcat 'format cc ", ")) ))) deleted-alist)) (defun mew-draft-restructure-to-cc () "To: と Cc: から不要なアドレスを削除し、 削除したフィールドの名前と値をリストで返す。" (let (deleted-alist) (dolist (field (list mew-to: mew-cc:) deleted-alist) (let (enable-address-list delete-address-list) (dolist (addr (mew-header-parse-address-list (list field))) (if (mew-member-case-equal addr mew-subscribed-mailing-list) (setq enable-address-list `(,@enable-address-list ,addr)) (setq delete-address-list `(,@delete-address-list ,addr)))) (setq deleted-alist (cons (cons field delete-address-list) deleted-alist)) (if enable-address-list (mew-header-replace-value field (mapconcat 'format enable-address-list ", ")) (mew-header-delete-lines (list field))))))) (defun mew-draft-restructure-bcc-dcc () "Bcc: および Dcc: フィールドを削除し、 削除したフィールドの名前と値をリストで返す。" (let (deleted-alist) (dolist (field (list mew-dcc: mew-bcc:) deleted-alist) (let ((deleted-address-list)) (setq deleted-address-list (mew-header-parse-address-list (list field))) (when deleted-address-list (setq deleted-alist (cons (cons field deleted-address-list) deleted-alist)) (mew-header-delete-lines (list field))))))) (add-hook 'mew-draft-mode-newdraft-hook 'mew-draft-restructure-header)