fixedpoint.jp


メール送信前に曜日をチェックする (2007-11-03)

とある受信メールの本文中に

開催日: 11/12(金)

と日付に対して誤った曜日が書かれていました。こういった間違いを避けるため、日付に対してそれに続く曜日が正しいかどうか送信する前に確認するべきです。この怠りがちな確認作業を確実に「MUA にやらせる」というアイディアがあります。

Mew 5.2 なら下のようなコードで簡単にチェックできます。あらかじめ読み込まれる設定ファイル(e.g. .mew.el)含めておきます。ただし文字エンコーディングに注意してください。`2007/11/03(日)'、`11/12(金)'、`2007-11-04 (mon.)'、'11月4日(月曜日)' といった誤りを検出すると確認を促し、ユーザー選択に従って送信動作をキャンセルします:

.mew.el
(require 'calendar)

(defvar my-dow-date-regexp
  "\\(?:\\([0-9]+\\)[年/-]\\)?\\([01]?[0-9]\\)[月/-]\\([0123]?[0-9]\\)[日]?[  ]*[((]\\([^))]+\\)[))]")
(defvar my-dow-index-year         1)
(defvar my-dow-index-month        2)
(defvar my-dow-index-day-of-month 3)
(defvar my-dow-index-name         4)
(defvar my-dow-day-regexp-alist
  (let ((alist '()))
    (dolist (spec
             '((0 "sun" "日")
               (1 "mon" "月")
               (2 "tue" "火")
               (3 "wed" "水")
               (4 "thu" "木")
               (5 "fri" "金")
               (6 "sat" "土"))
             alist)
      (let* ((en0 (cadr spec))
             (en1 (list en0 (capitalize en0) (upcase en0)))
             (en2 (append en1 (mapcar (lambda (s) (concat s ".")) en1)))
             (ja0 (nth 2 spec))
             (ja1 (list ja0 (concat ja0 "曜") (concat ja0 "曜日")))
             (re (regexp-opt (append en2 ja1))))
         (setq alist (cons (cons (car spec) (concat "^" re "$")) alist))))))

(defun my-dow-check-in-message ()
  "Check the day of week following date in message."
  (goto-char (mew-header-end))
  (let ((ol (make-overlay 0 0)))
    (overlay-put ol 'face 'highlight)
    (unwind-protect
        (while (re-search-forward my-dow-date-regexp (point-max) t)
          (let ((mdy (mapcar (lambda (i) (string-to-number (or (match-string i) "")))
                             (list my-dow-index-month
                                   my-dow-index-day-of-month
                                   my-dow-index-year)))
                (s (match-string    my-dow-index-name))
                (b (match-beginning my-dow-index-name))
                (e (match-end       my-dow-index-name)))
            (when (= 0 (nth 2 mdy))
              (setcar (cddr mdy)
                      (string-to-number (format-time-string "%Y" (current-time)))))
            (let ((wday (calendar-day-of-week mdy)))
              (dolist (pair my-dow-day-regexp-alist)
                (when (string-match (cdr pair) s)
                  (unless (= wday (car pair))
                    (move-overlay ol b e)
                    (let ((msg (format "It is afraid of %s" (aref calendar-day-name-array wday))))
                      (when (y-or-n-p (concat msg ". Do you want to modify it?"))
                        (goto-char e)
                        (error msg)))))))))
      (delete-overlay ol))))

(add-hook 'mew-make-message-hook 'my-dow-check-in-message)

XEmacs では (require 'overlay) が必要になるかもしれません。


© 2006-2023 fixedpoint.jp