Preserve rich text formatting when replying to HTML emails

This commit is contained in:
Jeremy Dormitzer 2020-05-09 16:21:09 -04:00
parent 133123c058
commit 0bef06145f

View File

@ -4010,31 +4010,51 @@ Support sending rich-text emails via Markdown:
html
"<#/multipart>\n"))
(defvar *message-md-pandoc-html-template*
"<html>
<head>
<meta charset=\"utf-8\" />
</head>
<body>
$body$
</body>
</html>"
"The default template used when converting markdown to HTML via pandoc.")
(defun gfm->html (gfm &optional template)
"Converts GitHub-flavored markdown to HTML via pandoc.
By default, the template `*message-md-pandoc-html-template*' is used,
but this can be overridden with the TEMPLATE argument."
(unless (executable-find "pandoc")
(error "Pandoc not found, unable to convert"))
(let ((template-file (make-temp-file "gfm->html-template"
nil ".html"
(or template
,*message-md-pandoc-html-template*))))
(with-temp-buffer
(insert gfm)
(unless
(= 0
(call-process-region (point-min) (point-max) "pandoc" t t nil
"--template" template-file "--quiet"
"-f" "gfm" "-t" "html"))
(error "Markdown to HTML conversion failed: %s"
(buffer-substring (point-min) (point-max))))
(buffer-substring (point-min) (point-max)))))
(defun convert-message-to-markdown ()
"Convert the message in the current buffer to a multipart HTML email.
The HTML is rendered by treating the message content as Markdown."
(interactive)
(unless (executable-find "pandoc")
(error "Pandoc not found, unable to convert message"))
(let* ((begin
(save-excursion
(goto-char (point-min))
(search-forward mail-header-separator)))
(end (point-max))
(html-buf (generate-new-buffer "*mail-md-output*"))
(exit-code
(call-process-region begin end "pandoc" nil html-buf nil
"--quiet" "-f" "gfm" "-t" "html"))
(html (format "<html>\n<head></head>\n<body>\n%s\n</body></html>\n"
(with-current-buffer html-buf
(buffer-substring (point-min) (point-max)))))
(raw-body (buffer-substring begin end)))
(when (not (= exit-code 0))
(error "Markdown conversion failed, see %s" (buffer-name html-buf)))
(with-current-buffer html-buf
(set-buffer-modified-p nil)
(kill-buffer))
(raw-body (buffer-substring begin end))
(html (gfm->html raw-body)))
(undo-boundary)
(delete-region begin end)
(save-excursion
@ -4063,33 +4083,46 @@ Support sending rich-text emails via Markdown:
(define-key message-mode-map (kbd "C-c C-c") #'message-md-send-and-exit))
;; Handle replies to HTML emails as well
;; (defun message-yank-original-as-md (msg)
;; (let ((message-reply-buffer (generate-new-buffer " message-md-reply")))
;; (with-current-buffer message-reply-buffer
;; (insert (mu4e-msg-field msg :body-html)))
;; (message-yank-original)
;; (kill-buffer message-reply-buffer)))
(defun html->gfm (html)
(unless (executable-find "pandoc")
(error "Pandoc not found, unable to convert"))
(with-temp-buffer
(insert html)
(unless
(= 0
(call-process-region (point-min) (point-max) "pandoc" t t nil
"--quiet" "-f" "html" "-t" "gfm"))
(error "HTML to mardkwon conversion failed: %s"
(buffer-substring (point-min) (point-max))))
(buffer-substring (point-min) (point-max))))
;; (defun mu4e-draft-cite-original-advice (oldfn msg &rest args)
;; (if-let ((html (mu4e-msg-field msg :body-html)))
;; (with-temp-buffer
;; (when (fboundp 'mu4e-view-message-text) ;; keep bytecompiler happy
;; (let ((mu4e-view-date-format "%Y-%m-%dT%T%z"))
;; (insert (mu4e-view-message-text msg)))
;; (message-yank-original-as-md msg)
;; (goto-char (point-min))
;; (push-mark (point-max))
;; ;; set the the signature separator to 'loose', since in the real world,
;; ;; many message don't follow the standard...
;; (let ((message-signature-separator "^-- *$")
;; (message-signature-insert-empty-line t))
;; (funcall mu4e-compose-cite-function))
;; (pop-mark)
;; (goto-char (point-min))
;; (buffer-string)))
;; (apply oldfn msg args)))
(with-eval-after-load 'mu4e
(defvar message-md-rich-text-reply t)
(defvar message-md--inhibit-rich-text-reply nil)
;; (advice-add 'mu4e~draft-cite-original :around #'mu4e-draft-cite-original-advice)
(defun html-to-md-command (msg)
"Returns the text of MSG as Markdown."
(if (mu4e-msg-field msg :body-html)
(html->gfm (mu4e-msg-field msg :body-html))
(mu4e-msg-field msg :body-txt)))
(defun mu4e-draft-cite-original-advice (oldfn &rest args)
(let ((res (if (and message-md-rich-text-reply
(not message-md--inhibit-rich-text-reply))
(let ((mu4e-view-prefer-html t)
(mu4e-html2text-command #'html-to-md-command))
(apply oldfn args))
(apply oldfn args))))
(setq message-md--inhibit-rich-text-reply nil)
res))
(defun mu4e-compose-reply-advice (oldfn &rest args)
(when current-prefix-arg
(setq message-md--inhibit-rich-text-reply t))
(apply oldfn args))
(advice-add 'mu4e~draft-cite-original :around #'mu4e-draft-cite-original-advice)
(advice-add 'mu4e-compose-reply :around #'mu4e-compose-reply-advice))
#+END_SRC