[Mew-dist 10092] Re: setting From: value based on case?
Shun-ichi GOTO --abc--
gotoh at example.com
1999年 8月 16日 (月) 16:12:04 JST
後藤＠太陽計測です
>>>>> at Mon, 16 Aug 1999 13:26:13 +0900
>>>>> 小幡 <obata at example.com> said,
小幡> たびたびヘッダ推測に関係しそうな話題が出るので、不完全ではありま
小幡> すが mew-guess.el を contrib したいと思います。ご参考にどうぞ。
小幡> (contrib/mew-ff.el は削除して下さい > かずさん)
小幡> ヘッダ推測とは、書いている最中のヘッダに基づき他のヘッダの内容を
小幡> その場で書き換える機能です。
これと同じ機能、偶然にも私も実装して使っていました。
私としても、
『IMにFrom:をつけさせるのではなくMewでつけて見たまま送信したい！』
クチなので。でも、小幡さんのものの方が、汎用性があるので、
私のコードは却下。(^^;
# 私のは推測元を config: 限定してましたので
## しかも、mew-ff も使っていたので、これに統一できるし。(^o^)
で、小幡さんのコードを使ってみまして、不満/要望とがあるので、
それをパッチにしてみました。
こんな設定とかして試してみました。
(setq mew-guess-header-alist
'(("From:"
("Config:"
("test" "後藤 俊一 <gotoh at example.com>"))
(t "Shun-ichi GOTO <gotoh at example.com>"))
("Dcc:"
("Config:"
("test" delete))) ; <== 削除される
("X-Foo:"
("config:" ("test" (lambda () (message "hello"))))) ; 関数もOK
))
それとは別に、
>>>>> at Mon, 16 Aug 1999 14:04:50 +0900, sen <sen at example.com> said,
sen> ＃ いまは:
sen> C-c C-m
sen> C-c C-c
sen> というのが脳に焼きついているので、「hook か何かで mew-guess の機能が使えたら
sen> いいな」と思っています。
という辺りは、私の場合、以下の設定で自動化しています。
(require 'advice)
(defadvice mew-draft-make-message (before replace-field activate)
(mew-guess-header))
(defadvice mew-draft-insert-config (after replace-field activate)
(mew-guess-header))
前者は C-c C-m の直前のタイミングで、後者はMew がconfig をguess した
直後のタイミングで実行されます。
特に後者に関してはあわせて 変数 mew-config-guess-alist,
mew-config-insert-when-prepared, mew-config-insert-when-composed も
設定するといいかも知れません。
でもって今回のパッチで行なったこと。
1. フィールドを削除できたい
置換文字列を書くべきところにシンボルdeleteを書くことで削除を意味する
ようにした。
2. 文字列だけでなく、関数や変数も使いたい(かも)
## ソースのコメント中に TODO となっていたので、やってみた。
3. 置換後の確認動作をしたい
変数を設けました。デフォルトはオリジナルの動作に合わせ、確認なし。
4. 存在するヘッダを書き換える場合は、位置を変更したくない。
... という動作になるように修正した。
というわけで、勝手ながらパッチを送らせていただきます。
以下 ChangeLog
1999-08-16 Shun-ichi GOTO <gotoh at example.com>
* mew-guess.el.diff (mew-guess-query-when-replaced): New variable
* mew-guess.el (mew-header-replace-value): Do query after replace
when mew-guess-query-when-replaced is non-nil.
If new value is function or variable, eval and use result.
If new value is symbol 'delete, that field will be deleted.
Keep position of header if already exist.
* mew-guess.el (mew-guess-by-alist): Allow symbol (function or
variable) and lambda expression instead of string to replace.
Note that function and lambda exp. should return string or nil
or 'delete. Variable should contains string or nil, too.
--- Regards,
Shun-ichi Goto <gotoh at example.com>
R&D Group, TAIYO Corp., Tokyo, JAPAN
-------------- next part --------------
--- mew-guess.el.orig Mon Aug 16 04:58:37 1999
+++ mew-guess.el Mon Aug 16 06:52:15 1999
@@ -1,4 +1,5 @@
;;; mew-guess.el --- Guess header and template file in draft for Mew
+From: Shun-ichi GOTO <gotoh at example.com>
;; Author: OBATA Noboru <obata at example.com>
;; Created: Mar 22, 1999
@@ -113,6 +114,10 @@ ;; (define-key mew-draft-body-map
;;; Code:
+
+(defvar mew-guess-query-when-replaced nil
+ "*If non-nil, make query to accept result of replacement.")
+
;; Guess
(defun mew-guess-by-alist (alist)
@@ -136,6 +141,9 @@ (defun mew-guess-by-alist (alist)
((stringp (car val))
(setq ent
(mew-refile-guess-by-alist2 key header (car val))))
+ ((or (functionp (car val))
+ (symbolp (car val)))
+ (setq ent (car val)))
((listp (car val))
(setq ent (mew-guess-by-alist val)))))
(if ent (setq ret val))
@@ -159,37 +167,66 @@ (defvar mew-guess-header-alist nil
(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)
+ (let ((alist mew-guess-header-alist)
+ header-gus sublist header-cnd glist undo changed)
+ (save-excursion
+ (mew-header-goto-end)
+ (setq undo (buffer-substring 1 (point)))
(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))))
+ (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)))
+ ;; compare with original
+ (mew-header-goto-end)
+ (setq changed (not (string= undo (buffer-substring 1 (point)))))
+ (if (not changed)
+ (if (interactive-p)
+ (message "Nothing changed")) ; nothing done
+ ;; something changed! query if need
+ (mew-highlight-header)
+ (if (or (not mew-guess-query-when-replaced)
+ (y-or-n-p "Headers are changed. Accept this? "))
+ (message "Some headers are changed") ; accepted
+ ;; restore original
+ (kill-region 1 (point))
+ (insert undo)
+ (mew-header-goto-end)
+ (mew-highlight-header)
+ (message "Changes are cacneled"))))))
+
(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)))))
+ (cond
+ ((eq value 'delete) nil) ; delete this line
+ ((fboundp value)
+ (funcall value)) ; use function result
+ ((and (boundp value)
+ (stringp (symbol-value value)))
+ (symbol-value value)) ; use value of variable
+ (t nil)))
+ ((functionp value) (funcall value))
+ (t nil)))
+ orgvalue)
+ (if (not (and (stringp field)
+ (or (null newvalue) (stringp newvalue))))
+ (error "Invalid field pair in mew-config-replace-alist")
+ (setq orgvalue (mew-header-get-value field))
+ (if (and orgvalue
+ newvalue
+ (string= (downcase newvalue) (downcase orgvalue)))
+ () ; same ... don't replace
+ (if orgvalue
+ (mew-header-delete-lines (list field))
+ (mew-header-goto-end))
+ (if newvalue
+ (insert field " " newvalue "\n"))))))
;; Template
Mew-dist メーリングリストの案内