457 lines
18 KiB
EmacsLisp
457 lines
18 KiB
EmacsLisp
;; Email in Emacs via mu4e
|
|
(use-package mu4e
|
|
:straight (:host github :repo "djcb/mu" :files ("mu4e/*"))
|
|
:if (locate-library "mu4e")
|
|
:commands (mu4e mu4e-update-mail-and-index)
|
|
:hook (after-init . (lambda () (mu4e t)))
|
|
:general
|
|
(normal mu4e-headers-mode-map "t" #'mu4e-headers-mark-thread)
|
|
(normal mu4e-view-mode-map "t" #'mu4e-view-mark-thread)
|
|
:config
|
|
(setq
|
|
;; General
|
|
mu4e-maildir (expand-file-name "~/.mail")
|
|
mu4e-completing-read-function 'completing-read
|
|
mu4e-attachment-dir (expand-file-name "~/Downloads")
|
|
mu4e-change-filenames-when-moving t
|
|
user-mail-address "jeremy.dormitzer@gmail.com"
|
|
mu4e-view-show-images t
|
|
mu4e-headers-skip-duplicates t
|
|
mu4e-split-view 'horizontal
|
|
mail-user-agent 'mu4e-user-agent
|
|
;; Custom actions
|
|
mu4e-view-actions '(("capture message" . mu4e-action-capture-message)
|
|
("view as pdf" . mu4e-action-view-as-pdf)
|
|
("show this thread" . mu4e-action-show-thread)
|
|
("View in browser" . mu4e-action-view-in-browser))
|
|
;; Bookmarked searches
|
|
mu4e-bookmarks '((:name "Inbox"
|
|
:query "maildir:/jeremy-dormitzer-gmail-com/Inbox OR maildir:/jdormitzer-spotify-com/Inbox"
|
|
:key ?i)
|
|
(:name "Unread messages"
|
|
:query "flag:unread AND NOT flag:trashed"
|
|
:key ?u)
|
|
(:name "Today's messages"
|
|
:query "date:today..now"
|
|
:key ?t)
|
|
(:name "Last 7 days"
|
|
:query "date:7d..now"
|
|
:key ?p))
|
|
;; Getting mail
|
|
mu4e-get-mail-command "mbsync -a"
|
|
;; Sending mail
|
|
send-mail-function #'message-send-mail-with-sendmail
|
|
message-send-mail-function #'message-send-mail-with-sendmail
|
|
sendmail-program (or (executable-find "msmtp") (user-error "msmtp executable not found"))
|
|
;; Let Gmail handle putting sent messages in the sent folder
|
|
mu4e-sent-messages-behavior 'delete
|
|
;; Move to trash folder instead of adding trash flag for Gmail mailboxes
|
|
mu4e-move-to-trash-patterns '("jeremy-dormitzer-gmail-com")
|
|
;; HTML email rendering
|
|
shr-use-colors nil
|
|
;; Make sure mu4e knows about my different accounts
|
|
mu4e-context-policy 'pick-first
|
|
mu4e-compose-context-policy 'ask
|
|
mu4e-contexts
|
|
`(,(make-mu4e-context
|
|
:name "Spotify Gmail"
|
|
:match-func (lambda (msg)
|
|
(when msg
|
|
(string-match-p
|
|
"jdormitzer-spotify-com"
|
|
(mu4e-message-field msg :path))))
|
|
:vars '((user-mail-address . "jdormitzer@spotify.com")
|
|
(mu4e-compose-signature . nil)
|
|
(mu4e-sent-folder . "/jdormitzer-spotify-com/Sent")
|
|
(mu4e-drafts-folder . "/jdormitzer-spotify-com/Drafts")
|
|
(mu4e-refile-folder . "/jdormitzer-spotify-com/Archive")
|
|
(mu4e-trash-folder . "/jdormitzer-spotify-com/Trash")
|
|
(message-sendmail-extra-arguments
|
|
. ("-a" "jdormitzer-spotify-com"))))
|
|
,(make-mu4e-context
|
|
:name "Personal Gmail"
|
|
:match-func (lambda (msg)
|
|
(when msg
|
|
(string-match-p
|
|
"jeremy-dormitzer-gmail-com"
|
|
(mu4e-message-field msg :path))))
|
|
:vars '((user-mail-address . "jeremy.dormitzer@gmail.com")
|
|
(mu4e-compose-signature . nil)
|
|
(mu4e-sent-folder . "/jeremy-dormitzer-gmail-com/Sent")
|
|
(mu4e-drafts-folder . "/jeremy-dormitzer-gmail-com/Drafts")
|
|
(mu4e-refile-folder . "/jeremy-dormitzer-gmail-com/Archive")
|
|
(mu4e-trash-folder . "/jeremy-dormitzer-gmail-com/Trash")
|
|
(message-sendmail-extra-arguments
|
|
. ("-a" "jeremy-dormitzer-gmail-com"))))))
|
|
;; Custom mark function to mark messages matching the current message
|
|
(defun mu4e-mark-matching-from-pred (msg from)
|
|
(mu4e-message-contact-field-matches msg :from from))
|
|
|
|
(defun mu4e-mark-matching-from-input ()
|
|
(let* ((msg (mu4e-message-at-point t)))
|
|
(if (not msg)
|
|
(error "No message at point")
|
|
(-non-nil
|
|
(funcall
|
|
(-juxt (lambda (v) (plist-get v :name))
|
|
(lambda (v) (plist-get v :email)))
|
|
(car (mu4e-message-field msg :from)))))))
|
|
|
|
(setq mu4e-headers-custom-markers
|
|
'(("Older than"
|
|
(lambda
|
|
(msg date)
|
|
(time-less-p
|
|
(mu4e-msg-field msg :date)
|
|
date))
|
|
(lambda nil
|
|
(mu4e-get-time-date "Match messages before: ")))
|
|
("Newer than"
|
|
(lambda
|
|
(msg date)
|
|
(time-less-p date
|
|
(mu4e-msg-field msg :date)))
|
|
(lambda nil
|
|
(mu4e-get-time-date "Match messages after: ")))
|
|
("Bigger than"
|
|
(lambda
|
|
(msg bytes)
|
|
(>
|
|
(mu4e-msg-field msg :size)
|
|
(* 1024 bytes)))
|
|
(lambda nil
|
|
(read-number "Match messages bigger than (Kbytes): ")))
|
|
("Matching current message from: field"
|
|
mu4e-mark-matching-from-pred
|
|
mu4e-mark-matching-from-input)))
|
|
(add-hook 'mu4e-compose-pre-hook
|
|
(lambda ()
|
|
(set
|
|
(make-local-variable '*should-delete-trailing-whitespace*)
|
|
nil)))
|
|
;; For some reason mu4e--server-filter expects these to be defined, but doesn't define them
|
|
(when (null mu4e-info-func)
|
|
(setq mu4e-info-func (lambda (&rest args))))
|
|
;; Support sending attachments from Dired buffers
|
|
(with-eval-after-load 'dired
|
|
(require 'gnus-dired)
|
|
;; make the `gnus-dired-mail-buffers' function also work on
|
|
;; message-mode derived modes, such as mu4e-compose-mode
|
|
(defun gnus-dired-mail-buffers ()
|
|
"Return a list of active message buffers."
|
|
(let (buffers)
|
|
(save-current-buffer
|
|
(dolist (buffer (buffer-list t))
|
|
(set-buffer buffer)
|
|
(when (and (derived-mode-p 'message-mode)
|
|
(null message-sent-message-via))
|
|
(push (buffer-name buffer) buffers))))
|
|
(nreverse buffers)))
|
|
|
|
(setq gnus-dired-mail-mode 'mu4e-user-agent)
|
|
(add-hook 'dired-mode-hook 'turn-on-gnus-dired-mode))
|
|
|
|
;; A custom library to send HTML email with Markdown syntax
|
|
;; TODO move this to an actual external package?
|
|
(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 mml-node->str (node)
|
|
"Converts a parsed MML node back to an MML string."
|
|
(let ((node-name (car node))
|
|
(node-alist (cdr node)))
|
|
(format "<#%s%s>\n%s"
|
|
node-name
|
|
(cl-reduce (lambda (acc pair)
|
|
(if (equal (car pair) 'contents)
|
|
acc
|
|
(concat acc (format " %s=%S"
|
|
(car pair)
|
|
(cdr pair)))))
|
|
node-alist
|
|
:initial-value "")
|
|
(cdr (assoc 'contents node-alist))
|
|
node-name)))
|
|
|
|
(defun multipart-message-as-string (plain html inline attachments)
|
|
"Given MML nodes PLAIN, and HTML and MML node lists INLINE and
|
|
ATTACHMENTS, constructs a multipart MML email and returns it as a
|
|
string."
|
|
(let* ((alternative (concat "<#multipart type=alternative>\n"
|
|
(mml-node->str plain) "\n"
|
|
(mml-node->str html) "\n"
|
|
"<#/multipart>"))
|
|
(related (when inline
|
|
(concat "<#multipart type=related>\n"
|
|
alternative "\n"
|
|
(cl-reduce
|
|
(lambda (acc node)
|
|
(concat acc (mml-node->str node) "\n"))
|
|
inline
|
|
:initial-value "")
|
|
"<#/multipart>")))
|
|
(mixed (when attachments
|
|
(concat "<#multipart type=mixed>\n"
|
|
(or related alternative) "\n"
|
|
(cl-reduce
|
|
(lambda (acc node)
|
|
(concat acc (mml-node->str node) "\n"))
|
|
attachments
|
|
:initial-value "")
|
|
"<#/multipart>"))))
|
|
(or mixed related alternative)))
|
|
|
|
(defun assoc-mml-node (key node)
|
|
(cdr (assoc key (cdr node))))
|
|
|
|
(defun multipart-html-message (raw)
|
|
"Creates a multipart HTML email with a text part and an html part."
|
|
(with-temp-buffer
|
|
(insert raw)
|
|
(let* ((parsed (mml-parse))
|
|
(plain (cl-reduce
|
|
(lambda (acc node)
|
|
(if (not (equal (assoc-mml-node 'type node) "text/plain"))
|
|
acc
|
|
`(part (type . "text/plain")
|
|
(contents . ,(concat (cdaddr acc)
|
|
(cdaddr node))))))
|
|
parsed
|
|
:initial-value '(part (type . "text/plain")
|
|
(contents . ""))))
|
|
(html `(part (type . "text/html")
|
|
(contents . ,(gfm->html (cdaddr plain)))))
|
|
(inline (nreverse
|
|
(cl-reduce
|
|
(lambda (acc node)
|
|
(if (not (equal (assoc-mml-node 'disposition node)
|
|
"inline"))
|
|
acc
|
|
(cons node acc)))
|
|
parsed
|
|
:initial-value nil)))
|
|
(attachments (nreverse
|
|
(cl-reduce
|
|
(lambda (acc node)
|
|
(if (not (equal (assoc-mml-node 'disposition node)
|
|
"attachment"))
|
|
acc
|
|
(cons node acc)))
|
|
parsed
|
|
:initial-value nil))))
|
|
(multipart-message-as-string plain
|
|
html
|
|
inline
|
|
attachments))))
|
|
|
|
(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)
|
|
(let* ((begin
|
|
(save-excursion
|
|
(goto-char (point-min))
|
|
(search-forward mail-header-separator)))
|
|
(end (point-max))
|
|
(raw-body (buffer-substring begin end)))
|
|
(undo-boundary)
|
|
(delete-region begin end)
|
|
(save-excursion
|
|
(goto-char begin)
|
|
(newline)
|
|
(insert (multipart-html-message raw-body)))))
|
|
|
|
(defun message-md-send (&optional arg)
|
|
"Convert the current buffer and send it.
|
|
If given prefix arg ARG, skips markdown conversion."
|
|
(interactive "P")
|
|
(unless arg
|
|
(convert-message-to-markdown))
|
|
(message-send))
|
|
|
|
(defun message-md-send-and-exit (&optional arg)
|
|
"Convert the current buffer and send it, then exit from mail buffer.
|
|
If given prefix arg ARG, skips markdown conversion."
|
|
(interactive "P")
|
|
(unless arg
|
|
(convert-message-to-markdown))
|
|
(message-send-and-exit))
|
|
|
|
(with-eval-after-load 'message
|
|
(define-key message-mode-map (kbd "C-c C-s") #'message-md-send)
|
|
(define-key message-mode-map (kbd "C-c C-c") #'message-md-send-and-exit))
|
|
|
|
;; Handle replies to HTML emails as well
|
|
(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-native_divs-native_spans"
|
|
"-t" "gfm"))
|
|
(error "HTML to mardkwon conversion failed: %s"
|
|
(buffer-substring (point-min) (point-max))))
|
|
(buffer-substring (point-min) (point-max))))
|
|
|
|
(with-eval-after-load 'mu4e
|
|
(defvar message-md-rich-text-reply t)
|
|
(defvar message-md--inhibit-rich-text-reply nil)
|
|
|
|
(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))
|
|
|
|
;; Add an "X-Attachment-Id" header to MIME stuff as well as a Content-Id:
|
|
(with-eval-after-load 'mml
|
|
(defun mml-insert-mime-headers (cont type charset encoding flowed)
|
|
(let (parameters id disposition description)
|
|
(setq parameters
|
|
(mml-parameter-string
|
|
cont mml-content-type-parameters))
|
|
(when (or charset
|
|
parameters
|
|
flowed
|
|
(not (equal type mml-generate-default-type))
|
|
mml-insert-mime-headers-always)
|
|
(when (consp charset)
|
|
(error
|
|
"Can't encode a part with several charsets"))
|
|
(insert "Content-Type: " type)
|
|
(when charset
|
|
(mml-insert-parameter
|
|
(mail-header-encode-parameter "charset" (symbol-name charset))))
|
|
(when flowed
|
|
(mml-insert-parameter "format=flowed"))
|
|
(when parameters
|
|
(mml-insert-parameter-string
|
|
cont mml-content-type-parameters))
|
|
(insert "\n"))
|
|
(when (setq id (cdr (assq 'id cont)))
|
|
(insert "Content-ID: " id "\n"))
|
|
(when (setq x-attachment-id (cdr (assq 'x-attachment-id cont)))
|
|
(insert "X-Attachment-Id: " x-attachment-id "\n"))
|
|
(setq parameters
|
|
(mml-parameter-string
|
|
cont mml-content-disposition-parameters))
|
|
(when (or (setq disposition (cdr (assq 'disposition cont)))
|
|
parameters)
|
|
(insert "Content-Disposition: "
|
|
(or disposition
|
|
(mml-content-disposition type (cdr (assq 'filename cont)))))
|
|
(when parameters
|
|
(mml-insert-parameter-string
|
|
cont mml-content-disposition-parameters))
|
|
(insert "\n"))
|
|
(unless (eq encoding '7bit)
|
|
(insert (format "Content-Transfer-Encoding: %s\n" encoding)))
|
|
(when (setq description (cdr (assq 'description cont)))
|
|
(insert "Content-Description: ")
|
|
(setq description (prog1
|
|
(point)
|
|
(insert description "\n")))
|
|
(mail-encode-encoded-word-region description (point))))))
|
|
|
|
(defun message-md-insert-inline-image (image type description)
|
|
(interactive
|
|
(let* ((file (mml-minibuffer-read-file "Insert image: "))
|
|
(type (if current-prefix-arg
|
|
(or (mm-default-file-encoding file)
|
|
"application/octet-stream")
|
|
(mml-minibuffer-read-type file)))
|
|
(description (if current-prefix-arg
|
|
nil
|
|
(mml-minibuffer-read-description))))
|
|
(list file type description)))
|
|
(let ((id (format "%s%s" (s-snake-case description) (random))))
|
|
(insert (format "" description id))
|
|
(save-excursion
|
|
(goto-char (point-max))
|
|
(newline)
|
|
(insert
|
|
(format (concat "<#part id=\"<%s>\" x-attachment-id=%S "
|
|
"type=%S filename=%S disposition=inline description=%s>")
|
|
id id type image description)))))
|
|
|
|
|
|
;; The default message signature begins with "-- \n". To makes this
|
|
;; markdown compatible, we need to add an extra space at the end: "-- \n"
|
|
(defun message-md-add-space-to-sig-separator (&rest args)
|
|
(save-excursion
|
|
(when (search-backward "--" nil t)
|
|
(forward-char 2)
|
|
(insert " "))))
|
|
|
|
(advice-add 'message-insert-signature :after
|
|
#'message-md-add-space-to-sig-separator)
|
|
|
|
;; A patch to shr to make it render links correctly
|
|
(with-eval-after-load 'shr
|
|
(defun shr-add-font (start end type)
|
|
(save-excursion
|
|
(goto-char start)
|
|
(while (< (point) end)
|
|
(when (bolp)
|
|
(skip-chars-forward " "))
|
|
;; Remove the APPEND argument to add-face-text-property
|
|
;; so the face ends up at the head of the face list
|
|
(add-face-text-property (point) (min (line-end-position) end) type)
|
|
(if (< (line-end-position) end)
|
|
(forward-line 1)
|
|
(goto-char end)))))))
|
|
|
|
(provide 'init-email)
|