[Mew-dist 10083] Re: setting From: value based on case?
OBATA Noboru
obata at example.com
1999年 8月 16日 (月) 13:26:13 JST
小幡です。
たびたびヘッダ推測に関係しそうな話題が出るので、不完全ではありま
すが mew-guess.el を contrib したいと思います。ご参考にどうぞ。
(contrib/mew-ff.el は削除して下さい > かずさん)
ヘッダ推測とは、書いている最中のヘッダに基づき他のヘッダの内容を
その場で書き換える機能です。
>> In message <19990815235741A.1000 at example.com>,
>> sen_ml at example.com writes:
> 自分の現在の設定だと、'C' で切り換えを行い、'w' で draft を作成すると
> From: の値が default の case の時のまま (mew-from の値) です。From: の値を
> case にちなんで切り換えさせる事は可能でしょうか？
今のところ、Config: の既定値を mew-config-imget にしたり、その
Config: に基づき From: を書き換えることができます。ドラフトに直
接反映されて、送信する前に目で確認できるので、ちょっと安心です。
と書いていたら、
>> In message <19990816123056U.1000 at example.com>,
>> sen_ml at example.com writes:
> (setq mew-from nil)
> (setq mew-use-config-imget-for-draft t)
>
> にしたらうまく行きました。ありがとうございます。 (__)
ありゃー。
--
小幡 昇 (obata at example.com)
-------------- next part --------------
;;; mew-guess.el --- Guess header and template file in draft for Mew
;; Author: OBATA Noboru <obata at example.com>
;; Created: Mar 22, 1999
;; Revised: Aug 16, 1999
;;; Commentary:
;; このパッケージは、ドラフトモードにおいて、既存のヘッダの内容から、他
;; のヘッダの内容を推測して書き換える機能を提供します。例えば、To: ヘッ
;; ダから From: を変更したり、Config: を挿入することができます。
;;
;; また、もうひとつの機能として、文頭にテキストファイル (テンプレート)
;; を挿入することができます。挿入するファイル名も、ヘッダから推測させる
;; ことができます。
;;
;; インストールの方法。
;;
;; - このファイルを emacs が見付けられる場所に置きます。
;;
;; - .emacs に次の記述を追加します。(define-key ...) はキーバインドの例
;; です。お好みに合わせて変えて下さい。
;;
;; (add-hook 'mew-init-hook
;; (lambda ()
;; (require 'mew-guess)
;; (define-key mew-draft-header-map "\C-c\C-v" 'mew-guess-template)
;; (define-key mew-draft-header-map "\C-c\C-d" 'mew-guess-header)
;; (define-key mew-draft-body-map "\C-c\C-v" 'mew-guess-template)
;; (define-key mew-draft-body-map "\C-c\C-d" 'mew-guess-header)))
;;
;; 設定の例。
;;
;; - ヘッダ推測の例。
;;
;; (setq mew-guess-header-alist
;; '(
;; ("From:"
;; ;; From: の推測のルール
;; ("To:"
;; ;; To: の内容が、"sorry@" にマッチしたら、From: の内容を
;; ;; "小幡 昇 <obata at example.com>" に書き
;; ;; 換えます。
;; ("sorry@" "小幡 昇 <obata at example.com>")
;; ;; 同様に、To: の内容が "@linux\\.or\\.jp" にマッチした
;; ;; ら、From: を "OBATA Noboru <obata at example.com>" に
;; ;; 書き換えます。
;; ("@linux\\.or\\.jp" "OBATA Noboru <obata at example.com>")
;; )
;; ("Config:"
;; ;; Config: の内容によって書き換えたい場合。
;; ("office" "OBATA Noboru <obata at example.com>"))
;; ;; 次の特別な記法によって、デフォルト値を指定します。
;; (t "OBATA Noboru <obata at example.com>"))
;; ))
;;
;; 置換後の文字列には、今のところ変数が使用できます。例えば、次のように
;; 書けば mew-config-imget の値を Config: に設定できます。
;;
;; (setq mew-guess-header-alist
;; '(
;; ("Config:"
;; (t mew-config-imget)
;; )
;; ))
;;
;; - テンプレート推測の例。
;;
;; (setq mew-guess-template-alist
;; '(("To:"
;; ;; To: の内容が "foo" にマッチしたら、文頭にファイル
;; ;; "~/.ff-foo" を挿入します。
;; ("foo" "~/.ff-foo")
;; ;; 同様。
;; ("bar" "~/.ff-bar")
;; )
;; ))
;;
;; - キーワード置換の例。上の方法では、推測のルールだけファイルを作らな
;; くてはいけないので、面倒です。テンプレートファイルに |>keyword<| の
;; 書式でキーワードを埋め込み、そのキーワードの置換を指定することができ
;; ます。
;;
;; (setq mew-guess-template-alist
;; '(("To:"
;; ;; To: の内容が "foo" にマッチしたら、文頭にファイル
;; ;; "~/.ff-foo" を挿入します。そのとき、ファイル内のキーワー
;; ;; ド |>me<| を、"ふー" (ダブルクォーテーションはなし) に
;; ;; 置き換えます。
;; ("foo" "~/.ff-foo" ("me" . "ふー"))
;; ;; 同様。
;; ("bar" "~/.ff-foo" ("me" . "ばー"))
;; )
;; ;; デフォルト
;; (t "~/.ff-foo")
;; ))
;;
;; その際、キーワード置換の既定値を、次のように記述することができます。
;; 置換後の文字列として、変数名、関数名、ラムダ式を記述できます。
;;
;; (setq mew-draft-replace-alist
;; '(("me" . "小幡")
;; ("email" . mew-mail-address)
;; ("time" . (lambda () (current-time-string)))
;; ;; ("time" . current-time-string) も OK
;; ))
;;
;; バグ。
;;
;; ヘッダ置換後の文字列指定には、文字列、変数名、関数名、ラムダ式など何
;; でも記述できるようにしたい。でも今は文字列と変数名しか通らない。
;; mew-guess-by-alist とデータ書式をちゃんと考え直せばよさそう。
;;; Code:
;; Guess
(defun mew-guess-by-alist (alist)
(let (name header sublist key val ent ret)
(while (and alist (not ret))
(setq name (car (car alist)))
(setq sublist (cdr (car alist)))
(cond
((eq name t)
(setq ret sublist))
;;((eq name nil)
;;(setq ret sublist))
(t
(setq header (mew-header-get-value name))
(if header
(while (and sublist (not ret))
(setq key (car (car sublist)))
(setq val (cdr (car sublist)))
(if (and (stringp key) (string-match key header))
(cond
((stringp (car val))
(setq ent
(mew-refile-guess-by-alist2 key header (car val))))
((listp (car val))
(setq ent (mew-guess-by-alist val)))))
(if ent (setq ret val))
(setq sublist (cdr sublist))))))
(setq alist (cdr alist)))
ret))
;; Header
(defvar mew-guess-header-alist nil
"*Alist to guess header contents.
The syntax is:
(HEADER-GUS (HEADER-CND (KEY VALUE)... )... )...
HEADER-GUS is the target header which you want to guess and modify.
HEADER-CND and KEY specify the condition to guess. If regexp KEY matches
to contents of HEADER-CND, contents are replaced with string VALUE.")
(defun mew-guess-header ()
"Guess and modify header according to \"mew-guess-header-alist\"."
(interactive)
(save-excursion
(mew-header-goto-end)
(let ((alist mew-guess-header-alist)
header-gus sublist header-cnd glist)
(while alist
(setq header-gus (car (car alist)))
(setq glist (mew-guess-by-alist (cdr (car alist))))
(if glist
(mew-header-replace-value header-gus (car glist)))
(setq alist (cdr alist)))
(mew-draft-rehighlight)
(setq mew-guess-header-done t))))
(defun mew-header-replace-value (field value)
"Replace header contents."
(interactive)
(let ((newvalue (cond
((null value) "")
((stringp value) value)
((functionp value) (funcall value))
((symbolp value)
(if (fboundp value) (funcall value)
(if (and (boundp value)
(stringp (symbol-value value)))
(symbol-value value))))
(t ""))))
(progn
(mew-header-delete-lines (list field))
(goto-char (mew-header-end))
(if (not (= 0 (length newvalue)))
(mew-draft-header-insert field newvalue)))))
;; Template
(defvar mew-guess-template-alist nil
"*Alist to guess template file.
The basic syntax is:
(HEADER (KEY TEMPLATE)... )...
If regexp KEY matches to contents of HEADER, file TEMPLATE is guessed
and guess is finished. Note that there is no dot (.) between KEY and
TEMPLATE.
You can specify alists for keyword replacement like:
(HEADER (KEY TEMPLATE (REPLACE-FROM . REPLACE-TO)... )... )...
Alists in this form take precedence over \"mew-draft-replace-alist\".
For example:
(setq mew-guess-template-alist
'((\"To:\"
(\"mew-dist at example.com\" \"~/.ff-mew-dist\"
(\"hello\" . \"Mew friends,\")))
(\"foo at example.com\" \"~/.ff-other\")
(t \"~/.ff-default\")
))
There is exceptional form as you can see in the example:
(t TEMPLATE [(REPLACE-FROM . REPLACE-TO)...])
You can specify default TEMPLATE in this form, putting it on the last.")
(defun mew-guess-template ()
"Insert template file on the top of the draft message."
(interactive)
(let* ((glist (mew-guess-by-alist mew-guess-template-alist))
(file (car glist)) (kwlist (cdr glist)) deleted efile)
(if file
(progn
(setq efile (expand-file-name file))
(if (not (file-exists-p efile))
(message "No template file %s" efile)
(progn
(forward-char
(mew-draft-insert-file-and-replace
efile 'top (list kwlist mew-draft-replace-alist)))))))))
;; Misc
(defvar mew-draft-replace-alist nil
"*Alist for keyword replacement in draft.
Keywords \"|>keyword<|\" in the template file and signature file (not
yet) are replaced with it's associated value. It is possible to specify
string, function, variable and lambda expression as the associated
value, which is evaluated when replacement occurs.
You can replace keyword to the string flushed on the right. For example:
(setq mew-draft-replace-alist
'((\"name\" . \"HOGE Hoge\")
(\"email\" . \"foo at example.com\")
(\"time\" .
(lambda () (format (format \"%%%ds\" fill-column)
(current-time-string))))
))")
(defun mew-draft-insert-file-and-replace (file pos &optional alists)
"Insert file and replace keyword.
Insert file FILE on position POS (possible values are top, bottom and
here), and replace keyword according to ALISTS (list of alist)."
(interactive)
(cond
((eq pos 'top)
(goto-char (mew-header-end))
(forward-line))
((eq pos 'bottom)
(if (null (mew-attach-p))
(goto-char (point-max))
(goto-char (mew-attach-begin))
(forward-line -1)
(end-of-line)
(insert "\n"))))
(let (bytes)
(save-restriction
(narrow-to-region
(point) (+ (point) (car (cdr (insert-file-contents file)))))
(while alists
(mew-draft-replace-by-alist (car alists))
(setq alists (cdr alists)))
(mew-fib-delete-frame)
(setq bytes (- (point-max) (point-min))))))
(defun mew-draft-replace-by-alist (alist)
"Fill |>item<| by alist."
(interactive)
(save-excursion
(let (begin end str)
(goto-char (point-min))
(while (re-search-forward "|>\\([^<]+\\)<|" nil t)
(setq begin (match-beginning 1)
end (match-end 1)
str (buffer-substring begin end))
(delete-region begin end)
(backward-char 2)
(insert (let ((obj (cdr (assoc (downcase str) alist))))
(cond
((null obj) str)
((stringp obj) obj)
((functionp obj) (funcall obj))
((symbolp obj)
(if (fboundp obj) (funcall obj)
(if (and (boundp obj)
(stringp (symbol-value obj)))
(symbol-value obj))))
(t str))))))))
(provide 'mew-guess)
;;; mew-guess.el ends here
Mew-dist メーリングリストの案内