Mew でメーリングリストに返信する時に宛先を構築し直す。

(defvar mew-subscribed-mailing-list
  '("[email protected]"
    "[email protected]")
  "加入している 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)