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