1 |
;;; mm-bodies.el --- functions for decoding MIME things |
;;; mm-bodies.el --- functions for decoding MIME things |
2 |
;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc. |
;; Copyright (C) 1998, 1999, 2000, 2002 Free Software Foundation, Inc. |
3 |
|
|
4 |
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> |
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> |
5 |
;; MORIOKA Tomohiko <morioka@jaist.ac.jp> |
;; MORIOKA Tomohiko <morioka@jaist.ac.jp> |
56 |
(defun mm-encode-body () |
(defun mm-encode-body () |
57 |
"Encode a body. |
"Encode a body. |
58 |
Should be called narrowed to the body that is to be encoded. |
Should be called narrowed to the body that is to be encoded. |
59 |
If there is more than one non-ASCII MULE charset, then list of found |
If there is more than one non-ASCII Mule charset, then the list of found |
60 |
MULE charsets are returned. |
Mule charsets is returned. |
61 |
If successful, the MIME charset is returned. |
If successful, the MIME charset is returned. |
62 |
If no encoding was done, nil is returned." |
If no encoding was done, nil is returned." |
63 |
(if (not (mm-multibyte-p)) |
(if (not (mm-multibyte-p)) |
73 |
nil)) |
nil)) |
74 |
(save-excursion |
(save-excursion |
75 |
(goto-char (point-min)) |
(goto-char (point-min)) |
76 |
(let ((charsets (mm-find-mime-charset-region (point-min) (point-max))) |
(let ((charsets (mm-find-mime-charset-region (point-min) (point-max)))) |
|
charset) |
|
77 |
(cond |
(cond |
78 |
;; No encoding. |
;; No encoding. |
79 |
((null charsets) |
((null charsets) |
83 |
charsets) |
charsets) |
84 |
;; We encode. |
;; We encode. |
85 |
(t |
(t |
86 |
(let ((charset (car charsets)) |
(mm-encode-coding-region (point-min) (point-max) |
87 |
start) |
(mm-charset-to-coding-system |
88 |
(when (or t |
(car charsets))) |
89 |
;; We always decode. |
(car charsets))))))) |
|
(not (mm-coding-system-equal |
|
|
charset buffer-file-coding-system))) |
|
|
(while (not (eobp)) |
|
|
(if (eq (mm-charset-after) 'ascii) |
|
|
(when start |
|
|
(save-restriction |
|
|
(narrow-to-region start (point)) |
|
|
(mm-encode-coding-region |
|
|
start (point) (mm-charset-to-coding-system charset)) |
|
|
(goto-char (point-max))) |
|
|
(setq start nil)) |
|
|
(unless start |
|
|
(setq start (point)))) |
|
|
(forward-char 1)) |
|
|
(when start |
|
|
(mm-encode-coding-region start (point) |
|
|
(mm-charset-to-coding-system charset)) |
|
|
(setq start nil))) |
|
|
charset))))))) |
|
90 |
|
|
91 |
(eval-when-compile (defvar message-posting-charset)) |
(eval-when-compile (defvar message-posting-charset)) |
92 |
|
|
113 |
|
|
114 |
(defun mm-body-7-or-8 () |
(defun mm-body-7-or-8 () |
115 |
"Say whether the body is 7bit or 8bit." |
"Say whether the body is 7bit or 8bit." |
116 |
(cond |
(if (save-excursion |
117 |
((not (featurep 'mule)) |
(goto-char (point-min)) |
118 |
(if (save-excursion |
(skip-chars-forward mm-7bit-chars) |
119 |
(goto-char (point-min)) |
(eobp)) |
120 |
(skip-chars-forward mm-7bit-chars) |
'7bit |
121 |
(eobp)) |
'8bit)) |
|
'7bit |
|
|
'8bit)) |
|
|
(t |
|
|
;; Mule version |
|
|
(if (and (null (delq 'ascii |
|
|
(mm-find-charset-region (point-min) (point-max)))) |
|
|
;;!!!The following is necessary because the function |
|
|
;;!!!above seems to return the wrong result under |
|
|
;;!!!Emacs 20.3. Sometimes. |
|
|
(save-excursion |
|
|
(goto-char (point-min)) |
|
|
(skip-chars-forward mm-7bit-chars) |
|
|
(eobp))) |
|
|
'7bit |
|
|
'8bit)))) |
|
122 |
|
|
123 |
;;; |
;;; |
124 |
;;; Functions for decoding |
;;; Functions for decoding |
178 |
The characters in CHARSET should then be decoded." |
The characters in CHARSET should then be decoded." |
179 |
(if (stringp charset) |
(if (stringp charset) |
180 |
(setq charset (intern (downcase charset)))) |
(setq charset (intern (downcase charset)))) |
181 |
(if (or (not charset) |
(if (or (not charset) |
182 |
(eq 'gnus-all mail-parse-ignored-charsets) |
(eq 'gnus-all mail-parse-ignored-charsets) |
183 |
(memq 'gnus-all mail-parse-ignored-charsets) |
(memq 'gnus-all mail-parse-ignored-charsets) |
184 |
(memq charset mail-parse-ignored-charsets)) |
(memq charset mail-parse-ignored-charsets)) |
191 |
(if (and (not coding-system) |
(if (and (not coding-system) |
192 |
(listp mail-parse-ignored-charsets) |
(listp mail-parse-ignored-charsets) |
193 |
(memq 'gnus-unknown mail-parse-ignored-charsets)) |
(memq 'gnus-unknown mail-parse-ignored-charsets)) |
194 |
(setq coding-system |
(setq coding-system |
195 |
(mm-charset-to-coding-system mail-parse-charset))) |
(mm-charset-to-coding-system mail-parse-charset))) |
196 |
(when (and charset coding-system |
(when (and charset coding-system |
197 |
;; buffer-file-coding-system |
;; buffer-file-coding-system |
207 |
"Decode STRING with CHARSET." |
"Decode STRING with CHARSET." |
208 |
(when (stringp charset) |
(when (stringp charset) |
209 |
(setq charset (intern (downcase charset)))) |
(setq charset (intern (downcase charset)))) |
210 |
(when (or (not charset) |
(when (or (not charset) |
211 |
(eq 'gnus-all mail-parse-ignored-charsets) |
(eq 'gnus-all mail-parse-ignored-charsets) |
212 |
(memq 'gnus-all mail-parse-ignored-charsets) |
(memq 'gnus-all mail-parse-ignored-charsets) |
213 |
(memq charset mail-parse-ignored-charsets)) |
(memq charset mail-parse-ignored-charsets)) |
218 |
(if (and (not coding-system) |
(if (and (not coding-system) |
219 |
(listp mail-parse-ignored-charsets) |
(listp mail-parse-ignored-charsets) |
220 |
(memq 'gnus-unknown mail-parse-ignored-charsets)) |
(memq 'gnus-unknown mail-parse-ignored-charsets)) |
221 |
(setq coding-system |
(setq coding-system |
222 |
(mm-charset-to-coding-system mail-parse-charset))) |
(mm-charset-to-coding-system mail-parse-charset))) |
223 |
(when (and charset coding-system |
(when (and charset coding-system |
224 |
(mm-multibyte-p) |
(mm-multibyte-p) |