(eval-and-compile
(or (fboundp 'base64-decode-region)
(require 'base64)))
(eval-when-compile
(defvar mm-uu-decode-function)
(defvar mm-uu-binhex-decode-function))
(require 'mm-util)
(require 'rfc2047)
(require 'mm-encode)
(defvar mm-7bit-chars "\x20-\x7f\r\n\t\x7\x8\xb\xc\x1f")
(defcustom mm-body-charset-encoding-alist
'((iso-2022-jp . 7bit)
(iso-2022-jp-2 . 7bit))
"Alist of MIME charsets to encodings.
Valid encodings are `7bit', `8bit', `quoted-printable' and `base64'."
:type '(repeat (cons (symbol :tag "charset")
(choice :tag "encoding"
(const 7bit)
(const 8bit)
(const quoted-printable)
(const base64))))
:group 'mime)
(defun mm-encode-body ()
"Encode a body.
Should be called narrowed to the body that is to be encoded.
If there is more than one non-ASCII MULE charset, then list of found
MULE charsets are returned.
If successful, the MIME charset is returned.
If no encoding was done, nil is returned."
(if (not (mm-multibyte-p))
(save-excursion
(goto-char (point-min))
(if (re-search-forward "[^\x0-\x7f]" nil t)
(or mail-parse-charset
(mm-read-charset "Charset used in the article: "))
nil))
(save-excursion
(goto-char (point-min))
(let ((charsets (mm-find-mime-charset-region (point-min) (point-max)))
charset)
(cond
((null charsets)
nil)
((> (length charsets) 1)
charsets)
(t
(let ((charset (car charsets))
start)
(when (or t
(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)))))))
(eval-when-compile (defvar message-posting-charset))
(defun mm-body-encoding (charset &optional encoding)
"Do Content-Transfer-Encoding and return the encoding of the current buffer."
(let ((bits (mm-body-7-or-8)))
(require 'message)
(cond
((and (not mm-use-ultra-safe-encoding) (eq bits '7bit))
bits)
((and (not mm-use-ultra-safe-encoding)
(or (eq t (cdr message-posting-charset))
(memq charset (cdr message-posting-charset))
(eq charset mail-parse-charset)))
bits)
(t
(let ((encoding (or encoding
(cdr (assq charset mm-body-charset-encoding-alist))
(mm-qp-or-base64))))
(when mm-use-ultra-safe-encoding
(setq encoding (mm-safer-encoding encoding)))
(mm-encode-content-transfer-encoding encoding "text/plain")
encoding)))))
(defun mm-body-7-or-8 ()
"Say whether the body is 7bit or 8bit."
(cond
((not (featurep 'mule))
(if (save-excursion
(goto-char (point-min))
(skip-chars-forward mm-7bit-chars)
(eobp))
'7bit
'8bit))
(t
(if (and (null (delq 'ascii
(mm-find-charset-region (point-min) (point-max))))
(save-excursion
(goto-char (point-min))
(skip-chars-forward mm-7bit-chars)
(eobp)))
'7bit
'8bit))))
(defun mm-decode-content-transfer-encoding (encoding &optional type)
(prog1
(condition-case error
(cond
((eq encoding 'quoted-printable)
(quoted-printable-decode-region (point-min) (point-max)))
((eq encoding 'base64)
(base64-decode-region
(point-min)
(save-excursion
(goto-char (point-min))
(while (re-search-forward "^[\t ]*\r?\n" nil t)
(delete-region (match-beginning 0) (match-end 0)))
(goto-char (point-max))
(when (re-search-backward "^[A-Za-z0-9+/]+=*[\t ]*$" nil t)
(forward-line)
(delete-region (point) (point-max)))
(point-max))))
((memq encoding '(7bit 8bit binary))
)
((null encoding)
)
((memq encoding '(x-uuencode x-uue))
(require 'mm-uu)
(funcall mm-uu-decode-function (point-min) (point-max)))
((eq encoding 'x-binhex)
(require 'mm-uu)
(funcall mm-uu-binhex-decode-function (point-min) (point-max)))
((functionp encoding)
(funcall encoding (point-min) (point-max)))
(t
(message "Unknown encoding %s; defaulting to 8bit" encoding)))
(error
(message "Error while decoding: %s" error)
nil))
(when (and
(memq encoding '(base64 x-uuencode x-uue x-binhex))
(equal type "text/plain"))
(goto-char (point-min))
(while (search-forward "\r\n" nil t)
(replace-match "\n" t t)))))
(defun mm-decode-body (charset &optional encoding type)
"Decode the current article that has been encoded with ENCODING.
The characters in CHARSET should then be decoded."
(if (stringp charset)
(setq charset (intern (downcase charset))))
(if (or (not charset)
(eq 'gnus-all mail-parse-ignored-charsets)
(memq 'gnus-all mail-parse-ignored-charsets)
(memq charset mail-parse-ignored-charsets))
(setq charset mail-parse-charset))
(save-excursion
(when encoding
(mm-decode-content-transfer-encoding encoding type))
(when (featurep 'mule)
(let ((coding-system (mm-charset-to-coding-system charset)))
(if (and (not coding-system)
(listp mail-parse-ignored-charsets)
(memq 'gnus-unknown mail-parse-ignored-charsets))
(setq coding-system
(mm-charset-to-coding-system mail-parse-charset)))
(when (and charset coding-system
(mm-multibyte-p)
(or (not (eq coding-system 'ascii))
(setq coding-system mail-parse-charset))
(not (eq coding-system 'gnus-decoded)))
(mm-decode-coding-region (point-min) (point-max) coding-system))))))
(defun mm-decode-string (string charset)
"Decode STRING with CHARSET."
(when (stringp charset)
(setq charset (intern (downcase charset))))
(when (or (not charset)
(eq 'gnus-all mail-parse-ignored-charsets)
(memq 'gnus-all mail-parse-ignored-charsets)
(memq charset mail-parse-ignored-charsets))
(setq charset mail-parse-charset))
(or
(when (featurep 'mule)
(let ((coding-system (mm-charset-to-coding-system charset)))
(if (and (not coding-system)
(listp mail-parse-ignored-charsets)
(memq 'gnus-unknown mail-parse-ignored-charsets))
(setq coding-system
(mm-charset-to-coding-system mail-parse-charset)))
(when (and charset coding-system
(mm-multibyte-p)
(or (not (eq coding-system 'ascii))
(setq coding-system mail-parse-charset)))
(mm-decode-coding-string string coding-system))))
string))
(provide 'mm-bodies)