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