diff --git a/emacs/.emacs.d/config/init-email.el b/emacs/.emacs.d/config/init-email.el new file mode 100644 index 0000000..d8780ac --- /dev/null +++ b/emacs/.emacs.d/config/init-email.el @@ -0,0 +1,460 @@ +;; Email in Emacs via mu4e +(use-package mu4e + ;; mu4e is not actually built-in, but it is installed outside of normal Emacs package management + :straight (:type built-in) + :if (locate-library "mu4e") + :commands mu4e + :general + (normal mu4e-headers-mode-map "t" #'mu4e-headers-mark-thread) + (normal mu4e-view-mode-map "t" #'mu4e-view-mark-thread) + :config + (evil-collection-mu4e-setup) + (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 + 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 (concat "maildir:/jeremy-dormitzer-gmail-com/Inbox" + " OR maildir:/jeremydormitzer-lola-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 (executable-find "msmtp") + ;; 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" "jeremydormitzer-lola-com") + ;; HTML email rendering + shr-use-colors nil + ;; Make sure mu4e knows about my different accounts + mu4e-context-policy 'ask + mu4e-compose-context-policy 'ask + mu4e-contexts + `(,(make-mu4e-context + :name "Lola Gmail" + :match-func (lambda (msg) + (when msg + (or + (mu4e-message-contact-field-matches msg + :to + "lola.com") + (string-match-p + "jeremydormitzer-lola-com" + (mu4e-message-field msg :path))))) + :vars '((user-mail-address . "jeremydormitzer@lola.com") + (mu4e-compose-signature . "Best regards, \nJeremy Dormitzer \nLola.com") + (message-signature-insert-empty-line . t) + (mu4e-sent-folder . "/jeremydormitzer-lola-com/Sent") + (mu4e-drafts-folder . "/jeremydormitzer-lola-com/Drafts") + (mu4e-refile-folder . "/jeremydormitzer-lola-com/Archive") + (mu4e-trash-folder . "/jeremydormitzer-lola-com/Trash") + (message-sendmail-extra-arguments + . ("-a" "jeremydormitzer-lola-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-pred (msg from) + (mu4e-message-contact-field-matches msg :from from)) + + (defun mu4e-mark-matching-input () + (let* ((msg (mu4e-message-at-point t))) + (if (not msg) + (error "No message at point") + (cdr (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" + (lambda (msg from) + (mu4e-message-contact-field-matches msg :from from)) + (lambda () + (let* ((msg (mu4e-message-at-point t))) + (if (not msg) + (error "No message at point") + (cdar (mu4e-message-field msg :from)))))))) + (add-hook 'mu4e-compose-pre-hook + (lambda () + (set + (make-local-variable '*should-delete-trailing-whitespace*) + nil))) + ;; 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* + " + + + + + $body$ + +" + "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 "![%s](cid:%s)" 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) diff --git a/emacs/.emacs.d/init.el b/emacs/.emacs.d/init.el index 734a797..a6ec2c4 100644 --- a/emacs/.emacs.d/init.el +++ b/emacs/.emacs.d/init.el @@ -79,6 +79,7 @@ (require 'init-aws) (require 'init-prodigy) (require 'init-direnv) +(require 'init-email) ;; Load the custom file (when (file-exists-p custom-file)