1 |
;;; mm-encode.el --- functions for encoding MIME things |
;;; mm-encode.el --- Functions for encoding MIME things |
2 |
;; Copyright (C) 1998, 1999, 2000, 2002 Free Software Foundation, Inc. |
;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004 |
3 |
|
;; Free Software Foundation, Inc. |
4 |
|
|
5 |
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> |
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> |
6 |
;; MORIOKA Tomohiko <morioka@jaist.ac.jp> |
;; MORIOKA Tomohiko <morioka@jaist.ac.jp> |
29 |
(require 'mail-parse) |
(require 'mail-parse) |
30 |
(require 'mailcap) |
(require 'mailcap) |
31 |
(eval-and-compile |
(eval-and-compile |
32 |
(autoload 'mm-body-7-or-8 "mm-bodies")) |
(autoload 'mm-body-7-or-8 "mm-bodies") |
33 |
|
(autoload 'mm-long-lines-p "mm-bodies")) |
34 |
|
|
35 |
(defvar mm-content-transfer-encoding-defaults |
(defcustom mm-content-transfer-encoding-defaults |
36 |
'(("text/x-patch" 8bit) |
'(("text/x-patch" 8bit) |
37 |
("text/.*" qp-or-base64) |
("text/.*" qp-or-base64) |
38 |
("message/rfc822" 8bit) |
("message/rfc822" 8bit) |
39 |
("application/emacs-lisp" 8bit) |
("application/emacs-lisp" qp-or-base64) |
40 |
("application/x-emacs-lisp" 8bit) |
("application/x-emacs-lisp" qp-or-base64) |
41 |
("application/x-patch" 8bit) |
("application/x-patch" qp-or-base64) |
42 |
(".*" base64)) |
(".*" base64)) |
43 |
"Alist of regexps that match MIME types and their encodings. |
"Alist of regexps that match MIME types and their encodings. |
44 |
If the encoding is `qp-or-base64', then either quoted-printable |
If the encoding is `qp-or-base64', then either quoted-printable |
45 |
or base64 will be used, depending on what is more efficient.") |
or base64 will be used, depending on what is more efficient. |
46 |
|
|
47 |
|
`qp-or-base64' has another effect. It will fold long lines so that |
48 |
|
MIME parts may not be broken by MTA. So do `quoted-printable' and |
49 |
|
`base64'. |
50 |
|
|
51 |
|
Note: It affects body encoding only when a part is a raw forwarded |
52 |
|
message (which will be made by `gnus-summary-mail-forward' with the |
53 |
|
arg 2 for example) or is neither the text/* type nor the message/* |
54 |
|
type. Even though in those cases, you can use the `encoding' MML tag |
55 |
|
to specify encoding of non-ASCII MIME parts." |
56 |
|
:type '(repeat (list (regexp :tag "MIME type") |
57 |
|
(choice :tag "encoding" |
58 |
|
(const 7bit) |
59 |
|
(const 8bit) |
60 |
|
(const qp-or-base64) |
61 |
|
(const quoted-printable) |
62 |
|
(const base64)))) |
63 |
|
:group 'mime) |
64 |
|
|
65 |
(defvar mm-use-ultra-safe-encoding nil |
(defvar mm-use-ultra-safe-encoding nil |
66 |
"If non-nil, use encodings aimed at Procrustean bed survival. |
"If non-nil, use encodings aimed at Procrustean bed survival. |
96 |
(mailcap-extension-to-mime (match-string 0 file)))) |
(mailcap-extension-to-mime (match-string 0 file)))) |
97 |
|
|
98 |
(defun mm-safer-encoding (encoding) |
(defun mm-safer-encoding (encoding) |
99 |
"Return a safer but similar encoding." |
"Return an encoding similar to ENCODING but safer than it." |
100 |
(cond |
(cond |
101 |
((memq encoding '(7bit 8bit quoted-printable)) 'quoted-printable) |
((eq encoding '7bit) '7bit) ;; 7bit is considered safe. |
102 |
|
((memq encoding '(8bit quoted-printable)) 'quoted-printable) |
103 |
;; The remaining encodings are binary and base64 (and perhaps some |
;; The remaining encodings are binary and base64 (and perhaps some |
104 |
;; non-standard ones), which are both turned into base64. |
;; non-standard ones), which are both turned into base64. |
105 |
(t 'base64))) |
(t 'base64))) |
106 |
|
|
107 |
(defun mm-encode-content-transfer-encoding (encoding &optional type) |
(defun mm-encode-content-transfer-encoding (encoding &optional type) |
108 |
|
"Encode the current buffer with ENCODING for MIME type TYPE. |
109 |
|
ENCODING can be: nil (do nothing); one of `quoted-printable', `base64'; |
110 |
|
`7bit', `8bit' or `binary' (all do nothing); a function to do the encoding." |
111 |
(cond |
(cond |
112 |
((eq encoding 'quoted-printable) |
((eq encoding 'quoted-printable) |
113 |
|
;; This used to try to make a multibyte buffer unibyte. That's |
114 |
|
;; completely wrong, since you'd get QP-encoded emacs-mule. If |
115 |
|
;; this gets run on multibyte text it's an error that needs |
116 |
|
;; fixing, and the encoding function will signal an error. |
117 |
|
;; Likewise base64 below. |
118 |
(quoted-printable-encode-region (point-min) (point-max) t)) |
(quoted-printable-encode-region (point-min) (point-max) t)) |
119 |
((eq encoding 'base64) |
((eq encoding 'base64) |
120 |
(when (equal type "text/plain") |
(when (equal type "text/plain") |
121 |
(goto-char (point-min)) |
(goto-char (point-min)) |
122 |
(while (search-forward "\n" nil t) |
(while (search-forward "\n" nil t) |
123 |
(replace-match "\r\n" t t))) |
(replace-match "\r\n" t t))) |
124 |
(condition-case error |
(base64-encode-region (point-min) (point-max))) |
|
(base64-encode-region (point-min) (point-max)) |
|
|
(error |
|
|
(message "Error while decoding: %s" error) |
|
|
nil))) |
|
125 |
((memq encoding '(7bit 8bit binary)) |
((memq encoding '(7bit 8bit binary)) |
126 |
;; Do nothing. |
;; Do nothing. |
127 |
) |
) |
128 |
((null encoding) |
((null encoding) |
129 |
;; Do nothing. |
;; Do nothing. |
130 |
) |
) |
131 |
|
;; Fixme: Ignoring errors here looks bogus. |
132 |
((functionp encoding) |
((functionp encoding) |
133 |
(ignore-errors (funcall encoding (point-min) (point-max)))) |
(ignore-errors (funcall encoding (point-min) (point-max)))) |
134 |
(t |
(t |
135 |
(message "Unknown encoding %s; defaulting to 8bit" encoding)))) |
(error "Unknown encoding %s" encoding)))) |
136 |
|
|
137 |
(defun mm-encode-buffer (type) |
(defun mm-encode-buffer (type) |
138 |
"Encode the buffer which contains data of TYPE. |
"Encode the buffer which contains data of MIME type TYPE. |
139 |
|
TYPE is a string or a list of the components. |
140 |
The encoding used is returned." |
The encoding used is returned." |
141 |
(let* ((mime-type (if (stringp type) type (car type))) |
(let* ((mime-type (if (stringp type) type (car type))) |
142 |
(encoding |
(encoding |
146 |
(bits (mm-body-7-or-8))) |
(bits (mm-body-7-or-8))) |
147 |
;; We force buffers that are 7bit to be unencoded, no matter |
;; We force buffers that are 7bit to be unencoded, no matter |
148 |
;; what the preferred encoding is. |
;; what the preferred encoding is. |
149 |
(when (eq bits '7bit) |
;; Only if the buffers don't contain lone lines. |
150 |
|
(when (and (eq bits '7bit) (not (mm-long-lines-p 76))) |
151 |
(setq encoding bits)) |
(setq encoding bits)) |
152 |
(mm-encode-content-transfer-encoding encoding mime-type) |
(mm-encode-content-transfer-encoding encoding mime-type) |
153 |
encoding)) |
encoding)) |
182 |
(pop rules))))) |
(pop rules))))) |
183 |
|
|
184 |
(defun mm-qp-or-base64 () |
(defun mm-qp-or-base64 () |
185 |
(save-excursion |
"Return the type with which to encode the buffer. |
186 |
(let ((limit (min (point-max) (+ 2000 (point-min)))) |
This is either `base64' or `quoted-printable'." |
187 |
(n8bit 0)) |
(if (equal mm-use-ultra-safe-encoding '(sign . "pgp")) |
188 |
(goto-char (point-min)) |
;; perhaps not always accurate? |
189 |
(skip-chars-forward "\x20-\x7f\r\n\t" limit) |
'quoted-printable |
190 |
(while (< (point) limit) |
(save-excursion |
191 |
(incf n8bit) |
(let ((limit (min (point-max) (+ 2000 (point-min)))) |
192 |
(forward-char 1) |
(n8bit 0)) |
193 |
(skip-chars-forward "\x20-\x7f\r\n\t" limit)) |
(goto-char (point-min)) |
194 |
(if (or (< (* 6 n8bit) (- limit (point-min))) |
(skip-chars-forward "\x20-\x7f\r\n\t" limit) |
195 |
;; Don't base64, say, a short line with a single |
(while (< (point) limit) |
196 |
;; non-ASCII char when splitting parts by charset. |
(incf n8bit) |
197 |
(= n8bit 1)) |
(forward-char 1) |
198 |
'quoted-printable |
(skip-chars-forward "\x20-\x7f\r\n\t" limit)) |
199 |
'base64)))) |
(if (or (< (* 6 n8bit) (- limit (point-min))) |
200 |
|
;; Don't base64, say, a short line with a single |
201 |
|
;; non-ASCII char when splitting parts by charset. |
202 |
|
(= n8bit 1)) |
203 |
|
'quoted-printable |
204 |
|
'base64))))) |
205 |
|
|
206 |
(provide 'mm-encode) |
(provide 'mm-encode) |
207 |
|
|