Mercurial > emacs
comparison lisp/gnus/mm-bodies.el @ 31717:6b20b7e85e3c
*** empty log message ***
author | Gerd Moellmann <gerd@gnu.org> |
---|---|
date | Tue, 19 Sep 2000 13:40:08 +0000 |
parents | |
children | cbbde5b20af5 |
comparison
equal
deleted
inserted
replaced
31716:9968f55ad26e | 31717:6b20b7e85e3c |
---|---|
1 ;;; mm-bodies.el --- Functions for decoding MIME things | |
2 ;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc. | |
3 | |
4 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> | |
5 ;; MORIOKA Tomohiko <morioka@jaist.ac.jp> | |
6 ;; This file is part of GNU Emacs. | |
7 | |
8 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
9 ;; it under the terms of the GNU General Public License as published by | |
10 ;; the Free Software Foundation; either version 2, or (at your option) | |
11 ;; any later version. | |
12 | |
13 ;; GNU Emacs is distributed in the hope that it will be useful, | |
14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
16 ;; GNU General Public License for more details. | |
17 | |
18 ;; You should have received a copy of the GNU General Public License | |
19 ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
20 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
21 ;; Boston, MA 02111-1307, USA. | |
22 | |
23 ;;; Commentary: | |
24 | |
25 ;;; Code: | |
26 | |
27 (eval-and-compile | |
28 (or (fboundp 'base64-decode-region) | |
29 (require 'base64)) | |
30 (autoload 'binhex-decode-region "binhex")) | |
31 | |
32 (require 'mm-util) | |
33 (require 'rfc2047) | |
34 (require 'qp) | |
35 (require 'uudecode) | |
36 | |
37 ;; 8bit treatment gets any char except: 0x32 - 0x7f, CR, LF, TAB, BEL, | |
38 ;; BS, vertical TAB, form feed, and ^_ | |
39 (defvar mm-7bit-chars "\x20-\x7f\r\n\t\x7\x8\xb\xc\x1f") | |
40 | |
41 (defcustom mm-body-charset-encoding-alist | |
42 '((iso-2022-jp . 7bit) | |
43 (iso-2022-jp-2 . 7bit)) | |
44 "Alist of MIME charsets to encodings. | |
45 Valid encodings are `7bit', `8bit', `quoted-printable' and `base64'." | |
46 :type '(repeat (cons (symbol :tag "charset") | |
47 (choice :tag "encoding" | |
48 (const 7bit) | |
49 (const 8bit) | |
50 (const quoted-printable) | |
51 (const base64)))) | |
52 :group 'mime) | |
53 | |
54 (defun mm-encode-body () | |
55 "Encode a body. | |
56 Should be called narrowed to the body that is to be encoded. | |
57 If there is more than one non-ASCII MULE charset, then list of found | |
58 MULE charsets are returned. | |
59 If successful, the MIME charset is returned. | |
60 If no encoding was done, nil is returned." | |
61 (if (not (featurep 'mule)) | |
62 ;; In the non-Mule case, we search for non-ASCII chars and | |
63 ;; return the value of `mail-parse-charset' if any are found. | |
64 (save-excursion | |
65 (goto-char (point-min)) | |
66 (if (re-search-forward "[^\x0-\x7f]" nil t) | |
67 (or mail-parse-charset | |
68 (mm-read-charset "Charset used in the article: ")) | |
69 ;; The logic in `mml-generate-mime-1' confirms that it's OK | |
70 ;; to return nil here. | |
71 nil)) | |
72 (save-excursion | |
73 (goto-char (point-min)) | |
74 (let ((charsets (mm-find-mime-charset-region (point-min) (point-max))) | |
75 charset) | |
76 (cond | |
77 ;; No encoding. | |
78 ((null charsets) | |
79 nil) | |
80 ;; Too many charsets. | |
81 ((> (length charsets) 1) | |
82 charsets) | |
83 ;; We encode. | |
84 (t | |
85 (let ((charset (car charsets)) | |
86 start) | |
87 (when (or t | |
88 ;; We always decode. | |
89 (not (mm-coding-system-equal | |
90 charset buffer-file-coding-system))) | |
91 (while (not (eobp)) | |
92 (if (eq (mm-charset-after) 'ascii) | |
93 (when start | |
94 (save-restriction | |
95 (narrow-to-region start (point)) | |
96 (mm-encode-coding-region start (point) charset) | |
97 (goto-char (point-max))) | |
98 (setq start nil)) | |
99 (unless start | |
100 (setq start (point)))) | |
101 (forward-char 1)) | |
102 (when start | |
103 (mm-encode-coding-region start (point) charset) | |
104 (setq start nil))) | |
105 charset))))))) | |
106 | |
107 (defun mm-body-encoding (charset &optional encoding) | |
108 "Do Content-Transfer-Encoding and return the encoding of the current buffer." | |
109 (let ((bits (mm-body-7-or-8))) | |
110 (cond | |
111 ((and (not mm-use-ultra-safe-encoding) (eq bits '7bit)) | |
112 bits) | |
113 ((and (not mm-use-ultra-safe-encoding) | |
114 (or (eq t (cdr message-posting-charset)) | |
115 (memq charset (cdr message-posting-charset)) | |
116 (eq charset mail-parse-charset))) | |
117 bits) | |
118 (t | |
119 (let ((encoding (or encoding | |
120 (cdr (assq charset mm-body-charset-encoding-alist)) | |
121 (mm-qp-or-base64)))) | |
122 (when mm-use-ultra-safe-encoding | |
123 (setq encoding (mm-safer-encoding encoding))) | |
124 (mm-encode-content-transfer-encoding encoding "text/plain") | |
125 encoding))))) | |
126 | |
127 (defun mm-body-7-or-8 () | |
128 "Say whether the body is 7bit or 8bit." | |
129 (cond | |
130 ((not (featurep 'mule)) | |
131 (if (save-excursion | |
132 (goto-char (point-min)) | |
133 (skip-chars-forward mm-7bit-chars) | |
134 (eobp)) | |
135 '7bit | |
136 '8bit)) | |
137 (t | |
138 ;; Mule version | |
139 (if (and (null (delq 'ascii | |
140 (mm-find-charset-region (point-min) (point-max)))) | |
141 ;;!!!The following is necessary because the function | |
142 ;;!!!above seems to return the wrong result under | |
143 ;;!!!Emacs 20.3. Sometimes. | |
144 (save-excursion | |
145 (goto-char (point-min)) | |
146 (skip-chars-forward mm-7bit-chars) | |
147 (eobp))) | |
148 '7bit | |
149 '8bit)))) | |
150 | |
151 ;;; | |
152 ;;; Functions for decoding | |
153 ;;; | |
154 | |
155 (defun mm-decode-content-transfer-encoding (encoding &optional type) | |
156 (prog1 | |
157 (condition-case error | |
158 (cond | |
159 ((eq encoding 'quoted-printable) | |
160 (quoted-printable-decode-region (point-min) (point-max))) | |
161 ((eq encoding 'base64) | |
162 (base64-decode-region | |
163 (point-min) | |
164 ;; Some mailers insert whitespace | |
165 ;; junk at the end which | |
166 ;; base64-decode-region dislikes. | |
167 ;; Also remove possible junk which could | |
168 ;; have been added by mailing list software. | |
169 (save-excursion | |
170 (goto-char (point-min)) | |
171 (while (re-search-forward "^[\t ]*\r?\n" nil t) | |
172 (delete-region (match-beginning 0) (match-end 0))) | |
173 (goto-char (point-max)) | |
174 (when (re-search-backward "^[A-Za-z0-9+/]+=*[\t ]*$" nil t) | |
175 (forward-line) | |
176 (delete-region (point) (point-max))) | |
177 (point-max)))) | |
178 ((memq encoding '(7bit 8bit binary)) | |
179 ;; Do nothing. | |
180 ) | |
181 ((null encoding) | |
182 ;; Do nothing. | |
183 ) | |
184 ((memq encoding '(x-uuencode x-uue)) | |
185 (funcall mm-uu-decode-function (point-min) (point-max))) | |
186 ((eq encoding 'x-binhex) | |
187 (funcall mm-uu-binhex-decode-function (point-min) (point-max))) | |
188 ((functionp encoding) | |
189 (funcall encoding (point-min) (point-max))) | |
190 (t | |
191 (message "Unknown encoding %s; defaulting to 8bit" encoding))) | |
192 (error | |
193 (message "Error while decoding: %s" error) | |
194 nil)) | |
195 (when (and | |
196 (memq encoding '(base64 x-uuencode x-uue x-binhex)) | |
197 (equal type "text/plain")) | |
198 (goto-char (point-min)) | |
199 (while (search-forward "\r\n" nil t) | |
200 (replace-match "\n" t t))))) | |
201 | |
202 (defun mm-decode-body (charset &optional encoding type) | |
203 "Decode the current article that has been encoded with ENCODING. | |
204 The characters in CHARSET should then be decoded." | |
205 (if (stringp charset) | |
206 (setq charset (intern (downcase charset)))) | |
207 (if (or (not charset) | |
208 (eq 'gnus-all mail-parse-ignored-charsets) | |
209 (memq 'gnus-all mail-parse-ignored-charsets) | |
210 (memq charset mail-parse-ignored-charsets)) | |
211 (setq charset mail-parse-charset)) | |
212 (save-excursion | |
213 (when encoding | |
214 (mm-decode-content-transfer-encoding encoding type)) | |
215 (when (featurep 'mule) | |
216 (let ((mule-charset (mm-charset-to-coding-system charset))) | |
217 (if (and (not mule-charset) | |
218 (listp mail-parse-ignored-charsets) | |
219 (memq 'gnus-unknown mail-parse-ignored-charsets)) | |
220 (setq mule-charset | |
221 (mm-charset-to-coding-system mail-parse-charset))) | |
222 (when (and charset mule-charset | |
223 ;; buffer-file-coding-system | |
224 ;;Article buffer is nil coding system | |
225 ;;in XEmacs | |
226 (mm-multibyte-p) | |
227 (or (not (eq mule-charset 'ascii)) | |
228 (setq mule-charset mail-parse-charset)) | |
229 (not (eq mule-charset 'gnus-decoded))) | |
230 (mm-decode-coding-region (point-min) (point-max) mule-charset)))))) | |
231 | |
232 (defun mm-decode-string (string charset) | |
233 "Decode STRING with CHARSET." | |
234 (when (stringp charset) | |
235 (setq charset (intern (downcase charset)))) | |
236 (when (or (not charset) | |
237 (eq 'gnus-all mail-parse-ignored-charsets) | |
238 (memq 'gnus-all mail-parse-ignored-charsets) | |
239 (memq charset mail-parse-ignored-charsets)) | |
240 (setq charset mail-parse-charset)) | |
241 (or | |
242 (when (featurep 'mule) | |
243 (let ((mule-charset (mm-charset-to-coding-system charset))) | |
244 (if (and (not mule-charset) | |
245 (listp mail-parse-ignored-charsets) | |
246 (memq 'gnus-unknown mail-parse-ignored-charsets)) | |
247 (setq mule-charset | |
248 (mm-charset-to-coding-system mail-parse-charset))) | |
249 (when (and charset mule-charset | |
250 (mm-multibyte-p) | |
251 (or (not (eq mule-charset 'ascii)) | |
252 (setq mule-charset mail-parse-charset))) | |
253 (mm-decode-coding-string string mule-charset)))) | |
254 string)) | |
255 | |
256 (provide 'mm-bodies) | |
257 | |
258 ;; mm-bodies.el ends here |