2009-02 / 01 02 03 04 05 06 07 08 09 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28

2009-02-14 (土)

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

某掲示板で話題になっていたので、昔作った関数を見直してみた。

○機能
- 返信先のアドレスに、自分が加入している 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)


2009-02 / 01 02 03 04 05 06 07 08 09 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28

最終更新時間: 2020-01-29 12:23 JST

検索


最近の話題
- 2020-01-22
  『AWSの薄い本 IAMのマニアックな話』を読んだ
- 2020-01-12
  『私はどのようにしてLinuxカーネルを学んだか』を読んだ
- 2019-12-20
  circleci/orb-tools を使った Orb のリリースフローが良く出来ていたので紹介する
- 2019-12-17
  Heroku 上での bundler version の決められ方
- 2019-11-17
  3ヶ月間、総務省の家計調査に協力していた
- 2019-10-28
  『Clean Architecture』を読んだ
- 2019-10-10
  terraform-provider-healthchecksio を Terraform Plugin SDK に移行した
最近追記された記事
- 2019-02-11-1 (128日前)
- 2019-02-03-1 (128日前)
- 2019-01-28-1 (128日前)
- 2019-02-03-1 (170日前)
- 2018-11-28-1 (184日前)
- 2019-05-07-1 (264日前)
- 2018-04-30-1 (279日前)
- 2018-01-28-1 (291日前)
- 2019-02-11-1 (351日前)
- 2019-01-20-1 (369日前)
カテゴリ
- Anthy (3)
- Apache (11)
- Apple (1)
- ATOK (4)
- au (3)
- AWS (24)
- Bazaar (1)
- Berkshelf (2)
- BigQuery (1)
- BitBar (4)
- Book (109)
- Boxen (2)
- Bugsnag (1)
- capistrano (4)
- chalow (57)
- ChatWork (1)
- Chef (17)
- Chrome (3)
- Chromecast (1)
- CircleCI (11)
- clang (26)
- Comics (2)
- Cooking (10)
- cvs (15)
- cygwin (12)
- D3.js (1)
- Debian (55)
- Docker (4)
- E-mail (9)
- elasticsearch (4)
- Emacs (223)
- Emacs講座 (10)
- English (4)
- feedforce (7)
- fetchmail (3)
- Firefox (20)
- Fluentd (4)
- ftp (2)
- Game (21)
- GCP (1)
- Gem (5)
- Git (9)
- GitHub (23)
- golang (11)
- Google (1)
- gpg (4)
- GrowthForecast (7)
- Health (6)
- Heroku (21)
- Homebrew (10)
- HTML (6)
- iBook (1)
- iPad (1)
- iPhone (17)
- IRC (1)
- Jenkins (8)
- JS (1)
- Karabiner (1)
- KeySnail (3)
- Kibana (1)
- Kindle (1)
- Kubernetes (2)
- Langrich (7)
- LDAP (6)
- Life (24)
- Linux (7)
- Mackerel (1)
- macOS (1)
- Mew (18)
- MongoDB (1)
- Mozilla (19)
- Music (1)
- MySQL (1)
- NAS (4)
- nginx (6)
- NHK (1)
- Node (1)
- ntp (4)
- OOP (2)
- OpenID (2)
- openssl (1)
- Opera (2)
- OSX (41)
- Perl (14)
- PHP (19)
- PostgreSQL (1)
- procmail (4)
- Programing (3)
- Puppet (1)
- Python (2)
- Rails (13)
- Rake (2)
- RaspberryPi (2)
- Redash (1)
- RedHat (29)
- Redmine (3)
- RSpec (2)
- Ruby (53)
- samba (3)
- screen (7)
- sed (5)
- serverspec (6)
- sh (8)
- Slack (2)
- Solaris9 (22)
- Spring (2)
- ssh (4)
- StatusNet (21)
- svn (12)
- Swift (1)
- Tablet (1)
- tdiary (3)
- Terraform (2)
- Twitter (15)
- Twmode (6)
- Ubuntu (5)
- UNIX (102)
- vagrant (8)
- Video (21)
- vim (1)
- Wercker (9)
- Windows (29)
- Wine (3)
- XML (11)
- XP (1)
- zsh (26)
- インストールメモ (33)
- クイックシェイプ (12)
- ネタ (15)
- 勉強会 (17)
- 携帯 (6)
- 正規表現 (4)
過去ログ
2020 : 01 02 03 04 05 06 07 08 09 10 11 12
2019 : 01 02 03 04 05 06 07 08 09 10 11 12
2018 : 01 02 03 04 05 06 07 08 09 10 11 12
2017 : 01 02 03 04 05 06 07 08 09 10 11 12
2016 : 01 02 03 04 05 06 07 08 09 10 11 12
2015 : 01 02 03 04 05 06 07 08 09 10 11 12
2014 : 01 02 03 04 05 06 07 08 09 10 11 12
2013 : 01 02 03 04 05 06 07 08 09 10 11 12
2012 : 01 02 03 04 05 06 07 08 09 10 11 12
2011 : 01 02 03 04 05 06 07 08 09 10 11 12
2010 : 01 02 03 04 05 06 07 08 09 10 11 12
2009 : 01 02 03 04 05 06 07 08 09 10 11 12
2008 : 01 02 03 04 05 06 07 08 09 10 11 12
2007 : 01 02 03 04 05 06 07 08 09 10 11 12
2006 : 01 02 03 04 05 06 07 08 09 10 11 12
2005 : 01 02 03 04 05 06 07 08 09 10 11 12
2004 : 01 02 03 04 05 06 07 08 09 10 11 12
2003 : 01 02 03 04 05 06 07 08 09 10 11 12
2002 : 01 02 03 04 05 06 07 08 09 10 11 12
2001 : 01 02 03 04 05 06 07 08 09 10 11 12