1 |
;;; mm-bodies.el --- functions for decoding MIME things |
;;; mm-bodies.el --- Functions for decoding MIME things |
2 |
;; Copyright (C) 1998, 1999, 2000, 2002 Free Software Foundation, Inc. |
|
3 |
|
;; Copyright (C) 1998, 1999, 2000, 2001, 2003 |
4 |
|
;; Free Software Foundation, Inc. |
5 |
|
|
6 |
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> |
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> |
7 |
;; MORIOKA Tomohiko <morioka@jaist.ac.jp> |
;; MORIOKA Tomohiko <morioka@jaist.ac.jp> |
44 |
|
|
45 |
(defcustom mm-body-charset-encoding-alist |
(defcustom mm-body-charset-encoding-alist |
46 |
'((iso-2022-jp . 7bit) |
'((iso-2022-jp . 7bit) |
47 |
(iso-2022-jp-2 . 7bit)) |
(iso-2022-jp-2 . 7bit) |
48 |
|
;; We MUST encode UTF-16 because it can contain \0's which is |
49 |
|
;; known to break servers. |
50 |
|
;; Note: UTF-16 variants are invalid for text parts [RFC 2781], |
51 |
|
;; so this can't happen :-/. |
52 |
|
(utf-16 . base64) |
53 |
|
(utf-16be . base64) |
54 |
|
(utf-16le . base64)) |
55 |
"Alist of MIME charsets to encodings. |
"Alist of MIME charsets to encodings. |
56 |
Valid encodings are `7bit', `8bit', `quoted-printable' and `base64'." |
Valid encodings are `7bit', `8bit', `quoted-printable' and `base64'." |
57 |
:type '(repeat (cons (symbol :tag "charset") |
:type '(repeat (cons (symbol :tag "charset") |
62 |
(const base64)))) |
(const base64)))) |
63 |
:group 'mime) |
:group 'mime) |
64 |
|
|
65 |
(defun mm-encode-body () |
(defun mm-encode-body (&optional charset) |
66 |
"Encode a body. |
"Encode a body. |
67 |
Should be called narrowed to the body that is to be encoded. |
Should be called narrowed to the body that is to be encoded. |
68 |
If there is more than one non-ASCII Mule charset, then the list of found |
If there is more than one non-ASCII MULE charset in the body, then the |
69 |
Mule charsets is returned. |
list of MULE charsets found is returned. |
70 |
|
If CHARSET is non-nil, it is used as the MIME charset to encode the body. |
71 |
If successful, the MIME charset is returned. |
If successful, the MIME charset is returned. |
72 |
If no encoding was done, nil is returned." |
If no encoding was done, nil is returned." |
73 |
(if (not (mm-multibyte-p)) |
(if (not (mm-multibyte-p)) |
74 |
;; In the non-Mule case, we search for non-ASCII chars and |
;; In the non-Mule case, we search for non-ASCII chars and |
75 |
;; return the value of `mail-parse-charset' if any are found. |
;; return the value of `mail-parse-charset' if any are found. |
76 |
(save-excursion |
(or charset |
77 |
(goto-char (point-min)) |
(save-excursion |
78 |
(if (re-search-forward "[^\x0-\x7f]" nil t) |
(goto-char (point-min)) |
79 |
(or mail-parse-charset |
(if (re-search-forward "[^\x0-\x7f]" nil t) |
80 |
(mm-read-charset "Charset used in the article: ")) |
(or mail-parse-charset |
81 |
;; The logic in `mml-generate-mime-1' confirms that it's OK |
(message-options-get 'mm-encody-body-charset) |
82 |
;; to return nil here. |
(message-options-set |
83 |
nil)) |
'mm-encody-body-charset |
84 |
|
(mm-read-coding-system "Charset used in the article: "))) |
85 |
|
;; The logic in `mml-generate-mime-1' confirms that it's OK |
86 |
|
;; to return nil here. |
87 |
|
nil))) |
88 |
(save-excursion |
(save-excursion |
89 |
(goto-char (point-min)) |
(if charset |
90 |
(let ((charsets (mm-find-mime-charset-region (point-min) (point-max)))) |
(progn |
91 |
(cond |
(mm-encode-coding-region (point-min) (point-max) charset) |
92 |
;; No encoding. |
charset) |
93 |
((null charsets) |
(goto-char (point-min)) |
94 |
nil) |
(let ((charsets (mm-find-mime-charset-region (point-min) (point-max) |
95 |
;; Too many charsets. |
mm-hack-charsets))) |
96 |
((> (length charsets) 1) |
(cond |
97 |
charsets) |
;; No encoding. |
98 |
;; We encode. |
((null charsets) |
99 |
(t |
nil) |
100 |
(mm-encode-coding-region (point-min) (point-max) |
;; Too many charsets. |
101 |
(mm-charset-to-coding-system |
((> (length charsets) 1) |
102 |
(car charsets))) |
charsets) |
103 |
(car charsets))))))) |
;; We encode. |
104 |
|
(t |
105 |
|
(prog1 |
106 |
|
(setq charset (car charsets)) |
107 |
|
(mm-encode-coding-region (point-min) (point-max) |
108 |
|
(mm-charset-to-coding-system charset)))) |
109 |
|
)))))) |
110 |
|
|
111 |
(eval-when-compile (defvar message-posting-charset)) |
(defun mm-long-lines-p (length) |
112 |
|
"Say whether any of the lines in the buffer is longer than LENGTH." |
113 |
|
(save-excursion |
114 |
|
(goto-char (point-min)) |
115 |
|
(end-of-line) |
116 |
|
(while (and (not (eobp)) |
117 |
|
(not (> (current-column) length))) |
118 |
|
(forward-line 1) |
119 |
|
(end-of-line)) |
120 |
|
(and (> (current-column) length) |
121 |
|
(current-column)))) |
122 |
|
|
123 |
|
(defvar message-posting-charset) |
124 |
|
|
125 |
(defun mm-body-encoding (charset &optional encoding) |
(defun mm-body-encoding (charset &optional encoding) |
126 |
"Do Content-Transfer-Encoding and return the encoding of the current buffer." |
"Do Content-Transfer-Encoding and return the encoding of the current buffer." |
127 |
(let ((bits (mm-body-7-or-8))) |
(when (stringp encoding) |
128 |
|
(setq encoding (intern (downcase encoding)))) |
129 |
|
(let ((bits (mm-body-7-or-8)) |
130 |
|
(longp (mm-long-lines-p 1000))) |
131 |
(require 'message) |
(require 'message) |
132 |
(cond |
(cond |
133 |
((and (not mm-use-ultra-safe-encoding) (eq bits '7bit)) |
((and (not longp) |
134 |
|
(not (and mm-use-ultra-safe-encoding |
135 |
|
(save-excursion (re-search-forward "^From " nil t)))) |
136 |
|
(eq bits '7bit)) |
137 |
bits) |
bits) |
138 |
((and (not mm-use-ultra-safe-encoding) |
((and (not mm-use-ultra-safe-encoding) |
139 |
|
(not longp) |
140 |
|
(not (cdr (assq charset mm-body-charset-encoding-alist))) |
141 |
(or (eq t (cdr message-posting-charset)) |
(or (eq t (cdr message-posting-charset)) |
142 |
(memq charset (cdr message-posting-charset)) |
(memq charset (cdr message-posting-charset)) |
143 |
(eq charset mail-parse-charset))) |
(eq charset mail-parse-charset))) |
164 |
;;; Functions for decoding |
;;; Functions for decoding |
165 |
;;; |
;;; |
166 |
|
|
167 |
|
(eval-when-compile (defvar mm-uu-yenc-decode-function)) |
168 |
|
|
169 |
(defun mm-decode-content-transfer-encoding (encoding &optional type) |
(defun mm-decode-content-transfer-encoding (encoding &optional type) |
170 |
|
"Decodes buffer encoded with ENCODING, returning success status. |
171 |
|
If TYPE is `text/plain' CRLF->LF translation may occur." |
172 |
(prog1 |
(prog1 |
173 |
(condition-case error |
(condition-case error |
174 |
(cond |
(cond |
175 |
((eq encoding 'quoted-printable) |
((eq encoding 'quoted-printable) |
176 |
(quoted-printable-decode-region (point-min) (point-max))) |
(quoted-printable-decode-region (point-min) (point-max)) |
177 |
|
t) |
178 |
((eq encoding 'base64) |
((eq encoding 'base64) |
179 |
(base64-decode-region |
(base64-decode-region |
180 |
(point-min) |
(point-min) |
189 |
(delete-region (match-beginning 0) (match-end 0))) |
(delete-region (match-beginning 0) (match-end 0))) |
190 |
(goto-char (point-max)) |
(goto-char (point-max)) |
191 |
(when (re-search-backward "^[A-Za-z0-9+/]+=*[\t ]*$" nil t) |
(when (re-search-backward "^[A-Za-z0-9+/]+=*[\t ]*$" nil t) |
192 |
(forward-line) |
(forward-line)) |
193 |
(delete-region (point) (point-max))) |
(point)))) |
|
(point-max)))) |
|
194 |
((memq encoding '(7bit 8bit binary)) |
((memq encoding '(7bit 8bit binary)) |
195 |
;; Do nothing. |
;; Do nothing. |
196 |
) |
t) |
197 |
((null encoding) |
((null encoding) |
198 |
;; Do nothing. |
;; Do nothing. |
199 |
) |
t) |
200 |
((memq encoding '(x-uuencode x-uue)) |
((memq encoding '(x-uuencode x-uue)) |
201 |
(require 'mm-uu) |
(require 'mm-uu) |
202 |
(funcall mm-uu-decode-function (point-min) (point-max))) |
(funcall mm-uu-decode-function (point-min) (point-max)) |
203 |
|
t) |
204 |
((eq encoding 'x-binhex) |
((eq encoding 'x-binhex) |
205 |
(require 'mm-uu) |
(require 'mm-uu) |
206 |
(funcall mm-uu-binhex-decode-function (point-min) (point-max))) |
(funcall mm-uu-binhex-decode-function (point-min) (point-max)) |
207 |
|
t) |
208 |
|
((eq encoding 'x-yenc) |
209 |
|
(require 'mm-uu) |
210 |
|
(funcall mm-uu-yenc-decode-function (point-min) (point-max)) |
211 |
|
) |
212 |
((functionp encoding) |
((functionp encoding) |
213 |
(funcall encoding (point-min) (point-max))) |
(funcall encoding (point-min) (point-max)) |
214 |
|
t) |
215 |
(t |
(t |
216 |
(message "Unknown encoding %s; defaulting to 8bit" encoding))) |
(message "Unknown encoding %s; defaulting to 8bit" encoding))) |
217 |
(error |
(error |
218 |
(message "Error while decoding: %s" error) |
(message "Error while decoding: %s" error) |
219 |
nil)) |
nil)) |
220 |
(when (and |
(when (and |
221 |
(memq encoding '(base64 x-uuencode x-uue x-binhex)) |
(memq encoding '(base64 x-uuencode x-uue x-binhex x-yenc)) |
222 |
(equal type "text/plain")) |
(equal type "text/plain")) |
223 |
(goto-char (point-min)) |
(goto-char (point-min)) |
224 |
(while (search-forward "\r\n" nil t) |
(while (search-forward "\r\n" nil t) |
225 |
(replace-match "\n" t t))))) |
(replace-match "\n" t t))))) |
226 |
|
|
227 |
(defun mm-decode-body (charset &optional encoding type) |
(defun mm-decode-body (charset &optional encoding type) |
228 |
"Decode the current article that has been encoded with ENCODING. |
"Decode the current article that has been encoded with ENCODING to CHARSET. |
229 |
The characters in CHARSET should then be decoded." |
ENCODING is a MIME content transfer encoding. |
230 |
(if (stringp charset) |
CHARSET is the MIME charset with which to decode the data after transfer |
231 |
(setq charset (intern (downcase charset)))) |
decoding. If it is nil, default to `mail-parse-charset'." |
232 |
(if (or (not charset) |
(when (stringp charset) |
233 |
(eq 'gnus-all mail-parse-ignored-charsets) |
(setq charset (intern (downcase charset)))) |
234 |
(memq 'gnus-all mail-parse-ignored-charsets) |
(when (or (not charset) |
235 |
(memq charset mail-parse-ignored-charsets)) |
(eq 'gnus-all mail-parse-ignored-charsets) |
236 |
(setq charset mail-parse-charset)) |
(memq 'gnus-all mail-parse-ignored-charsets) |
237 |
|
(memq charset mail-parse-ignored-charsets)) |
238 |
|
(setq charset mail-parse-charset)) |
239 |
(save-excursion |
(save-excursion |
240 |
(when encoding |
(when encoding |
241 |
(mm-decode-content-transfer-encoding encoding type)) |
(mm-decode-content-transfer-encoding encoding type)) |
242 |
(when (featurep 'mule) |
(when (featurep 'mule) ; Fixme: Wrong test for unibyte session. |
243 |
(let ((coding-system (mm-charset-to-coding-system charset))) |
(let ((coding-system (mm-charset-to-coding-system charset))) |
244 |
(if (and (not coding-system) |
(if (and (not coding-system) |
245 |
(listp mail-parse-ignored-charsets) |
(listp mail-parse-ignored-charsets) |
254 |
(or (not (eq coding-system 'ascii)) |
(or (not (eq coding-system 'ascii)) |
255 |
(setq coding-system mail-parse-charset)) |
(setq coding-system mail-parse-charset)) |
256 |
(not (eq coding-system 'gnus-decoded))) |
(not (eq coding-system 'gnus-decoded))) |
257 |
(mm-decode-coding-region (point-min) (point-max) coding-system)))))) |
(mm-decode-coding-region (point-min) (point-max) |
258 |
|
coding-system)) |
259 |
|
(setq buffer-file-coding-system |
260 |
|
(if (boundp 'last-coding-system-used) |
261 |
|
(symbol-value 'last-coding-system-used) |
262 |
|
coding-system)))))) |
263 |
|
|
264 |
(defun mm-decode-string (string charset) |
(defun mm-decode-string (string charset) |
265 |
"Decode STRING with CHARSET." |
"Decode STRING with CHARSET." |