Preserve rich text formatting when replying to HTML emails
This commit is contained in:
parent
133123c058
commit
0bef06145f
113
emacs/init.org
113
emacs/init.org
@ -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
|
||||
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user