(eval-and-compile
(or (fboundp 'base64-decode-region)
- (require 'base64))
- (autoload 'binhex-decode-region "binhex"))
+ (require 'base64)))
+
+(eval-when-compile
+ (defvar mm-uu-decode-function)
+ (defvar mm-uu-binhex-decode-function))
(require 'mm-util)
(require 'rfc2047)
-(require 'qp)
-(require 'uudecode)
+(require 'mm-encode)
;; 8bit treatment gets any char except: 0x32 - 0x7f, CR, LF, TAB, BEL,
;; BS, vertical TAB, form feed, and ^_
(const base64))))
:group 'mime)
-(defun mm-encode-body ()
+(defun mm-encode-body (&optional charset)
"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 CHARSET is non-nil, it is used.
If successful, the MIME charset is returned.
If no encoding was done, nil is returned."
- (if (not (featurep 'mule))
+ (if (not (mm-multibyte-p))
;; In the non-Mule case, we search for non-ASCII chars and
- ;; return the value of `mm-default-charset' if any are found.
- (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: "))
- ;; The logic in `mml-generate-mime-1' confirms that it's OK
- ;; to return nil here.
- nil))
+ ;; return the value of `mail-parse-charset' if any are found.
+ (or charset
+ (save-excursion
+ (goto-char (point-min))
+ (if (re-search-forward "[^\x0-\x7f]" nil t)
+ (or mail-parse-charset
+ (message-options-get 'mm-encody-body-charset)
+ (message-options-set
+ 'mm-encody-body-charset
+ (mm-read-charset "Charset used in the article: ")))
+ ;; The logic in `mml-generate-mime-1' confirms that it's OK
+ ;; to return nil here.
+ nil)))
(save-excursion
- (goto-char (point-min))
- (let ((charsets (mm-find-mime-charset-region (point-min) (point-max)))
+ (if charset
+ (progn
+ (mm-encode-coding-region (point-min) (point-max) charset)
charset)
- (cond
- ;; No encoding.
- ((null charsets)
- nil)
- ;; Too many charsets.
- ((> (length charsets) 1)
- charsets)
- ;; We encode.
- (t
- (let ((charset (car charsets))
- start)
- (when (or t
- ;; We always decode.
- (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) charset)
- (goto-char (point-max)))
- (setq start nil))
- (unless start
- (setq start (point))))
- (forward-char 1))
- (when start
- (mm-encode-coding-region start (point) charset)
- (setq start nil)))
+ (goto-char (point-min))
+ (let ((charsets (mm-find-mime-charset-region (point-min) (point-max)))
+ start)
+ (cond
+ ;; No encoding.
+ ((null charsets)
+ nil)
+ ;; Too many charsets.
+ ((> (length charsets) 1)
+ charsets)
+ ;; We encode.
+ (t
+ (setq charset (car charsets))
+ (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)))))))
+(defun mm-long-lines-p (length)
+ "Say whether any of the lines in the buffer is longer than LINES."
+ (save-excursion
+ (goto-char (point-min))
+ (end-of-line)
+ (while (and (not (eobp))
+ (not (> (current-column) length)))
+ (forward-line 1)
+ (end-of-line))
+ (and (> (current-column) length)
+ (current-column))))
+
+(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)))
+ (let ((bits (mm-body-7-or-8))
+ (longp (mm-long-lines-p 1000)))
+ (require 'message)
(cond
- ((eq bits '7bit)
+ ((and (not mm-use-ultra-safe-encoding)
+ (not longp)
+ (eq bits '7bit))
bits)
((and (not mm-use-ultra-safe-encoding)
+ (not longp)
(or (eq t (cdr message-posting-charset))
(memq charset (cdr message-posting-charset))
(eq charset mail-parse-charset)))
;; have been added by mailing list software.
(save-excursion
(goto-char (point-min))
- (if (re-search-forward "^[\t ]*$" nil t)
- (delete-region (point) (point-max))
- (goto-char (point-max)))
- (skip-chars-backward "\n\t ")
- (delete-region (point) (point-max))
+ (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))
(point))))
((memq encoding '(7bit 8bit binary))
;; Do nothing.
;; Do nothing.
)
((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)))
(when encoding
(mm-decode-content-transfer-encoding encoding type))
(when (featurep 'mule)
- (let ((mule-charset (mm-charset-to-coding-system charset)))
- (if (and (not mule-charset)
+ (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 mule-charset
+ (setq coding-system
(mm-charset-to-coding-system mail-parse-charset)))
- (when (and charset mule-charset
+ (when (and charset coding-system
;; buffer-file-coding-system
;;Article buffer is nil coding system
;;in XEmacs
(mm-multibyte-p)
- (or (not (eq mule-charset 'ascii))
- (setq mule-charset mail-parse-charset))
- (not (eq mule-charset 'gnus-decoded)))
- (mm-decode-coding-region (point-min) (point-max) mule-charset))))))
+ (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."
- (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))
+ (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 ((mule-charset (mm-charset-to-coding-system charset)))
- (if (and (not mule-charset)
+ (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 mule-charset
+ (setq coding-system
(mm-charset-to-coding-system mail-parse-charset)))
- (when (and charset mule-charset
+ (when (and charset coding-system
(mm-multibyte-p)
- (or (not (eq mule-charset 'ascii))
- (setq mule-charset mail-parse-charset)))
- (mm-decode-coding-string string mule-charset))))
+ (or (not (eq coding-system 'ascii))
+ (setq coding-system mail-parse-charset)))
+ (mm-decode-coding-string string coding-system))))
string))
(provide 'mm-bodies)