|
74
|
1 ;;; tm-ew-e.el --- RFC 2047 based encoded-word encoder for GNU Emacs
|
|
4
|
2
|
|
98
|
3 ;; Copyright (C) 1995,1996,1997 Free Software Foundation, Inc.
|
|
4
|
4
|
|
|
5 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
|
|
167
|
6 ;; Version: $Revision: 1.5 $
|
|
74
|
7 ;; Keywords: encoded-word, MIME, multilingual, header, mail, news
|
|
4
|
8
|
|
|
9 ;; This file is part of tm (Tools for MIME).
|
|
|
10
|
|
|
11 ;; This program is free software; you can redistribute it and/or
|
|
|
12 ;; modify it under the terms of the GNU General Public License as
|
|
|
13 ;; published by the Free Software Foundation; either version 2, or (at
|
|
|
14 ;; your option) any later version.
|
|
|
15
|
|
|
16 ;; This program is distributed in the hope that it will be useful, but
|
|
|
17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
|
19 ;; General Public License for more details.
|
|
|
20
|
|
|
21 ;; You should have received a copy of the GNU General Public License
|
|
|
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
|
|
|
23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
|
24 ;; Boston, MA 02111-1307, USA.
|
|
|
25
|
|
|
26 ;;; Code:
|
|
|
27
|
|
|
28 (require 'mel)
|
|
|
29 (require 'std11)
|
|
|
30 (require 'tm-def)
|
|
|
31 (require 'tl-list)
|
|
|
32
|
|
|
33
|
|
|
34 ;;; @ version
|
|
|
35 ;;;
|
|
|
36
|
|
|
37 (defconst tm-ew-e/RCS-ID
|
|
167
|
38 "$Id: tm-ew-e.el,v 1.5 1997/06/29 23:13:28 steve Exp $")
|
|
4
|
39 (defconst mime-eword/encoder-version (get-version-string tm-ew-e/RCS-ID))
|
|
|
40
|
|
|
41
|
|
|
42 ;;; @ variables
|
|
|
43 ;;;
|
|
|
44
|
|
|
45 (defvar mime/field-encoding-method-alist
|
|
|
46 (if (boundp 'mime/no-encoding-header-fields)
|
|
|
47 (nconc
|
|
|
48 (mapcar (function
|
|
|
49 (lambda (field-name)
|
|
|
50 (cons field-name 'default-mime-charset)
|
|
|
51 ))
|
|
|
52 mime/no-encoding-header-fields)
|
|
|
53 '((t . mime))
|
|
|
54 )
|
|
|
55 '(("X-Nsubject" . iso-2022-jp-2)
|
|
|
56 ("Newsgroups" . nil)
|
|
167
|
57 ("Message-ID" . nil)
|
|
4
|
58 (t . mime)
|
|
|
59 ))
|
|
|
60 "*Alist to specify field encoding method.
|
|
|
61 Its key is field-name, value is encoding method.
|
|
|
62
|
|
|
63 If method is `mime', this field will be encoded into MIME format.
|
|
|
64
|
|
|
65 If method is a MIME-charset, this field will be encoded as the charset
|
|
|
66 when it must be convert into network-code.
|
|
|
67
|
|
|
68 If method is `default-mime-charset', this field will be encoded as
|
|
|
69 variable `default-mime-charset' when it must be convert into
|
|
|
70 network-code.
|
|
|
71
|
|
|
72 If method is nil, this field will not be encoded. [tm-ew-e.el]")
|
|
|
73
|
|
|
74 (defvar mime/generate-X-Nsubject
|
|
|
75 (and (boundp 'mime/use-X-Nsubject)
|
|
|
76 mime/use-X-Nsubject)
|
|
|
77 "*If it is not nil, X-Nsubject field is generated
|
|
|
78 when Subject field is encoded by `mime/encode-message-header'.
|
|
|
79 \[tm-ew-e.el]")
|
|
|
80
|
|
|
81 (defvar mime-eword/charset-encoding-alist
|
|
|
82 '((us-ascii . nil)
|
|
|
83 (iso-8859-1 . "Q")
|
|
|
84 (iso-8859-2 . "Q")
|
|
|
85 (iso-8859-3 . "Q")
|
|
|
86 (iso-8859-4 . "Q")
|
|
|
87 (iso-8859-5 . "Q")
|
|
|
88 (koi8-r . "Q")
|
|
|
89 (iso-8859-7 . "Q")
|
|
|
90 (iso-8859-8 . "Q")
|
|
|
91 (iso-8859-9 . "Q")
|
|
|
92 (iso-2022-jp . "B")
|
|
|
93 (iso-2022-kr . "B")
|
|
74
|
94 (gb2312 . "B")
|
|
|
95 (cn-gb . "B")
|
|
|
96 (cn-gb-2312 . "B")
|
|
4
|
97 (euc-kr . "B")
|
|
|
98 (iso-2022-jp-2 . "B")
|
|
|
99 (iso-2022-int-1 . "B")
|
|
|
100 ))
|
|
|
101
|
|
74
|
102
|
|
4
|
103 ;;; @ encoded-text encoder
|
|
|
104 ;;;
|
|
|
105
|
|
|
106 (defun tm-eword::encode-encoded-text (charset encoding string &optional mode)
|
|
|
107 (let ((text
|
|
|
108 (cond ((string= encoding "B")
|
|
|
109 (base64-encode-string string))
|
|
|
110 ((string= encoding "Q")
|
|
|
111 (q-encoding-encode-string string mode))
|
|
|
112 )
|
|
|
113 ))
|
|
|
114 (if text
|
|
|
115 (concat "=?" (upcase (symbol-name charset)) "?"
|
|
|
116 encoding "?" text "?=")
|
|
|
117 )))
|
|
|
118
|
|
|
119
|
|
|
120 ;;; @ leading char
|
|
|
121 ;;;
|
|
|
122
|
|
|
123 (defun tm-eword::char-type (chr)
|
|
159
|
124 (if (or (= chr ? )(= chr ?\t))
|
|
4
|
125 nil
|
|
|
126 (char-charset chr)
|
|
|
127 ))
|
|
|
128
|
|
|
129 (defun tm-eword::parse-lc-word (str)
|
|
|
130 (let* ((chr (sref str 0))
|
|
|
131 (lc (tm-eword::char-type chr))
|
|
|
132 (i (char-length chr))
|
|
|
133 (len (length str))
|
|
|
134 )
|
|
|
135 (while (and (< i len)
|
|
|
136 (setq chr (sref str i))
|
|
|
137 (eq lc (tm-eword::char-type chr))
|
|
|
138 )
|
|
|
139 (setq i (+ i (char-length chr)))
|
|
|
140 )
|
|
|
141 (cons (cons lc (substring str 0 i)) (substring str i))
|
|
|
142 ))
|
|
|
143
|
|
|
144 (defun tm-eword::split-to-lc-words (str)
|
|
|
145 (let (ret dest)
|
|
|
146 (while (and (not (string= str ""))
|
|
|
147 (setq ret (tm-eword::parse-lc-word str))
|
|
|
148 )
|
|
|
149 (setq dest (cons (car ret) dest))
|
|
|
150 (setq str (cdr ret))
|
|
|
151 )
|
|
|
152 (reverse dest)
|
|
|
153 ))
|
|
|
154
|
|
|
155
|
|
|
156 ;;; @ word
|
|
|
157 ;;;
|
|
|
158
|
|
|
159 (defun tm-eword::parse-word (lcwl)
|
|
|
160 (let* ((lcw (car lcwl))
|
|
|
161 (lc (car lcw))
|
|
|
162 )
|
|
|
163 (if (null lc)
|
|
|
164 lcwl
|
|
|
165 (let ((lcl (list lc))
|
|
|
166 (str (cdr lcw))
|
|
|
167 )
|
|
|
168 (catch 'tag
|
|
|
169 (while (setq lcwl (cdr lcwl))
|
|
|
170 (setq lcw (car lcwl))
|
|
|
171 (setq lc (car lcw))
|
|
|
172 (if (null lc)
|
|
|
173 (throw 'tag nil)
|
|
|
174 )
|
|
|
175 (if (not (memq lc lcl))
|
|
|
176 (setq lcl (cons lc lcl))
|
|
|
177 )
|
|
|
178 (setq str (concat str (cdr lcw)))
|
|
|
179 ))
|
|
|
180 (cons (cons lcl str) lcwl)
|
|
|
181 ))))
|
|
|
182
|
|
|
183 (defun tm-eword::lc-words-to-words (lcwl)
|
|
|
184 (let (ret dest)
|
|
|
185 (while (setq ret (tm-eword::parse-word lcwl))
|
|
|
186 (setq dest (cons (car ret) dest))
|
|
|
187 (setq lcwl (cdr ret))
|
|
|
188 )
|
|
|
189 (reverse dest)
|
|
|
190 ))
|
|
|
191
|
|
|
192
|
|
|
193 ;;; @ rule
|
|
|
194 ;;;
|
|
|
195
|
|
|
196 (defmacro tm-eword::make-rword (text charset encoding type)
|
|
|
197 (` (list (, text)(, charset)(, encoding)(, type))))
|
|
|
198 (defmacro tm-eword::rword-text (rword)
|
|
|
199 (` (car (, rword))))
|
|
|
200 (defmacro tm-eword::rword-charset (rword)
|
|
|
201 (` (car (cdr (, rword)))))
|
|
|
202 (defmacro tm-eword::rword-encoding (rword)
|
|
|
203 (` (car (cdr (cdr (, rword))))))
|
|
|
204 (defmacro tm-eword::rword-type (rword)
|
|
|
205 (` (car (cdr (cdr (cdr (, rword)))))))
|
|
|
206
|
|
|
207 (defun tm-eword::find-charset-rule (charsets)
|
|
|
208 (if charsets
|
|
|
209 (let* ((charset (charsets-to-mime-charset charsets))
|
|
|
210 (encoding (cdr (assq charset mime-eword/charset-encoding-alist)))
|
|
|
211 )
|
|
|
212 (list charset encoding)
|
|
|
213 )))
|
|
|
214
|
|
|
215 (defun tm-eword::words-to-ruled-words (wl &optional mode)
|
|
|
216 (mapcar (function
|
|
|
217 (lambda (word)
|
|
|
218 (let ((ret (tm-eword::find-charset-rule (car word))))
|
|
|
219 (tm-eword::make-rword (cdr word) (car ret)(nth 1 ret) mode)
|
|
|
220 )))
|
|
|
221 wl))
|
|
|
222
|
|
|
223 (defun tm-eword::space-process (seq)
|
|
|
224 (let (prev a ac b c cc)
|
|
|
225 (while seq
|
|
|
226 (setq b (car seq))
|
|
|
227 (setq seq (cdr seq))
|
|
|
228 (setq c (car seq))
|
|
|
229 (setq cc (tm-eword::rword-charset c))
|
|
|
230 (if (null (tm-eword::rword-charset b))
|
|
|
231 (progn
|
|
|
232 (setq a (car prev))
|
|
|
233 (setq ac (tm-eword::rword-charset a))
|
|
|
234 (if (and (tm-eword::rword-encoding a)
|
|
|
235 (tm-eword::rword-encoding c))
|
|
|
236 (cond ((eq ac cc)
|
|
|
237 (setq prev (cons
|
|
|
238 (cons (concat (car a)(car b)(car c))
|
|
|
239 (cdr a))
|
|
|
240 (cdr prev)
|
|
|
241 ))
|
|
|
242 (setq seq (cdr seq))
|
|
|
243 )
|
|
|
244 (t
|
|
|
245 (setq prev (cons
|
|
|
246 (cons (concat (car a)(car b))
|
|
|
247 (cdr a))
|
|
|
248 (cdr prev)
|
|
|
249 ))
|
|
|
250 ))
|
|
|
251 (setq prev (cons b prev))
|
|
|
252 ))
|
|
|
253 (setq prev (cons b prev))
|
|
|
254 ))
|
|
|
255 (reverse prev)
|
|
|
256 ))
|
|
|
257
|
|
|
258 (defun tm-eword::split-string (str &optional mode)
|
|
|
259 (tm-eword::space-process
|
|
|
260 (tm-eword::words-to-ruled-words (tm-eword::lc-words-to-words
|
|
|
261 (tm-eword::split-to-lc-words str))
|
|
|
262 mode)))
|
|
|
263
|
|
|
264
|
|
|
265 ;;; @ length
|
|
|
266 ;;;
|
|
|
267
|
|
|
268 (defun tm-eword::encoded-word-length (rword)
|
|
|
269 (let ((string (tm-eword::rword-text rword))
|
|
|
270 (charset (tm-eword::rword-charset rword))
|
|
|
271 (encoding (tm-eword::rword-encoding rword))
|
|
|
272 ret)
|
|
|
273 (setq ret
|
|
|
274 (cond ((string-equal encoding "B")
|
|
|
275 (setq string (encode-mime-charset-string string charset))
|
|
|
276 (base64-encoded-length string)
|
|
|
277 )
|
|
|
278 ((string-equal encoding "Q")
|
|
|
279 (setq string (encode-mime-charset-string string charset))
|
|
|
280 (q-encoding-encoded-length string
|
|
|
281 (tm-eword::rword-type rword))
|
|
|
282 )))
|
|
|
283 (if ret
|
|
|
284 (cons (+ 7 (length (symbol-name charset)) ret) string)
|
|
|
285 )))
|
|
|
286
|
|
|
287
|
|
|
288 ;;; @ encode-string
|
|
|
289 ;;;
|
|
|
290
|
|
|
291 (defun tm-eword::encode-string-1 (column rwl)
|
|
|
292 (let* ((rword (car rwl))
|
|
|
293 (ret (tm-eword::encoded-word-length rword))
|
|
|
294 string len)
|
|
|
295 (if (null ret)
|
|
|
296 (cond ((and (setq string (car rword))
|
|
167
|
297 (or (<= (setq len (+ (length string) column)) 76)
|
|
|
298 (<= column 1))
|
|
4
|
299 )
|
|
|
300 (setq rwl (cdr rwl))
|
|
|
301 )
|
|
|
302 (t
|
|
|
303 (setq string "\n ")
|
|
|
304 (setq len 1)
|
|
|
305 ))
|
|
|
306 (cond ((and (setq len (car ret))
|
|
|
307 (<= (+ column len) 76)
|
|
|
308 )
|
|
|
309 (setq string
|
|
|
310 (tm-eword::encode-encoded-text
|
|
|
311 (tm-eword::rword-charset rword)
|
|
|
312 (tm-eword::rword-encoding rword)
|
|
|
313 (cdr ret)
|
|
|
314 (tm-eword::rword-type rword)
|
|
|
315 ))
|
|
|
316 (setq len (+ (length string) column))
|
|
|
317 (setq rwl (cdr rwl))
|
|
|
318 )
|
|
|
319 (t
|
|
|
320 (setq string (car rword))
|
|
98
|
321 (let* ((p 0) np
|
|
4
|
322 (str "") nstr)
|
|
|
323 (while (and (< p len)
|
|
|
324 (progn
|
|
|
325 (setq np (+ p (char-length (sref string p))))
|
|
|
326 (setq nstr (substring string 0 np))
|
|
|
327 (setq ret (tm-eword::encoded-word-length
|
|
|
328 (cons nstr (cdr rword))
|
|
|
329 ))
|
|
|
330 (setq nstr (cdr ret))
|
|
|
331 (setq len (+ (car ret) column))
|
|
|
332 (<= len 76)
|
|
|
333 ))
|
|
|
334 (setq str nstr
|
|
|
335 p np))
|
|
|
336 (if (string-equal str "")
|
|
|
337 (setq string "\n "
|
|
|
338 len 1)
|
|
|
339 (setq rwl (cons (cons (substring string p) (cdr rword))
|
|
|
340 (cdr rwl)))
|
|
|
341 (setq string
|
|
|
342 (tm-eword::encode-encoded-text
|
|
|
343 (tm-eword::rword-charset rword)
|
|
|
344 (tm-eword::rword-encoding rword)
|
|
|
345 str
|
|
|
346 (tm-eword::rword-type rword)))
|
|
|
347 (setq len (+ (length string) column))
|
|
|
348 )
|
|
|
349 )))
|
|
|
350 )
|
|
|
351 (list string len rwl)
|
|
|
352 ))
|
|
|
353
|
|
|
354 (defun tm-eword::encode-rwl (column rwl)
|
|
|
355 (let (ret dest ps special str ew-f pew-f)
|
|
|
356 (while rwl
|
|
|
357 (setq ew-f (nth 2 (car rwl)))
|
|
|
358 (if (and pew-f ew-f)
|
|
|
359 (setq rwl (cons '(" ") rwl)
|
|
|
360 pew-f nil)
|
|
|
361 (setq pew-f ew-f)
|
|
|
362 )
|
|
|
363 (setq ret (tm-eword::encode-string-1 column rwl))
|
|
|
364 (setq str (car ret))
|
|
|
365 (if (eq (elt str 0) ?\n)
|
|
|
366 (if (eq special ?\()
|
|
|
367 (progn
|
|
|
368 (setq dest (concat dest "\n ("))
|
|
|
369 (setq ret (tm-eword::encode-string-1 2 rwl))
|
|
|
370 (setq str (car ret))
|
|
|
371 ))
|
|
159
|
372 (cond ((eq special ? )
|
|
4
|
373 (if (string= str "(")
|
|
|
374 (setq ps t)
|
|
|
375 (setq dest (concat dest " "))
|
|
|
376 (setq ps nil)
|
|
|
377 ))
|
|
|
378 ((eq special ?\()
|
|
|
379 (if ps
|
|
|
380 (progn
|
|
|
381 (setq dest (concat dest " ("))
|
|
|
382 (setq ps nil)
|
|
|
383 )
|
|
|
384 (setq dest (concat dest "("))
|
|
|
385 )
|
|
|
386 )))
|
|
|
387 (cond ((string= str " ")
|
|
159
|
388 (setq special ? )
|
|
4
|
389 )
|
|
|
390 ((string= str "(")
|
|
|
391 (setq special ?\()
|
|
|
392 )
|
|
|
393 (t
|
|
|
394 (setq special nil)
|
|
|
395 (setq dest (concat dest str))
|
|
|
396 ))
|
|
|
397 (setq column (nth 1 ret)
|
|
|
398 rwl (nth 2 ret))
|
|
|
399 )
|
|
|
400 (list dest column)
|
|
|
401 ))
|
|
|
402
|
|
|
403 (defun tm-eword::encode-string (column str &optional mode)
|
|
|
404 (tm-eword::encode-rwl column (tm-eword::split-string str mode))
|
|
|
405 )
|
|
|
406
|
|
|
407
|
|
|
408 ;;; @ converter
|
|
|
409 ;;;
|
|
|
410
|
|
|
411 (defun tm-eword::phrase-to-rwl (phrase)
|
|
|
412 (let (token type dest str)
|
|
|
413 (while phrase
|
|
|
414 (setq token (car phrase))
|
|
|
415 (setq type (car token))
|
|
|
416 (cond ((eq type 'quoted-string)
|
|
|
417 (setq str (concat "\"" (cdr token) "\""))
|
|
|
418 (setq dest
|
|
|
419 (append dest
|
|
|
420 (list
|
|
|
421 (let ((ret (tm-eword::find-charset-rule
|
|
|
422 (find-non-ascii-charset-string str))))
|
|
|
423 (tm-eword::make-rword
|
|
|
424 str (car ret)(nth 1 ret) 'phrase)
|
|
|
425 )
|
|
|
426 )))
|
|
|
427 )
|
|
|
428 ((eq type 'comment)
|
|
|
429 (setq dest
|
|
|
430 (append dest
|
|
|
431 '(("(" nil nil))
|
|
|
432 (tm-eword::words-to-ruled-words
|
|
|
433 (tm-eword::lc-words-to-words
|
|
|
434 (tm-eword::split-to-lc-words (cdr token)))
|
|
|
435 'comment)
|
|
|
436 '((")" nil nil))
|
|
|
437 ))
|
|
|
438 )
|
|
|
439 (t
|
|
|
440 (setq dest (append dest
|
|
|
441 (tm-eword::words-to-ruled-words
|
|
|
442 (tm-eword::lc-words-to-words
|
|
|
443 (tm-eword::split-to-lc-words (cdr token))
|
|
|
444 ) 'phrase)))
|
|
|
445 ))
|
|
|
446 (setq phrase (cdr phrase))
|
|
|
447 )
|
|
|
448 (tm-eword::space-process dest)
|
|
|
449 ))
|
|
|
450
|
|
|
451 (defun tm-eword::phrase-route-addr-to-rwl (phrase-route-addr)
|
|
|
452 (if (eq (car phrase-route-addr) 'phrase-route-addr)
|
|
|
453 (let ((phrase (nth 1 phrase-route-addr))
|
|
|
454 (route (nth 2 phrase-route-addr))
|
|
|
455 dest)
|
|
|
456 (if (eq (car (car phrase)) 'spaces)
|
|
|
457 (setq phrase (cdr phrase))
|
|
|
458 )
|
|
|
459 (setq dest (tm-eword::phrase-to-rwl phrase))
|
|
|
460 (if dest
|
|
|
461 (setq dest (append dest '((" " nil nil))))
|
|
|
462 )
|
|
|
463 (append
|
|
|
464 dest
|
|
|
465 (list (list (concat "<" (std11-addr-to-string route) ">") nil nil))
|
|
|
466 ))))
|
|
|
467
|
|
|
468 (defun tm-eword::addr-spec-to-rwl (addr-spec)
|
|
|
469 (if (eq (car addr-spec) 'addr-spec)
|
|
|
470 (list (list (std11-addr-to-string (cdr addr-spec)) nil nil))
|
|
|
471 ))
|
|
|
472
|
|
|
473 (defun tm-eword::mailbox-to-rwl (mbox)
|
|
|
474 (let ((addr (nth 1 mbox))
|
|
|
475 (comment (nth 2 mbox))
|
|
|
476 dest)
|
|
|
477 (setq dest (or (tm-eword::phrase-route-addr-to-rwl addr)
|
|
|
478 (tm-eword::addr-spec-to-rwl addr)
|
|
|
479 ))
|
|
|
480 (if comment
|
|
|
481 (setq dest
|
|
|
482 (append dest
|
|
|
483 '((" " nil nil)
|
|
|
484 ("(" nil nil))
|
|
|
485 (tm-eword::split-string comment 'comment)
|
|
|
486 '((")" nil nil))
|
|
|
487 )))
|
|
|
488 dest))
|
|
|
489
|
|
|
490 (defun tm-eword::addresses-to-rwl (addresses)
|
|
|
491 (let ((dest (tm-eword::mailbox-to-rwl (car addresses))))
|
|
|
492 (if dest
|
|
|
493 (while (setq addresses (cdr addresses))
|
|
|
494 (setq dest (append dest
|
|
|
495 '(("," nil nil))
|
|
|
496 '((" " nil nil))
|
|
|
497 (tm-eword::mailbox-to-rwl (car addresses))
|
|
|
498 ))
|
|
|
499 ))
|
|
|
500 dest))
|
|
|
501
|
|
|
502 (defun tm-eword::encode-address-list (column str)
|
|
|
503 (tm-eword::encode-rwl
|
|
|
504 column
|
|
|
505 (tm-eword::addresses-to-rwl (std11-parse-addresses-string str))
|
|
|
506 ))
|
|
|
507
|
|
|
508
|
|
|
509 ;;; @ application interfaces
|
|
|
510 ;;;
|
|
|
511
|
|
|
512 (defun mime/encode-field (str)
|
|
|
513 (setq str (std11-unfold-string str))
|
|
|
514 (let ((ret (string-match std11-field-head-regexp str)))
|
|
|
515 (or (if ret
|
|
|
516 (let ((field-name (substring str 0 (1- (match-end 0))))
|
|
|
517 (field-body (eliminate-top-spaces
|
|
|
518 (substring str (match-end 0))))
|
|
|
519 fname)
|
|
|
520 (if (setq ret
|
|
|
521 (cond ((string-equal field-body "") "")
|
|
|
522 ((member (setq fname (downcase field-name))
|
|
|
523 '("reply-to" "from" "sender"
|
|
|
524 "resent-reply-to" "resent-from"
|
|
|
525 "resent-sender" "to" "resent-to"
|
|
|
526 "cc" "resent-cc"
|
|
|
527 "bcc" "resent-bcc" "dcc")
|
|
|
528 )
|
|
|
529 (car (tm-eword::encode-address-list
|
|
|
530 (+ (length field-name) 2) field-body))
|
|
|
531 )
|
|
|
532 (t
|
|
|
533 (car (tm-eword::encode-string
|
|
|
534 (+ (length field-name) 1)
|
|
|
535 field-body 'text))
|
|
|
536 ))
|
|
|
537 )
|
|
|
538 (concat field-name ": " ret)
|
|
|
539 )))
|
|
|
540 (car (tm-eword::encode-string 0 str))
|
|
|
541 )))
|
|
|
542
|
|
|
543 (defun mime/exist-encoded-word-in-subject ()
|
|
|
544 (let ((str (std11-field-body "Subject")))
|
|
|
545 (if (and str (string-match mime/encoded-word-regexp str))
|
|
|
546 str)))
|
|
|
547
|
|
|
548 (defun mime/encode-message-header (&optional code-conversion)
|
|
|
549 (interactive "*")
|
|
|
550 (save-excursion
|
|
|
551 (save-restriction
|
|
|
552 (std11-narrow-to-header mail-header-separator)
|
|
|
553 (goto-char (point-min))
|
|
|
554 (let ((default-cs (mime-charset-to-coding-system default-mime-charset))
|
|
|
555 beg end field-name)
|
|
|
556 (while (re-search-forward std11-field-head-regexp nil t)
|
|
|
557 (setq beg (match-beginning 0))
|
|
|
558 (setq field-name (buffer-substring beg (1- (match-end 0))))
|
|
|
559 (setq end (std11-field-end))
|
|
|
560 (and (find-non-ascii-charset-region beg end)
|
|
|
561 (let ((ret (or (ASSOC (downcase field-name)
|
|
|
562 mime/field-encoding-method-alist
|
|
|
563 :test (function
|
|
|
564 (lambda (str1 str2)
|
|
|
565 (and (stringp str2)
|
|
|
566 (string= str1
|
|
|
567 (downcase str2))
|
|
|
568 ))))
|
|
|
569 (assq t mime/field-encoding-method-alist)
|
|
|
570 )))
|
|
|
571 (if ret
|
|
|
572 (let ((method (cdr ret)))
|
|
|
573 (cond ((eq method 'mime)
|
|
|
574 (let ((field
|
|
|
575 (buffer-substring-no-properties beg end)
|
|
|
576 ))
|
|
|
577 (delete-region beg end)
|
|
|
578 (insert (mime/encode-field field))
|
|
|
579 ))
|
|
|
580 (code-conversion
|
|
|
581 (let ((cs
|
|
|
582 (or (mime-charset-to-coding-system
|
|
|
583 method)
|
|
|
584 default-cs)))
|
|
|
585 (encode-coding-region beg end cs)
|
|
|
586 )))
|
|
|
587 ))
|
|
|
588 ))
|
|
|
589 ))
|
|
|
590 (and mime/generate-X-Nsubject
|
|
|
591 (or (std11-field-body "X-Nsubject")
|
|
|
592 (let ((str (mime/exist-encoded-word-in-subject)))
|
|
|
593 (if str
|
|
|
594 (progn
|
|
|
595 (setq str
|
|
|
596 (mime-eword/decode-string
|
|
|
597 (std11-unfold-string str)))
|
|
|
598 (if code-conversion
|
|
|
599 (setq str
|
|
|
600 (encode-mime-charset-string
|
|
|
601 str
|
|
|
602 (or (cdr (ASSOC
|
|
|
603 "x-nsubject"
|
|
|
604 mime/field-encoding-method-alist
|
|
|
605 :test
|
|
|
606 (function
|
|
|
607 (lambda (str1 str2)
|
|
|
608 (and (stringp str2)
|
|
|
609 (string= str1
|
|
|
610 (downcase str2))
|
|
|
611 )))))
|
|
|
612 'iso-2022-jp-2)))
|
|
|
613 )
|
|
|
614 (insert (concat "\nX-Nsubject: " str))
|
|
|
615 )))))
|
|
|
616 )))
|
|
|
617
|
|
|
618 (defun mime-eword/encode-string (str &optional column mode)
|
|
|
619 (car (tm-eword::encode-rwl (or column 0) (tm-eword::split-string str mode)))
|
|
|
620 )
|
|
|
621
|
|
|
622
|
|
|
623 ;;; @ end
|
|
|
624 ;;;
|
|
|
625
|
|
|
626 (provide 'tm-ew-e)
|
|
|
627
|
|
|
628 ;;; tm-ew-e.el ends here
|
