1
0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-11-27 07:37:33 +00:00

Revert mml-generate-mime-1 (bug#27141)

* lisp/gnus/mml.el (mml-generate-mime-1): Reverted to emacs-25 version
with slight modernizations (bug#27141).
This commit is contained in:
Katsumi Yamaoka 2017-05-31 23:21:27 +00:00
parent ca3622bf2e
commit 8130d91095

View File

@ -606,38 +606,28 @@ be \"related\" or \"alternate\"."
(intern (downcase charset))))))
(if (and (not raw)
(member (car (split-string type "/")) '("text" "message")))
;; We have a text-like MIME part, so we need to do
;; charset encoding.
(progn
(with-temp-buffer
(set-buffer-multibyte nil)
;; First insert the data into the buffer.
(if (and filename
(not (equal (cdr (assq 'nofile cont)) "yes")))
(mm-insert-file-contents filename)
(insert
(with-temp-buffer
(cond
((cdr (assq 'buffer cont))
(insert-buffer-substring (cdr (assq 'buffer cont))))
((eq 'mml (car cont))
(insert (cdr (assq 'contents cont))))
(t
(insert (cdr (assq 'contents cont)))
;; Remove quotes from quoted tags.
(goto-char (point-min))
(while (re-search-forward
"<#!+/?\\(part\\|multipart\\|external\\|mml\\|secure\\)"
nil t)
(delete-region (+ (match-beginning 0) 2)
(+ (match-beginning 0) 3)))))
(setq charset
(mm-coding-system-to-mime-charset
(detect-coding-region
(point-min) (point-max) t)))
(encode-coding-region (point-min) (point-max)
charset)
(buffer-string))))
(cond
((cdr (assq 'buffer cont))
(insert-buffer-substring (cdr (assq 'buffer cont))))
((and filename
(not (equal (cdr (assq 'nofile cont)) "yes")))
(let ((coding-system-for-read coding))
(mm-insert-file-contents filename)))
((eq 'mml (car cont))
(insert (cdr (assq 'contents cont))))
(t
(save-restriction
(narrow-to-region (point) (point))
(insert (cdr (assq 'contents cont)))
;; Remove quotes from quoted tags.
(goto-char (point-min))
(while (re-search-forward
"<#!+/?\\(part\\|multipart\\|external\\|mml\\|secure\\)"
nil t)
(delete-region (+ (match-beginning 0) 2)
(+ (match-beginning 0) 3))))))
(cond
((eq (car cont) 'mml)
(let ((mml-boundary (mml-compute-boundary cont))
@ -665,7 +655,7 @@ be \"related\" or \"alternate\"."
;; actually are hard newlines in the text.
(let (use-hard-newlines)
(when (and mml-enable-flowed
(string= type "text/plain")
(string= type "text/plain")
(not (string= (cdr (assq 'sign cont)) "pgp"))
(or (null (assq 'format cont))
(string= (cdr (assq 'format cont))
@ -678,14 +668,13 @@ be \"related\" or \"alternate\"."
;; insert a "; format=flowed" string unless the
;; user has already specified it.
(setq flowed (null (assq 'format cont)))))
(unless charset
(setq charset
;; Prefer `utf-8' for text/calendar parts.
(if (string= type "text/calendar")
'utf-8
(mm-coding-system-to-mime-charset
(detect-coding-region
(point-min) (point-max) t)))))
;; Prefer `utf-8' for text/calendar parts.
(if (or charset
(not (string= type "text/calendar")))
(setq charset (mm-encode-body charset))
(let ((mm-coding-system-priorities
(cons 'utf-8 mm-coding-system-priorities)))
(setq charset (mm-encode-body))))
(setq encoding (mm-body-encoding
charset (cdr (assq 'encoding cont))))))
(setq coded (buffer-string)))
@ -696,26 +685,33 @@ be \"related\" or \"alternate\"."
(set-buffer-multibyte nil)
(cond
((cdr (assq 'buffer cont))
(insert (string-as-unibyte
(with-current-buffer (cdr (assq 'buffer cont))
(buffer-string)))))
;; multibyte string that inserted to a unibyte buffer
;; will be converted to the unibyte version safely.
(insert (with-current-buffer (cdr (assq 'buffer cont))
(buffer-string))))
((and filename
(not (equal (cdr (assq 'nofile cont)) "yes")))
(let ((coding-system-for-read mm-binary-coding-system))
(mm-insert-file-contents filename nil nil nil nil t)))
(mm-insert-file-contents filename nil nil nil nil t))
(unless charset
(setq charset (mm-coding-system-to-mime-charset
(mm-find-buffer-file-coding-system
filename)))))
(t
(let ((contents (cdr (assq 'contents cont))))
(if (multibyte-string-p contents)
(if (if (featurep 'xemacs)
(string-match "[^\000-\377]" contents)
(multibyte-string-p contents))
(progn
(mm-enable-multibyte)
(set-buffer-multibyte t)
(insert contents)
(unless raw
(setq charset (mm-encode-body charset))))
(insert contents)))))
(if (setq encoding (cdr (assq 'encoding cont)))
(setq encoding (intern (downcase encoding))))
(setq encoding (mm-encode-buffer type encoding)
coded (string-as-multibyte (buffer-string))))
(setq encoding (mm-encode-buffer type encoding))
(setq coded (decode-coding-string (buffer-string) 'us-ascii)))
(mml-insert-mime-headers cont type charset encoding nil)
(insert "\n" coded))))
((eq (car cont) 'external)