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

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

Browse Source 
* 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
1 changed files with 43 additions and 47 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

90
lisp/gnus/mml.el
View File

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