10 (defvar ew-decode-field-cache-buf '())
11 (defvar ew-decode-field-cache-num 300)
13 (defun ew-decode-field (field-name field-body &optional eword-filter)
14 "Decode MIME RFC2047 encoded-words in a field.
15 FIELD-NAME is a name of the field such as \"To\", \"Subject\" etc. and
16 used to selecting syntax of body of the field and deciding first
17 column of body of the field.
18 FIELD-BODY is a body of the field.
20 If FIELD-BODY has multiple lines, each line is separated by CRLF as
21 pure network representation. Also if the result has multiple lines,
22 each line is separated by CRLF.
24 If EWORD-FILTER is non-nil, it should be closure. it is called for
25 each successful decoded encoded-word with decoded string as a
26 argument. The return value of EWORD-FILTER is used as decoding result
27 instead of its argument."
28 (let* ((key (ew-cons* field-name field-body eword-filter
29 (ew-dynamic-options)))
30 (tmp (assoc key ew-decode-field-cache-buf)))
34 (setq tmp (nthcdr ew-decode-field-cache-num
35 ew-decode-field-cache-buf))
38 (setcdr (cdr tmp) ew-decode-field-cache-buf)
39 (setq ew-decode-field-cache-buf (cdr tmp))
41 (setq ew-decode-field-cache-buf
43 ew-decode-field-cache-buf)))
44 (setcar (car ew-decode-field-cache-buf) key)
45 (setcdr (car ew-decode-field-cache-buf)
46 (ew-decode-field-no-cache
47 field-name field-body eword-filter))
48 (cdar ew-decode-field-cache-buf)))))
50 (defun ew-decode-field-no-cache (field-name field-body &optional eword-filter)
51 "No caching version of ew-decode-field."
52 (let ((tmp (assoc (downcase field-name) ew-decode-field-syntax-alist))
53 frag-anchor frag1 frag2 decode)
56 (setq tmp ew-decode-field-default-syntax))
57 (setq frag-anchor (funcall (car tmp) (1+ (length field-name)) field-body))
58 ;;(setq zzz frag-anchor)
59 (when (and (eq (car tmp) 'ew-scan-unibyte-unstructured)
60 ew-decode-sticked-encoded-word)
61 (ew-separate-eword (get frag-anchor 'next-frag)
65 (ew-mark (cdr tmp) frag-anchor))
66 (setq frag1 (get frag-anchor 'next-frag))
67 (while (not (eq frag1 frag-anchor))
68 (setq decode (get frag1 'decode))
69 (setq frag2 (get frag1 'next-frag))
70 (while (and (not (eq frag2 frag-anchor))
71 (eq decode (get frag2 'decode)))
72 (setq frag2 (get frag2 'next-frag)))
73 (funcall decode frag-anchor frag1 frag2 eword-filter)
75 (setq frag1 (get frag-anchor 'prev-frag)
77 (while (not (eq frag1 frag-anchor))
78 (setq tmp (cons (or (get frag1 'result) (symbol-name frag1)) tmp)
79 frag1 (get frag1 'prev-frag)))
82 (defun ew-mark (tag anchor)
83 (let ((tlist (cons (list (symbol-value tag)) (ew-pair-list anchor))))
84 ;;(insert (format "%s" tlist))
89 (prog1 (car tlist) (setq tlist (cdr tlist)))))
91 (message "%s%s : %s" msg tok anchor)
92 (when (< 0 ew-parse-error-sit-for-seconds)
93 (sit-for ew-parse-error-sit-for-seconds))))))
95 (defun ew-decode-none (anchor frag end eword-filter)
96 (while (not (eq frag end))
97 (put frag 'result (funcall ew-decode-us-ascii (symbol-name frag)))
98 (setq frag (get frag 'next-frag))))
100 (defun ew-decode-generic (anchor start end
105 (let ((frag start) result buff type f)
106 (while (not (eq frag end))
107 (setq type (get frag 'type))
109 ((and (memq type eword)
110 (ew-proper-eword-p frag))
112 (setq result (ew-rappend result
113 (funcall decode-others
116 (let ((first frag) (ewords (list frag)))
118 (setq f (get frag 'next-frag))
119 (while (and (not (eq f end))
120 (memq (get f 'type) gap))
121 (setq f (get f 'next-frag)))
122 (and (not (eq f end))
123 (ew-proper-eword-p f)))
124 (setq ewords (ew-rcons* ewords f)
126 (while (not (eq first frag))
127 (put first 'result "")
128 (setq first (get first 'next-frag)))
129 (put frag 'result "")
130 (setq result (ew-rappend result
131 (funcall decode-ewords
135 (setq buff (cons frag buff))
136 (put frag 'result ""))
138 (error "unexpected token: %s (%s)" frag type)))
139 (setq frag (get frag 'next-frag)))
141 (setq result (ew-rappend result (funcall decode-others (nreverse buff)))))
143 (apply 'ew-quote-concat (nreverse result)))
146 (defun ew-decode-generic-others (frags puncts quotes targets)
147 (let (result buff frag type tmp)
149 (setq frag (car frags)
150 type (get frag 'type)
155 (setq buff (nreverse buff)
156 tmp (funcall ew-decode-us-ascii
157 (mapconcat 'car buff "")))
158 (if (ew-contain-non-ascii-p tmp)
159 (setq result (ew-rcons* result tmp))
160 (setq result (ew-rcons*
162 (funcall ew-decode-us-ascii
163 (mapconcat 'cdr buff "")))))
165 (setq result (ew-rcons*
167 (symbol-name frag))))
169 (setq buff (ew-rcons*
171 (cons (substring (symbol-name frag) 1)
172 (symbol-name frag)))))
174 (setq buff (ew-rcons*
176 (cons (symbol-name frag)
177 (symbol-name frag)))))
179 (error "something wrong: unexpected token: %s (%s)" frag type))))
181 (setq buff (nreverse buff)
182 tmp (funcall ew-decode-us-ascii
183 (mapconcat 'car buff "")))
184 (if (ew-contain-non-ascii-p tmp)
185 (setq result (ew-rcons* result tmp))
186 (setq result (ew-rcons*
188 (funcall ew-decode-us-ascii
189 (mapconcat 'cdr buff "")))))
193 (defun ew-decode-unstructured-ewords (ewords eword-filter)
196 (setq result (ew-rcons*
198 (list (ew-decode-eword (symbol-name (car ewords))
201 ewords (cdr ewords)))
204 (defun ew-decode-unstructured-others (frags)
207 (setq result (ew-rcons*
209 (symbol-name (car frags)))
211 (list (funcall ew-decode-us-ascii
212 (apply 'concat (nreverse result))))))
214 (defun ew-decode-unstructured (anchor start end eword-filter)
217 'ew-decode-unstructured-ewords
218 'ew-decode-unstructured-others
227 (defun ew-decode-phrase-ewords (ewords eword-filter)
228 (let ((qs (eq (get (car ewords) 'type) 'ew:qs-texts))
232 (setq result (ew-rcons*
234 (list (ew-decode-eword (symbol-name (car ewords))
237 require-quoting (or require-quoting
238 (string-match "[][()<>@,;:\\\".\000-\037]"
240 ewords (cdr ewords)))
243 (funcall (if qs 'ew-embed-in-quoted-string 'ew-embed-in-phrase)
244 (apply 'ew-quote-concat
248 (defun ew-decode-phrase-others (frags)
249 (ew-decode-generic-others
262 (defun ew-decode-phrase (anchor start end eword-filter)
265 'ew-decode-phrase-ewords
266 'ew-decode-phrase-others
267 (if ew-decode-quoted-encoded-word
268 '(ew:atom ew:qs-texts)
284 (defun ew-decode-comment-ewords (ewords eword-filter)
285 (let (require-quoting
288 (setq result (ew-rcons*
290 (list (ew-decode-eword (symbol-name (car ewords))
293 require-quoting (or require-quoting
294 (string-match "[()\\\\]" (caar result)))
295 ewords (cdr ewords)))
299 (apply 'ew-quote-concat
303 (defun ew-decode-comment-others (frags)
304 (ew-decode-generic-others
313 (defun ew-decode-comment (anchor start end eword-filter)
316 'ew-decode-comment-ewords
317 'ew-decode-comment-others
330 (defun ew-embed-in-phrase (str)
331 (concat "\"" (ew-embed-in-quoted-string str) "\""))
333 (defun ew-embed-in-quoted-string (str)
334 (ew-quote-as-quoted-pair str '(?\\ ?\")))
336 (defun ew-embed-in-comment (str)
337 (ew-quote-as-quoted-pair str '(?\\ ?\( ?\))))
339 (defun ew-quote-as-quoted-pair (str specials)
340 (let ((i 0) (j 0) (l (length str)) result)
342 (when (member (aref str j) specials)
343 (setq result (ew-rcons*
350 (setq result (ew-rcons*
353 (apply 'concat (nreverse result))))
357 (defun ew-proper-eword-p (frag)
359 (or ew-ignore-75bytes-limit
360 (<= (length (symbol-name frag)) 75))
361 (or ew-ignore-76bytes-limit
362 (<= (get frag 'line-length) 76))
364 ((eq (get frag 'type) 'ew:cm-texts)
365 (ew-eword-p (symbol-name frag)))
366 ((eq (get frag 'type) 'ew:qs-texts)
367 (ew-eword-p (symbol-name frag)))
368 ((eq (get frag 'type) 'ew:atom)
370 (or ew-permit-sticked-comment
372 (not (ew-comment-frag-p (get frag 'prev-frag)))
373 (not (ew-comment-frag-p (get frag 'next-frag)))))
374 (or ew-permit-sticked-special
376 (or (ew-comment-frag-p (get frag 'prev-frag))
377 (not (ew-special-frag-p (get frag 'prev-frag))))
378 (or (ew-comment-frag-p (get frag 'next-frag))
379 (not (ew-special-frag-p (get frag 'next-frag))))))
380 (ew-eword-p (symbol-name frag))))
381 ((eq (get frag 'type) 'ew:us-texts)
383 (or ew-permit-sticked-special
384 (not (ew-special-frag-p (get frag 'prev-frag))))
385 (ew-eword-p (symbol-name frag))))
389 (defun ew-contain-non-ascii-p (str)
390 (not (eq (charsets-to-mime-charset (find-charset-string str)) 'us-ascii)))
394 (ew-decode-field "To" " =?US-ASCII?Q?phrase?= <akr@jaist.ac.jp>")
395 (ew-decode-field "To" " =?US-ASCII?Q?phrase?= < =?US-ASCII?Q?akr?= @jaist.ac.jp>")
396 (ew-decode-field "To" " =?US-ASCII?Q?akr?= @jaist.ac.jp")
397 (ew-decode-field "Subject" " =?ISO-2022-JP?B?GyRCJCIbKEI=?=")
398 (ew-decode-field "Content-Type" " text/vnd.latex-z(=?US-ASCII?Q?What=3F?=);charset=ISO-2022-JP")
400 (ew-decode-field "To" " =?US-ASCII?Q?A=22B=5CC?= <akr@jaist.ac.jp>")
401 (let ((ew-decode-quoted-encoded-word t))
402 (ew-decode-field "To" " \"=?US-ASCII?Q?A=22B=5CC?=\" <akr@jaist.ac.jp>"))
404 (ew-decode-field "To" " akr@jaist.ac.jp (=?US-ASCII?Q?=28A=29B=5C?=)")
406 (ew-decode-field "To" "\"A\\BC\e$B\\\"\\\\\e(B\" <foo@bar>")
407 (ew-decode-field "To" "\"A\\BC\" <foo@bar>")
408 (ew-decode-field "To" "\"\e\\$\\B\\$\\\"\e\\(\\B\" <foo@bar>")