1 ;;; mew-guess.el --- Guess header and template file in draft for Mew
3 ;; Author: OBATA Noboru <obata@nippon-control-system.co.jp>
4 ;; Created: Mar 22, 1999
5 ;; Revised: Aug 31, 1999
9 ;; Shun-ichi GOTO <gotoh@taiyo.co.jp>
\e$B$5$s$K46<U$7$^$9!#
\e(B
11 ;;
\e$B$3$N%Q%C%1!<%8$O!"%I%i%U%H%b!<%I$K$*$$$F!"4{B8$N%X%C%@$NFbMF$+$i!"B>
\e(B
12 ;;
\e$B$N%X%C%@$NFbMF$r?dB,$7$F=q$-49$($k5!G=$rDs6!$7$^$9!#Nc$($P!"
\e(BTo:
\e$B%X%C
\e(B
13 ;;
\e$B%@$+$i
\e(B From:
\e$B$rJQ99$7$?$j!"
\e(BConfig:
\e$B$rA^F~$9$k$3$H$,$G$-$^$9!#
\e(B
15 ;;
\e$B$^$?!"$b$&$R$H$D$N5!G=$H$7$F!"J8F,$K%F%-%9%H%U%!%$%k
\e(B (
\e$B%F%s%W%l!<%H
\e(B)
16 ;;
\e$B$rA^F~$9$k$3$H$,$G$-$^$9!#A^F~$9$k%U%!%$%kL>$b!"%X%C%@$+$i?dB,$5$;$k
\e(B
17 ;;
\e$B$3$H$,$G$-$^$9!#
\e(B
19 ;;
\e$B%$%s%9%H!<%k$NJ}K!!#
\e(B
21 ;; -
\e$B$3$N%U%!%$%k$r
\e(B emacs
\e$B$,8+IU$1$i$l$k>l=j$KCV$-$^$9!#
\e(B
23 ;; - .emacs
\e$B$K<!$N5-=R$rDI2C$7$^$9!#
\e(B(define-key ...)
\e$B$O%-!<%P%$%s%I$NNc
\e(B
24 ;;
\e$B$G$9!#$*9%$_$K9g$o$;$FJQ$($F2<$5$$!#
\e(B
26 ;; (add-hook 'mew-init-hook
28 ;; (require 'mew-guess)
29 ;; (define-key mew-draft-header-map "\C-c\C-v" 'mew-guess-template)
30 ;; (define-key mew-draft-header-map "\C-c\C-d" 'mew-guess-header)
31 ;; (define-key mew-draft-body-map "\C-c\C-v" 'mew-guess-template)
32 ;; (define-key mew-draft-body-map "\C-c\C-d" 'mew-guess-header)))
36 ;; -
\e$B%X%C%@?dB,$NNc!#
\e(B
38 ;; (setq mew-guess-header-alist
41 ;; ;; From:
\e$B$N?dB,$N%k!<%k
\e(B
43 ;; ;; To:
\e$B$NFbMF$,!"
\e(B"sorry@"
\e$B$K%^%C%A$7$?$i!"
\e(BFrom:
\e$B$NFbMF$r
\e(B
44 ;; ;; "
\e$B>.H(
\e(B
\e$B>:
\e(B <obata@nippon-control-system.co.jp>"
\e$B$K=q$-
\e(B
45 ;; ;;
\e$B49$($^$9!#
\e(B
46 ;; ("sorry@" "
\e$B>.H(
\e(B
\e$B>:
\e(B <obata@nippon-control-system.co.jp>")
47 ;; ;;
\e$BF1MM$K!"
\e(BTo:
\e$B$NFbMF$,
\e(B "@linux\\.or\\.jp"
\e$B$K%^%C%A$7$?
\e(B
48 ;; ;;
\e$B$i!"
\e(BFrom:
\e$B$r
\e(B "OBATA Noboru <obata@hh.iij4u.or.jp>"
\e$B$K
\e(B
49 ;; ;;
\e$B=q$-49$($^$9!#
\e(B
50 ;; ("@linux\\.or\\.jp" "OBATA Noboru <obata@hh.iij4u.or.jp>")
53 ;; ;; Config:
\e$B$NFbMF$K$h$C$F=q$-49$($?$$>l9g!#
\e(B
54 ;; ("office" "OBATA Noboru <obata@nippon-control-system.co.jp>"))
55 ;; ;;
\e$B<!$NFCJL$J5-K!$K$h$C$F!"%G%U%)%k%HCM$r;XDj$7$^$9!#
\e(B
56 ;; (t "OBATA Noboru <obata@nippon-control-system.co.jp>"))
59 ;;
\e$BCV498e$NJ8;zNs$H$7$F!"CM$H$7$FJ8;zNs$r;}$DJQ?tL>$d!"J8;zNs$rJV$94X?t
\e(B
60 ;;
\e$BL>$d%i%`%@<0$r5-=R$G$-$^$9!#Nc$($P!"<!$N$h$&$K=q$1$P
\e(B Config:
\e$B$K
\e(B
61 ;; mew-config-imget
\e$B$NCM$r@_Dj$G$-$^$9!#
\e(B
63 ;; (setq mew-guess-header-alist
66 ;; (t mew-config-imget)
70 ;; -
\e$B%F%s%W%l!<%H?dB,$NNc!#
\e(B
72 ;; (setq mew-guess-template-alist
74 ;; ;; To:
\e$B$NFbMF$,
\e(B "foo"
\e$B$K%^%C%A$7$?$i!"J8F,$K%U%!%$%k
\e(B
75 ;; ;; "~/.ff-foo"
\e$B$rA^F~$7$^$9!#
\e(B
76 ;; ("foo" "~/.ff-foo")
78 ;; ("bar" "~/.ff-bar")
82 ;; -
\e$B%-!<%o!<%ICV49$NNc!#>e$NJ}K!$G$O!"?dB,$N%k!<%k$@$1%U%!%$%k$r:n$i$J
\e(B
83 ;;
\e$B$/$F$O$$$1$J$$$N$G!"LLE]$G$9!#%F%s%W%l!<%H%U%!%$%k$K
\e(B |>keyword<|
\e$B$N
\e(B
84 ;;
\e$B=q<0$G%-!<%o!<%I$rKd$a9~$_!"$=$N%-!<%o!<%I$NCV49$r;XDj$9$k$3$H$,$G$-
\e(B
87 ;; (setq mew-guess-template-alist
89 ;; ;; To:
\e$B$NFbMF$,
\e(B "foo"
\e$B$K%^%C%A$7$?$i!"J8F,$K%U%!%$%k
\e(B
90 ;; ;; "~/.ff-foo"
\e$B$rA^F~$7$^$9!#$=$N$H$-!"%U%!%$%kFb$N%-!<%o!<
\e(B
91 ;; ;;
\e$B%I
\e(B |>me<|
\e$B$r!"
\e(B"
\e$B$U!<
\e(B" (
\e$B%@%V%k%/%)!<%F!<%7%g%s$O$J$7
\e(B)
\e$B$K
\e(B
92 ;; ;;
\e$BCV$-49$($^$9!#
\e(B
93 ;; ("foo" "~/.ff-foo" ("me" . "
\e$B$U!<
\e(B"))
95 ;; ("bar" "~/.ff-foo" ("me" . "
\e$B$P!<
\e(B"))
97 ;; ;;
\e$B%G%U%)%k%H
\e(B
101 ;;
\e$B$=$N:]!"%-!<%o!<%ICV49$N4{DjCM$r!"<!$N$h$&$K5-=R$9$k$3$H$,$G$-$^$9!#
\e(B
102 ;;
\e$BCV498e$NJ8;zNs$H$7$F!"JQ?tL>!"4X?tL>!"%i%`%@<0$r5-=R$G$-$^$9!#
\e(B
104 ;; (setq mew-draft-replace-alist
105 ;; '(("me" . "
\e$B>.H(
\e(B")
106 ;; ("email" . mew-mail-address)
107 ;; ("time" . (lambda () (current-time-string)))
108 ;; ;; ("time" . current-time-string)
\e$B$b
\e(B OK
114 (defvar mew-guess-query-when-replaced nil
115 "*If non-nil, make query to accept result of replacement.")
119 (defun mew-guess-by-alist (alist)
120 (let (name header sublist key val ent ret)
121 (while (and alist (not ret))
122 (setq name (car (car alist)))
123 (setq sublist (cdr (car alist)))
128 ;;(setq ret sublist))
130 (setq header (mew-header-get-value name))
132 (while (and sublist (not ret))
133 (setq key (car (car sublist)))
134 (setq val (cdr (car sublist)))
135 (if (and (stringp key) (string-match key header))
139 (mew-refile-guess-by-alist2 key header (car val))))
140 ((or (functionp (car val))
142 (setq ent (car val)))
144 (setq ent (mew-guess-by-alist val)))))
145 (if ent (setq ret val))
146 (setq sublist (cdr sublist))))))
147 (setq alist (cdr alist)))
152 (defvar mew-guess-header-alist nil
153 "*Alist to guess header contents.
156 (HEADER-GUS (HEADER-CND (KEY VALUE)... )... )...
158 HEADER-GUS is the target header which you want to guess and modify.
160 HEADER-CND and KEY specify the condition to guess. If regexp KEY matches
161 to contents of HEADER-CND, contents are replaced with string VALUE.")
163 (defun mew-guess-header ()
164 "Guess and modify header according to \"mew-guess-header-alist\"."
166 (let ((alist mew-guess-header-alist)
167 header-gus sublist header-cnd glist undo changed)
169 (mew-header-goto-end)
170 (setq undo (buffer-substring 1 (point)))
172 (setq header-gus (car (car alist)))
173 (setq glist (mew-guess-by-alist (cdr (car alist))))
175 (mew-header-replace-value header-gus (car glist)))
176 (setq alist (cdr alist)))
177 ;; compare with original
178 (mew-header-goto-end)
179 (setq changed (not (string= undo (buffer-substring 1 (point)))))
182 (message "Nothing changed")) ; nothing done
183 ;; something changed! query if need
184 (mew-highlight-header)
185 (mew-draft-header-keymap)
186 (if (or (not mew-guess-query-when-replaced)
187 (y-or-n-p "Headers are changed. Accept this? "))
188 (message "Some headers are changed") ; accepted
190 (kill-region 1 (point))
192 (mew-header-goto-end)
193 (mew-highlight-header)
194 (mew-draft-header-keymap)
195 (message "Changes are canceled"))))))
198 (defun mew-header-replace-value (field value)
199 "Replace header contents."
201 (let ((newvalue (cond
202 ((stringp value) value)
205 ((eq value 'delete) nil) ; delete this line
207 (funcall value)) ; use function result
209 (stringp (symbol-value value)))
210 (symbol-value value)) ; use value of variable
212 ((functionp value) (funcall value))
215 (if (not (and (stringp field)
216 (or (null newvalue) (stringp newvalue))))
217 (error "Invalid field pair in mew-header-replace-alist")
218 (setq orgvalue (mew-header-get-value field))
221 (string= (downcase newvalue) (downcase orgvalue)))
222 () ; same ... don't replace
224 (mew-header-delete-lines (list field))
225 (mew-header-goto-end))
227 (insert field " " newvalue "\n"))))))
231 (defvar mew-guess-template-alist nil
232 "*Alist to guess template file.
235 (HEADER (KEY TEMPLATE)... )...
237 If regexp KEY matches to contents of HEADER, file TEMPLATE is guessed
238 and guess is finished. Note that there is no dot (.) between KEY and
241 You can specify alists for keyword replacement like:
243 (HEADER (KEY TEMPLATE (REPLACE-FROM . REPLACE-TO)... )... )...
245 Alists in this form take precedence over \"mew-draft-replace-alist\".
249 (setq mew-guess-template-alist
251 (\"mew-dist@mew.org\" \"~/.ff-mew-dist\"
252 (\"hello\" . \"Mew friends,\")))
253 (\"foo@hoge.hoge\" \"~/.ff-other\")
254 (t \"~/.ff-default\")
257 There is exceptional form as you can see in the example:
259 (t TEMPLATE [(REPLACE-FROM . REPLACE-TO)...])
261 You can specify default TEMPLATE in this form, putting it on the last.")
263 (defun mew-guess-template ()
264 "Insert template file on the top of the draft message."
266 (let* ((glist (mew-guess-by-alist mew-guess-template-alist))
267 (file (car glist)) (kwlist (cdr glist)) deleted efile)
270 (setq efile (expand-file-name file))
271 (if (not (file-exists-p efile))
272 (message "No template file %s" efile)
275 (mew-draft-insert-file-and-replace
276 efile 'top (list kwlist mew-draft-replace-alist)))))))))
280 (defvar mew-draft-replace-alist nil
281 "*Alist for keyword replacement in draft.
282 Keywords \"|>keyword<|\" in the template file and signature file (not
283 yet) are replaced with it's associated value. It is possible to specify
284 string, function, variable and lambda expression as the associated
285 value, which is evaluated when replacement occurs.
287 You can replace keyword to the string flushed on the right. For example:
289 (setq mew-draft-replace-alist
290 '((\"name\" . \"HOGE Hoge\")
291 (\"email\" . \"foo@hoge.hoge\")
293 (lambda () (format (format \"%%%ds\" fill-column)
294 (current-time-string))))
297 (defun mew-draft-insert-file-and-replace (file pos &optional alists)
298 "Insert file and replace keyword.
299 Insert file FILE on position POS (possible values are top, bottom and
300 here), and replace keyword according to ALISTS (list of alist)."
304 (goto-char (mew-header-end))
307 (if (null (mew-attach-p))
308 (goto-char (point-max))
309 (goto-char (mew-attach-begin))
316 (point) (+ (point) (car (cdr (insert-file-contents file)))))
318 (mew-draft-replace-by-alist (car alists))
319 (setq alists (cdr alists)))
320 (mew-fib-delete-frame)
321 (setq bytes (- (point-max) (point-min))))))
323 (defun mew-draft-replace-by-alist (alist)
324 "Fill |>item<| by alist."
328 (goto-char (point-min))
329 (while (re-search-forward "|>\\([^<]+\\)<|" nil t)
330 (setq begin (match-beginning 1)
332 str (buffer-substring begin end))
333 (delete-region begin end)
335 (insert (let ((obj (cdr (assoc (downcase str) alist))))
339 ((functionp obj) (funcall obj))
341 (if (fboundp obj) (funcall obj)
342 (if (and (boundp obj)
343 (stringp (symbol-value obj)))
344 (symbol-value obj))))
349 ;;; mew-guess.el ends here