;; 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 mu4e-update-mail-and-index)
  :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 "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")
               (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*
    "<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 "![%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)