aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--lisp/gnus/mm-bodies.el71
1 files changed, 18 insertions, 53 deletions
diff --git a/lisp/gnus/mm-bodies.el b/lisp/gnus/mm-bodies.el
index 51a16a6a7f1..ab8ab1ccacb 100644
--- a/lisp/gnus/mm-bodies.el
+++ b/lisp/gnus/mm-bodies.el
@@ -1,5 +1,5 @@
1;;; mm-bodies.el --- functions for decoding MIME things 1;;; mm-bodies.el --- functions for decoding MIME things
2;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc. 2;; Copyright (C) 1998, 1999, 2000, 2002 Free Software Foundation, Inc.
3 3
4;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> 4;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
5;; MORIOKA Tomohiko <morioka@jaist.ac.jp> 5;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
@@ -56,8 +56,8 @@ Valid encodings are `7bit', `8bit', `quoted-printable' and `base64'."
56(defun mm-encode-body () 56(defun mm-encode-body ()
57 "Encode a body. 57 "Encode a body.
58Should be called narrowed to the body that is to be encoded. 58Should be called narrowed to the body that is to be encoded.
59If there is more than one non-ASCII MULE charset, then list of found 59If there is more than one non-ASCII Mule charset, then the list of found
60MULE charsets are returned. 60Mule charsets is returned.
61If successful, the MIME charset is returned. 61If successful, the MIME charset is returned.
62If no encoding was done, nil is returned." 62If no encoding was done, nil is returned."
63 (if (not (mm-multibyte-p)) 63 (if (not (mm-multibyte-p))
@@ -73,8 +73,7 @@ If no encoding was done, nil is returned."
73 nil)) 73 nil))
74 (save-excursion 74 (save-excursion
75 (goto-char (point-min)) 75 (goto-char (point-min))
76 (let ((charsets (mm-find-mime-charset-region (point-min) (point-max))) 76 (let ((charsets (mm-find-mime-charset-region (point-min) (point-max))))
77 charset)
78 (cond 77 (cond
79 ;; No encoding. 78 ;; No encoding.
80 ((null charsets) 79 ((null charsets)
@@ -84,29 +83,10 @@ If no encoding was done, nil is returned."
84 charsets) 83 charsets)
85 ;; We encode. 84 ;; We encode.
86 (t 85 (t
87 (let ((charset (car charsets)) 86 (mm-encode-coding-region (point-min) (point-max)
88 start) 87 (mm-charset-to-coding-system
89 (when (or t 88 (car charsets)))
90 ;; We always decode. 89 (car charsets)))))))
91 (not (mm-coding-system-equal
92 charset buffer-file-coding-system)))
93 (while (not (eobp))
94 (if (eq (mm-charset-after) 'ascii)
95 (when start
96 (save-restriction
97 (narrow-to-region start (point))
98 (mm-encode-coding-region
99 start (point) (mm-charset-to-coding-system charset))
100 (goto-char (point-max)))
101 (setq start nil))
102 (unless start
103 (setq start (point))))
104 (forward-char 1))
105 (when start
106 (mm-encode-coding-region start (point)
107 (mm-charset-to-coding-system charset))
108 (setq start nil)))
109 charset)))))))
110 90
111(eval-when-compile (defvar message-posting-charset)) 91(eval-when-compile (defvar message-posting-charset))
112 92
@@ -133,27 +113,12 @@ If no encoding was done, nil is returned."
133 113
134(defun mm-body-7-or-8 () 114(defun mm-body-7-or-8 ()
135 "Say whether the body is 7bit or 8bit." 115 "Say whether the body is 7bit or 8bit."
136 (cond 116 (if (save-excursion
137 ((not (featurep 'mule)) 117 (goto-char (point-min))
138 (if (save-excursion 118 (skip-chars-forward mm-7bit-chars)
139 (goto-char (point-min)) 119 (eobp))
140 (skip-chars-forward mm-7bit-chars) 120 '7bit
141 (eobp)) 121 '8bit))
142 '7bit
143 '8bit))
144 (t
145 ;; Mule version
146 (if (and (null (delq 'ascii
147 (mm-find-charset-region (point-min) (point-max))))
148 ;;!!!The following is necessary because the function
149 ;;!!!above seems to return the wrong result under
150 ;;!!!Emacs 20.3. Sometimes.
151 (save-excursion
152 (goto-char (point-min))
153 (skip-chars-forward mm-7bit-chars)
154 (eobp)))
155 '7bit
156 '8bit))))
157 122
158;;; 123;;;
159;;; Functions for decoding 124;;; Functions for decoding
@@ -213,7 +178,7 @@ If no encoding was done, nil is returned."
213The characters in CHARSET should then be decoded." 178The characters in CHARSET should then be decoded."
214 (if (stringp charset) 179 (if (stringp charset)
215 (setq charset (intern (downcase charset)))) 180 (setq charset (intern (downcase charset))))
216 (if (or (not charset) 181 (if (or (not charset)
217 (eq 'gnus-all mail-parse-ignored-charsets) 182 (eq 'gnus-all mail-parse-ignored-charsets)
218 (memq 'gnus-all mail-parse-ignored-charsets) 183 (memq 'gnus-all mail-parse-ignored-charsets)
219 (memq charset mail-parse-ignored-charsets)) 184 (memq charset mail-parse-ignored-charsets))
@@ -226,7 +191,7 @@ The characters in CHARSET should then be decoded."
226 (if (and (not coding-system) 191 (if (and (not coding-system)
227 (listp mail-parse-ignored-charsets) 192 (listp mail-parse-ignored-charsets)
228 (memq 'gnus-unknown mail-parse-ignored-charsets)) 193 (memq 'gnus-unknown mail-parse-ignored-charsets))
229 (setq coding-system 194 (setq coding-system
230 (mm-charset-to-coding-system mail-parse-charset))) 195 (mm-charset-to-coding-system mail-parse-charset)))
231 (when (and charset coding-system 196 (when (and charset coding-system
232 ;; buffer-file-coding-system 197 ;; buffer-file-coding-system
@@ -242,7 +207,7 @@ The characters in CHARSET should then be decoded."
242 "Decode STRING with CHARSET." 207 "Decode STRING with CHARSET."
243 (when (stringp charset) 208 (when (stringp charset)
244 (setq charset (intern (downcase charset)))) 209 (setq charset (intern (downcase charset))))
245 (when (or (not charset) 210 (when (or (not charset)
246 (eq 'gnus-all mail-parse-ignored-charsets) 211 (eq 'gnus-all mail-parse-ignored-charsets)
247 (memq 'gnus-all mail-parse-ignored-charsets) 212 (memq 'gnus-all mail-parse-ignored-charsets)
248 (memq charset mail-parse-ignored-charsets)) 213 (memq charset mail-parse-ignored-charsets))
@@ -253,7 +218,7 @@ The characters in CHARSET should then be decoded."
253 (if (and (not coding-system) 218 (if (and (not coding-system)
254 (listp mail-parse-ignored-charsets) 219 (listp mail-parse-ignored-charsets)
255 (memq 'gnus-unknown mail-parse-ignored-charsets)) 220 (memq 'gnus-unknown mail-parse-ignored-charsets))
256 (setq coding-system 221 (setq coding-system
257 (mm-charset-to-coding-system mail-parse-charset))) 222 (mm-charset-to-coding-system mail-parse-charset)))
258 (when (and charset coding-system 223 (when (and charset coding-system
259 (mm-multibyte-p) 224 (mm-multibyte-p)