Mercurial > emacs
annotate lisp/gnus/mm-bodies.el @ 52677:a4cf4569e557
(scheme-mode-variables): When setting
`font-lock-defaults', also specify that "#" should
be interpreted with `word' syntax.
(scheme-font-lock-keywords-2): Also interpret "#:foo" as keyword.
author | Thien-Thi Nguyen <ttn@gnuvola.org> |
---|---|
date | Tue, 30 Sep 2003 11:46:13 +0000 |
parents | 695cf19ef79e |
children | 55fd4f77387a 375f2633d815 |
rev | line source |
---|---|
38413
a26d9b55abb6
Some fixes to follow coding conventions in files from Gnus.
Pavel Janík <Pavel@Janik.cz>
parents:
33343
diff
changeset
|
1 ;;; mm-bodies.el --- functions for decoding MIME things |
47948
bce2c13027f2
(mm-body-7-or-8): Don't special-case Mule.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
2 ;; Copyright (C) 1998, 1999, 2000, 2002 Free Software Foundation, Inc. |
31717 | 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) | |
32209
cbbde5b20af5
Require mm-uu, Don't require qp, uudecode.
Dave Love <fx@gnu.org>
parents:
31717
diff
changeset
|
29 (require 'base64))) |
32409
9373d6d073ed
Don't require `mm-uu' at compile-time; it leads
Gerd Moellmann <gerd@gnu.org>
parents:
32209
diff
changeset
|
30 |
32628 | 31 (eval-when-compile |
32 (defvar mm-uu-decode-function) | |
33 (defvar mm-uu-binhex-decode-function)) | |
31717 | 34 |
35 (require 'mm-util) | |
36 (require 'rfc2047) | |
32209
cbbde5b20af5
Require mm-uu, Don't require qp, uudecode.
Dave Love <fx@gnu.org>
parents:
31717
diff
changeset
|
37 (require 'mm-encode) |
31717 | 38 |
39 ;; 8bit treatment gets any char except: 0x32 - 0x7f, CR, LF, TAB, BEL, | |
40 ;; BS, vertical TAB, form feed, and ^_ | |
41 (defvar mm-7bit-chars "\x20-\x7f\r\n\t\x7\x8\xb\xc\x1f") | |
42 | |
43 (defcustom mm-body-charset-encoding-alist | |
44 '((iso-2022-jp . 7bit) | |
45 (iso-2022-jp-2 . 7bit)) | |
46 "Alist of MIME charsets to encodings. | |
47 Valid encodings are `7bit', `8bit', `quoted-printable' and `base64'." | |
48 :type '(repeat (cons (symbol :tag "charset") | |
49 (choice :tag "encoding" | |
50 (const 7bit) | |
51 (const 8bit) | |
52 (const quoted-printable) | |
53 (const base64)))) | |
54 :group 'mime) | |
55 | |
56 (defun mm-encode-body () | |
57 "Encode a body. | |
58 Should be called narrowed to the body that is to be encoded. | |
47948
bce2c13027f2
(mm-body-7-or-8): Don't special-case Mule.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
59 If there is more than one non-ASCII Mule charset, then the list of found |
bce2c13027f2
(mm-body-7-or-8): Don't special-case Mule.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
60 Mule charsets is returned. |
31717 | 61 If successful, the MIME charset is returned. |
62 If no encoding was done, nil is returned." | |
33343
074ad4abf8e0
(mm-encode-body): Use mm-multibyte-p, don't just
Dave Love <fx@gnu.org>
parents:
32628
diff
changeset
|
63 (if (not (mm-multibyte-p)) |
31717 | 64 ;; In the non-Mule case, we search for non-ASCII chars and |
65 ;; return the value of `mail-parse-charset' if any are found. | |
66 (save-excursion | |
67 (goto-char (point-min)) | |
68 (if (re-search-forward "[^\x0-\x7f]" nil t) | |
69 (or mail-parse-charset | |
70 (mm-read-charset "Charset used in the article: ")) | |
71 ;; The logic in `mml-generate-mime-1' confirms that it's OK | |
72 ;; to return nil here. | |
73 nil)) | |
74 (save-excursion | |
75 (goto-char (point-min)) | |
47948
bce2c13027f2
(mm-body-7-or-8): Don't special-case Mule.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
76 (let ((charsets (mm-find-mime-charset-region (point-min) (point-max)))) |
31717 | 77 (cond |
78 ;; No encoding. | |
79 ((null charsets) | |
80 nil) | |
81 ;; Too many charsets. | |
82 ((> (length charsets) 1) | |
83 charsets) | |
84 ;; We encode. | |
85 (t | |
47948
bce2c13027f2
(mm-body-7-or-8): Don't special-case Mule.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
86 (mm-encode-coding-region (point-min) (point-max) |
bce2c13027f2
(mm-body-7-or-8): Don't special-case Mule.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
87 (mm-charset-to-coding-system |
bce2c13027f2
(mm-body-7-or-8): Don't special-case Mule.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
88 (car charsets))) |
bce2c13027f2
(mm-body-7-or-8): Don't special-case Mule.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
89 (car charsets))))))) |
31717 | 90 |
32209
cbbde5b20af5
Require mm-uu, Don't require qp, uudecode.
Dave Love <fx@gnu.org>
parents:
31717
diff
changeset
|
91 (eval-when-compile (defvar message-posting-charset)) |
cbbde5b20af5
Require mm-uu, Don't require qp, uudecode.
Dave Love <fx@gnu.org>
parents:
31717
diff
changeset
|
92 |
31717 | 93 (defun mm-body-encoding (charset &optional encoding) |
94 "Do Content-Transfer-Encoding and return the encoding of the current buffer." | |
95 (let ((bits (mm-body-7-or-8))) | |
32209
cbbde5b20af5
Require mm-uu, Don't require qp, uudecode.
Dave Love <fx@gnu.org>
parents:
31717
diff
changeset
|
96 (require 'message) |
31717 | 97 (cond |
98 ((and (not mm-use-ultra-safe-encoding) (eq bits '7bit)) | |
99 bits) | |
100 ((and (not mm-use-ultra-safe-encoding) | |
101 (or (eq t (cdr message-posting-charset)) | |
102 (memq charset (cdr message-posting-charset)) | |
103 (eq charset mail-parse-charset))) | |
104 bits) | |
105 (t | |
106 (let ((encoding (or encoding | |
107 (cdr (assq charset mm-body-charset-encoding-alist)) | |
108 (mm-qp-or-base64)))) | |
109 (when mm-use-ultra-safe-encoding | |
110 (setq encoding (mm-safer-encoding encoding))) | |
111 (mm-encode-content-transfer-encoding encoding "text/plain") | |
112 encoding))))) | |
113 | |
114 (defun mm-body-7-or-8 () | |
115 "Say whether the body is 7bit or 8bit." | |
47948
bce2c13027f2
(mm-body-7-or-8): Don't special-case Mule.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
116 (if (save-excursion |
bce2c13027f2
(mm-body-7-or-8): Don't special-case Mule.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
117 (goto-char (point-min)) |
bce2c13027f2
(mm-body-7-or-8): Don't special-case Mule.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
118 (skip-chars-forward mm-7bit-chars) |
bce2c13027f2
(mm-body-7-or-8): Don't special-case Mule.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
119 (eobp)) |
bce2c13027f2
(mm-body-7-or-8): Don't special-case Mule.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
120 '7bit |
bce2c13027f2
(mm-body-7-or-8): Don't special-case Mule.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
121 '8bit)) |
31717 | 122 |
123 ;;; | |
124 ;;; Functions for decoding | |
125 ;;; | |
126 | |
127 (defun mm-decode-content-transfer-encoding (encoding &optional type) | |
128 (prog1 | |
129 (condition-case error | |
130 (cond | |
131 ((eq encoding 'quoted-printable) | |
132 (quoted-printable-decode-region (point-min) (point-max))) | |
133 ((eq encoding 'base64) | |
134 (base64-decode-region | |
135 (point-min) | |
136 ;; Some mailers insert whitespace | |
137 ;; junk at the end which | |
138 ;; base64-decode-region dislikes. | |
139 ;; Also remove possible junk which could | |
140 ;; have been added by mailing list software. | |
141 (save-excursion | |
142 (goto-char (point-min)) | |
143 (while (re-search-forward "^[\t ]*\r?\n" nil t) | |
144 (delete-region (match-beginning 0) (match-end 0))) | |
145 (goto-char (point-max)) | |
146 (when (re-search-backward "^[A-Za-z0-9+/]+=*[\t ]*$" nil t) | |
147 (forward-line) | |
148 (delete-region (point) (point-max))) | |
149 (point-max)))) | |
150 ((memq encoding '(7bit 8bit binary)) | |
151 ;; Do nothing. | |
152 ) | |
153 ((null encoding) | |
154 ;; Do nothing. | |
155 ) | |
156 ((memq encoding '(x-uuencode x-uue)) | |
32209
cbbde5b20af5
Require mm-uu, Don't require qp, uudecode.
Dave Love <fx@gnu.org>
parents:
31717
diff
changeset
|
157 (require 'mm-uu) |
31717 | 158 (funcall mm-uu-decode-function (point-min) (point-max))) |
159 ((eq encoding 'x-binhex) | |
32209
cbbde5b20af5
Require mm-uu, Don't require qp, uudecode.
Dave Love <fx@gnu.org>
parents:
31717
diff
changeset
|
160 (require 'mm-uu) |
31717 | 161 (funcall mm-uu-binhex-decode-function (point-min) (point-max))) |
162 ((functionp encoding) | |
163 (funcall encoding (point-min) (point-max))) | |
164 (t | |
165 (message "Unknown encoding %s; defaulting to 8bit" encoding))) | |
166 (error | |
167 (message "Error while decoding: %s" error) | |
168 nil)) | |
169 (when (and | |
170 (memq encoding '(base64 x-uuencode x-uue x-binhex)) | |
171 (equal type "text/plain")) | |
172 (goto-char (point-min)) | |
173 (while (search-forward "\r\n" nil t) | |
174 (replace-match "\n" t t))))) | |
175 | |
176 (defun mm-decode-body (charset &optional encoding type) | |
177 "Decode the current article that has been encoded with ENCODING. | |
178 The characters in CHARSET should then be decoded." | |
179 (if (stringp charset) | |
180 (setq charset (intern (downcase charset)))) | |
47948
bce2c13027f2
(mm-body-7-or-8): Don't special-case Mule.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
181 (if (or (not charset) |
31717 | 182 (eq 'gnus-all mail-parse-ignored-charsets) |
183 (memq 'gnus-all mail-parse-ignored-charsets) | |
184 (memq charset mail-parse-ignored-charsets)) | |
185 (setq charset mail-parse-charset)) | |
186 (save-excursion | |
187 (when encoding | |
188 (mm-decode-content-transfer-encoding encoding type)) | |
189 (when (featurep 'mule) | |
32209
cbbde5b20af5
Require mm-uu, Don't require qp, uudecode.
Dave Love <fx@gnu.org>
parents:
31717
diff
changeset
|
190 (let ((coding-system (mm-charset-to-coding-system charset))) |
cbbde5b20af5
Require mm-uu, Don't require qp, uudecode.
Dave Love <fx@gnu.org>
parents:
31717
diff
changeset
|
191 (if (and (not coding-system) |
31717 | 192 (listp mail-parse-ignored-charsets) |
193 (memq 'gnus-unknown mail-parse-ignored-charsets)) | |
47948
bce2c13027f2
(mm-body-7-or-8): Don't special-case Mule.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
194 (setq coding-system |
31717 | 195 (mm-charset-to-coding-system mail-parse-charset))) |
32209
cbbde5b20af5
Require mm-uu, Don't require qp, uudecode.
Dave Love <fx@gnu.org>
parents:
31717
diff
changeset
|
196 (when (and charset coding-system |
31717 | 197 ;; buffer-file-coding-system |
198 ;;Article buffer is nil coding system | |
199 ;;in XEmacs | |
200 (mm-multibyte-p) | |
32209
cbbde5b20af5
Require mm-uu, Don't require qp, uudecode.
Dave Love <fx@gnu.org>
parents:
31717
diff
changeset
|
201 (or (not (eq coding-system 'ascii)) |
cbbde5b20af5
Require mm-uu, Don't require qp, uudecode.
Dave Love <fx@gnu.org>
parents:
31717
diff
changeset
|
202 (setq coding-system mail-parse-charset)) |
cbbde5b20af5
Require mm-uu, Don't require qp, uudecode.
Dave Love <fx@gnu.org>
parents:
31717
diff
changeset
|
203 (not (eq coding-system 'gnus-decoded))) |
cbbde5b20af5
Require mm-uu, Don't require qp, uudecode.
Dave Love <fx@gnu.org>
parents:
31717
diff
changeset
|
204 (mm-decode-coding-region (point-min) (point-max) coding-system)))))) |
31717 | 205 |
206 (defun mm-decode-string (string charset) | |
207 "Decode STRING with CHARSET." | |
208 (when (stringp charset) | |
209 (setq charset (intern (downcase charset)))) | |
47948
bce2c13027f2
(mm-body-7-or-8): Don't special-case Mule.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
210 (when (or (not charset) |
31717 | 211 (eq 'gnus-all mail-parse-ignored-charsets) |
212 (memq 'gnus-all mail-parse-ignored-charsets) | |
213 (memq charset mail-parse-ignored-charsets)) | |
214 (setq charset mail-parse-charset)) | |
215 (or | |
216 (when (featurep 'mule) | |
32209
cbbde5b20af5
Require mm-uu, Don't require qp, uudecode.
Dave Love <fx@gnu.org>
parents:
31717
diff
changeset
|
217 (let ((coding-system (mm-charset-to-coding-system charset))) |
cbbde5b20af5
Require mm-uu, Don't require qp, uudecode.
Dave Love <fx@gnu.org>
parents:
31717
diff
changeset
|
218 (if (and (not coding-system) |
31717 | 219 (listp mail-parse-ignored-charsets) |
220 (memq 'gnus-unknown mail-parse-ignored-charsets)) | |
47948
bce2c13027f2
(mm-body-7-or-8): Don't special-case Mule.
Dave Love <fx@gnu.org>
parents:
38413
diff
changeset
|
221 (setq coding-system |
31717 | 222 (mm-charset-to-coding-system mail-parse-charset))) |
32209
cbbde5b20af5
Require mm-uu, Don't require qp, uudecode.
Dave Love <fx@gnu.org>
parents:
31717
diff
changeset
|
223 (when (and charset coding-system |
31717 | 224 (mm-multibyte-p) |
32209
cbbde5b20af5
Require mm-uu, Don't require qp, uudecode.
Dave Love <fx@gnu.org>
parents:
31717
diff
changeset
|
225 (or (not (eq coding-system 'ascii)) |
cbbde5b20af5
Require mm-uu, Don't require qp, uudecode.
Dave Love <fx@gnu.org>
parents:
31717
diff
changeset
|
226 (setq coding-system mail-parse-charset))) |
cbbde5b20af5
Require mm-uu, Don't require qp, uudecode.
Dave Love <fx@gnu.org>
parents:
31717
diff
changeset
|
227 (mm-decode-coding-string string coding-system)))) |
31717 | 228 string)) |
229 | |
230 (provide 'mm-bodies) | |
231 | |
52401 | 232 ;;; arch-tag: 41104bb6-4443-4ca9-8d5c-ff87ecf27d8d |
38413
a26d9b55abb6
Some fixes to follow coding conventions in files from Gnus.
Pavel Janík <Pavel@Janik.cz>
parents:
33343
diff
changeset
|
233 ;;; mm-bodies.el ends here |