[Mew-dist 07793] guess header and signature file on draft mode
OBATA Noboru
obata at example.com
1999年 2月 28日 (日) 23:04:58 JST
小幡です。
ヘッダコンテンツと署名ファイルを推測する件について、やってみたい
ことをとりあえずコードにしました。まだ不十分なところがありますが、
方針に対して意見が頂ければと思い投稿します。1.94b10 に対するパッ
チとちょっとしたサンプルを添付します。
1. 任意のヘッダコンテンツを、メール作成時に推測する。
mew-draft-guess-header-alist という変数を導入し、各ヘッダに対し
て、条件とそのときに書きたいコンテンツを記述できるようにしました。
条件が一致した場合に、ヘッダコンテンツを丸ごと「置換」するのか、
それとも既存のコンテンツに「追加」(先頭、末尾)するのかを制御でき
るようにしました。
本心は「置換」だけの方がスマートで良いと思います。自分の用途には
置換だけで十分だとも思います。山本さんの [Mew-dist 07778] のよう
に、推測させたい場所に予め "(guess)" のような識別文字列を埋め込
んでおくという方法もいいかなと思っていますが、正直悩んでいます。
例えば、次のように書きます。
(setq mew-draft-guess-header-alist
'(("Fcc:"
("To:"
("@localnet" "+inbox")
("mew-dist at example.com\\.org" "+ML/Mew-dist" 'eol ", "))
(t "+internet"))
("Config:"
("To:"
("mew-dist at example.com\\.org" "ml")
))
))
実際に処理を行うのは mew-draft-guess-and-modify-header という関
数で、添付のパッチでは C-cC-h に割当てました (キーバインドまわり
のコードはちょっと自信がありません)。
またデフォルトでは無効ですが、コンテンツの置換時にプロンプトを出
す制御変数 mew-draft-ask-when-guess-header も用意しました。プロ
ンプトは出したいのですが、プロンプト文字列が長くなり過ぎることが
多く、どのようにすればよいのか思案中です。
2. 任意のファイルを、メール作成時に推測して挿入する。キーワード
置換も行う。
署名ファイルも定型文ファイルも、同じように扱いたいと思い、
mew-draft-insert-file-and-replace という関数を作りました。
mew-signature-guess-alist という変数で、署名ファイルを推測します。
書式は mew-refile-guess-alist と同じで、例えば次のように書きます。
(setq mew-signature-guess-alist
'(("To:"
("mew-dist at example.com\\.org" . "~/.signature-mew")
("@hogehoge" . "~/.signature-xxx")
)
))
その中に |>keyword<| の形でキーワードを埋め込んでおくことにより、
キーワード置換を行うことができます。mew-signature-replace-alist
という変数に連想リストを持たせます。例えば、次のように書きます。
(setq mew-signature-replace-alist
'(("time" . current-time-string)
("email" . "foo at example.com")
))
定型文の挿入も統合しました。mew-draft-insert-ff という関数で、
C-cC-v に割当てました。推測の規則として mew-draft-guess-ff-alist
を、またデフォルトのキーワード置換連想リストとして
mew-draft-replace-ff-alist を導入しました。こちらの詳細は省略し
ますが、ヘルプやソースを見ればきっと分かると思います。
3. 気になる点。
推測関数を 2 種類使っています。mew-refile-guess-by-alist1 と、自
前の mew-draft-guess-by-alist です。可能であれば統合したいです。
-replace-hoge-alist とか -guess-alist が増えました。整理すれば、
もう少し減らせると思います。
-guess-config には手を付けていませんが、guess-config と同等のこ
とはできるはずです。可能であれば統合したいです。
elisp の勉強を始めて間もないため、変なコードがところどころにある
と思います。「そんなことしてはいけない」「大事なことを忘れている」
というコードがあれば指摘して頂けると大変助かります。
英語がインチキだと思います。指摘して(直して)頂けるとこれも助かり
ます。
4. サンプルについて
sample.el と .signature-sample と .ff-sample を添付します。3 つ
のファイルをホームディクトリに置き、sample.el の中身を読むと、こ
の機能を簡単に試すことができると思います。
以上、興味のあります方はお試し下さい。仕様についてアドバイス頂け
ると嬉しいです。
--
小幡 昇 (obata at example.com)
-------------- next part --------------
diff -ru mew-1.94b10.orig/mew-draft.el mew-1.94b10/mew-draft.el
--- mew-1.94b10.orig/mew-draft.el Mon Feb 22 20:53:46 1999
+++ mew-1.94b10/mew-draft.el Sun Feb 28 22:47:42 1999
@@ -135,7 +135,9 @@
(define-key (symbol-value symmap) "\C-c\C-s" 'mew-pgp-sign-letter)
(define-key (symbol-value symmap) "\C-c\C-e" 'mew-pgp-encrypt-letter)
(define-key (symbol-value symmap) "\C-c\C-b" 'mew-pgp-sign-encrypt-letter)
- (define-key (symbol-value symmap) "\C-x\C-s" 'mew-save-buffer))
+ (define-key (symbol-value symmap) "\C-x\C-s" 'mew-save-buffer)
+ (define-key (symbol-value symmap) "\C-c\C-h" 'mew-draft-guess-and-modify-header)
+ (define-key (symbol-value symmap) "\C-c\C-v" 'mew-draft-insert-ff))
(if mew-draft-body-map
()
(setq mew-draft-body-map (make-sparse-keymap))
@@ -267,6 +269,8 @@
(define-key mew-draft-mode-map "\C-c\C-z" 'mew-fib-flush-input)
(define-key mew-draft-mode-map "\C-c\C-o" 'mew-draft-insert-config)
(define-key mew-draft-mode-map "\C-x\C-s" 'mew-save-buffer)
+ (define-key mew-draft-mode-map "\C-c\C-h" 'mew-draft-guess-and-modify-header)
+ (define-key mew-draft-mode-map "\C-c\C-v" 'mew-draft-insert-ff)
)))
(if mew-xemacs-p
@@ -973,6 +977,9 @@
(end-of-line)
(mew-draft-rehighlight)))))))
+(defvar mew-signature-replace-alist nil
+ "*Alist for signature keyword replacement.")
+
(defun mew-draft-insert-signature ()
"Insert the signature file specified by mew-signature-file.
If attachments exist and mew-signature-as-lastpart is *non-nil*,
@@ -981,7 +988,10 @@
the file is inserted to the end of the body. Otherwise, inserted
the cursor position."
(interactive)
- (let ((sigfile (expand-file-name mew-signature-file)))
+ (let ((sigfile (expand-file-name
+ (or (car (mew-refile-guess-by-alist1
+ mew-signature-guess-alist))
+ mew-signature-file))))
(if (not (file-exists-p sigfile))
(message "No signature file %s" sigfile)
(if (and (mew-attach-p) mew-signature-as-lastpart)
@@ -993,15 +1003,178 @@
(mew-attach-disposition "") ;; nil is NG.
(mew-attach-description mew-signature-description)
)
- (if mew-signature-insert-last
- (if (null (mew-attach-p))
- (goto-char (point-max))
- (goto-char (mew-attach-begin))
- (forward-line -1)
- (end-of-line)
- (insert "\n")))
- (insert-file-contents sigfile)
- ))
+ (if mew-signature-insert-last
+ (mew-draft-insert-file-and-replace
+ sigfile 'bottom (list mew-signature-replace-alist))
+ (mew-draft-insert-file-and-replace
+ sigfile 'here (list mew-signature-replace-alist)))))))
+
+(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"))))
+ (mew-fib-insert-file-and-fill file alists))
+
+(defvar mew-draft-ask-when-guess-header nil
+ "*Prompt user for modificaion of guessed header if *non-nil*.")
+
+(defvar mew-draft-guess-header-alist nil
+ "*Alist to guess header contents.
+The syntax is:
+
+ (HEADER-GUS (HEADER-CND (KEY VALUE [POS [SEP]])... )... )...
+
+HEADER-GUS is the target header which you want 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.
+
+But, if optional element POS is non-nil (possible values are bol and
+eol), VALUE is *appended* before(bol) or after(eol) original contents of
+HEADER-CND.
+
+Next optional element SEP (string) is inserted between VALUE and
+original contents of HEADER-CND if necessary (both SEP is non-nil and
+original contents of HEADER-CND is non-empty).
+
+For example:
+
+ (setq mew-draft-guess-header-alist
+ '((\"Fcc:\"
+ (\"To:\"
+ (\"mew-dist at example.com\" \"+ML/Mew-dist\")))
+ (\"Dcc:\"
+ (\"To:\"
+ (\"mew-dist at example.com\" \"foo at example.com\" eol \", \")))
+ (\"Config:\"
+ (\"To:\"
+ (\"mew-dist at example.com\" \"mew\")))
+ ))")
+
+(defvar mew-draft-replace-ff-alist nil
+ "*Default alist for fixed form keyword replacement.
+Keyword like \"|>keyword<|\" in the template file is replaced with it's
+associated value. It is possible to specify string, function, variable
+and lambda expression as 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-ff-alist
+ '((\"name\" . \"HOGE Hoge\")
+ (\"email\" . \"foo at example.com\")
+ (\"time\" .
+ (lambda () (format (format \"%%%ds\" fill-column)
+ (current-time-string))))
+ ))")
+
+(defvar mew-draft-guess-ff-alist nil
+ "*Alist to guess fixed from 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 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-ff-alist\".
+
+For example:
+
+ (setq mew-draft-guess-ff-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 with this form, putting it on the last.")
+
+(defun mew-draft-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-draft-guess-by-alist val)))))
+ (if ent (setq ret val))
+ (setq sublist (cdr sublist))))))
+ (setq alist (cdr alist)))
+ ret))
+
+(defun mew-draft-guess-and-modify-header ()
+ "Guess and modify header according to \"mew-draft-guess-header-alist\"."
+ (interactive)
+ (save-excursion
+ (let ((alist mew-draft-guess-header-alist)
+ header-gus sublist header-cnd glist value pos sep)
+ (while alist
+ (setq header-gus (car (car alist)))
+ (setq glist (mew-draft-guess-by-alist (cdr (car alist))))
+ (if glist
+ (progn
+ (setq value (car glist))
+ (setq pos (nth 1 glist))
+ (setq sep (nth 2 glist))
+ (if pos
+ (mew-header-append-value
+ header-gus value pos mew-draft-ask-when-guess-header sep)
+ (mew-header-replace-value
+ header-gus value mew-draft-ask-when-guess-header))))
+ (setq alist (cdr alist)))
+ (mew-draft-rehighlight))))
+
+(defun mew-draft-insert-ff ()
+ "Insert fixed form on the top of the message."
+ (interactive)
+ (let* ((glist (mew-draft-guess-by-alist mew-draft-guess-ff-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 fixed form template file %s" efile)
+ (progn
+ (forward-char
+ (mew-draft-insert-file-and-replace
+ efile 'top (list kwlist mew-draft-replace-ff-alist)))))))
))
;;
diff -ru mew-1.94b10.orig/mew-fib.el mew-1.94b10/mew-fib.el
--- mew-1.94b10.orig/mew-fib.el Fri Feb 26 19:08:17 1999
+++ mew-1.94b10/mew-fib.el Sun Feb 28 15:52:18 1999
@@ -66,6 +66,19 @@
(t str)))))
)))
+(defun mew-fib-insert-file-and-fill (file &optional alists)
+ "Insert FILE and fill |>item<| in it by ALISTS."
+ (interactive)
+ (let (bytes)
+ (save-restriction
+ (narrow-to-region
+ (point) (+ (point) (car (cdr (insert-file-contents file)))))
+ (while alists
+ (mew-fib-fill-by-alist (car alists))
+ (setq alists (cdr alists)))
+ (mew-fib-delete-frame)
+ (setq bytes (- (point-max) (point-min))))))
+
(defun mew-fib-fill-default ()
"Fill |>item<| from .mew-fib."
(interactive)
diff -ru mew-1.94b10.orig/mew-header.el mew-1.94b10/mew-header.el
--- mew-1.94b10.orig/mew-header.el Tue Feb 23 13:55:01 1999
+++ mew-1.94b10/mew-header.el Sun Feb 28 22:19:54 1999
@@ -134,6 +134,45 @@
(insert (concat "\n\t"name-val))))
(insert "\n"))))
+(defun mew-header-replace-value (field value ask)
+ "Replace header contents."
+ (interactive)
+ (let ((oldvalue (mew-header-get-value field)))
+ (if (and (not (string= oldvalue value))
+ (or (not ask)
+ (y-or-n-p
+ (format "Replace %s value with %s? "
+ field value))))
+ (progn
+ (mew-header-delete-lines (list field))
+ (if (not (mew-header-existp field))
+ (goto-char (mew-header-end)))
+ (mew-draft-header-insert field value)))))
+
+(defun mew-header-append-value (field value pos ask &optional sep)
+ "Append string to header contents.
+POS specifies the position to append VALUE. Possible values are
+bol (beginning of line) or eol (end of line). (only bol is
+recognized actually)
+
+Prompt user to confirm modification if ASK is non-nil. (prompt message
+may be not proper)
+
+Optional argument SEP (string) is inserted between VALUE and original
+contents of FIELD if necessary (both SEP is non-nil and original
+contents of FIELD is non-empty)."
+ (interactive)
+ (let ((oldvalue (mew-header-get-value field)) newvalue)
+ (if (and oldvalue sep)
+ (cond
+ ((equal pos 'bol)
+ (setq newvalue (concat value sep oldvalue)))
+ ;;((equal pos 'eol)
+ (t
+ (setq newvalue (concat oldvalue sep value))))
+ (setq newvalue (concat oldvalue value)))
+ (mew-header-replace-value field newvalue ask)))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Low-level functions to parse fields
-------------- next part --------------
;; sample.el
;;
;; 0. Prepare ~/.signature-sample and ~/.ff-sample.
;; 1. M-x eval-current-buffer in this buffer.
;; 2. Prepare draft and put `sample' on the To: field.
;; 3. Move cursor to the body, then try C-cC-h, C-cTAB and C-cC-v.
;; 4. Uncomment lines below, M-x eval-current-buffer, and try C-cC-h
;; again.
(setq mew-signature-guess-alist
'(("To:"
("sample" . "~/.signature-sample")
)
))
(setq mew-signature-replace-alist
'(("email" . "sample at example.com")
))
(setq mew-draft-guess-header-alist
'(("X-Sample:"
("To:"
;;("sample" "Sample string" eol "+ ")
("sample" "Sample string")
))
))
(setq mew-draft-guess-ff-alist
'(("To:"
("sample" "~/.ff-sample"
("time" . current-time-string)
))
))
(setq mew-draft-replace-ff-alist
'(("hello" . "hello,world.")
))
;;(setq mew-draft-ask-when-guess-header t)
-------------- next part --------------
--
|>email<|
-------------- next part --------------
|>time<|
|>hello<|
Mew-dist メーリングリストの案内