Mu4e customization

(require 'mu4e)

(setq mu4e-trash-folder nil ;; must be configured later by context
      mu4e-drafts-folder nil ;; must be configured later by context
      mu4e-sent-folder nil ;; must be configured later by context
      mu4e-compose-reply-to-address nil ;; must be configured later by context
      mu4e-compose-signature nil ;; must be configured later by context
      mu4e-get-mail-command "offlineimap"
      mu4e-update-interval nil ;; in seconds or nil to desactivate
      mu4e-index-update-in-background t ;; nil to update in foreground
      mu4e-confirm-quit nil
      message-kill-buffer-on-exit t
      mail-user-agent 'mu4e-user-agent
      mml-secure-openpgp-sign-with-sender t
      mml-secure-openpgp-encrypt-to-self t
      message-send-mail-function 'smtpmail-send-it
      mu4e-view-show-addresses t
      mu4e-headers-include-related t
      mu4e-headers-skip-duplicates t
      mu4e-compose-dont-reply-to-self t
      mu4e-split-view 'horizontal
      mu4e-compose-crypto-reply-policy 'sign-and-encrypt
      ;;mu4e-html2text-command "html2text -utf8 -nobs -width 72"
      mu4e-html2text-command "w3m -dump -T text/html -cols 72 -o display_link_number=true -o auto_image=false -o display_image=false -o ignore_null_img_alt=true"
      mu4e-headers-date-format "%d/%m/%Y"
      mu4e-headers-time-format "%H:%M"
      message-citation-line-format "%a %d %b %Y à %R, %n a écrit:\n"
      message-citation-line-function 'message-insert-formatted-citation-line
      ;; thread prefix marks
      mu4e-headers-has-child-prefix '("."  . "◼ ")
      mu4e-headers-default-prefix '(" "  . "│ ")
      mu4e-context-policy 'pick-first
      mu4e-compose-context-policy 'ask)

;;;
;;; Various utility functions
;;;

(defun ed/preview-some-mail-at (path)
  (interactive "fPath: ")
  (call-process
   "mu" nil
   (switch-to-buffer (generate-new-buffer "*mail preview*") t)
   t "view" (expand-file-name path))
  (with-current-buffer "*mail preview*"
    (goto-char (point-min))
    (mu4e~fontify-cited)
    (mu4e~fontify-signature)
    (while (re-search-forward "^\\(\\w+:\\) \\(.*\\)$" nil t)
      (let ((key (match-string 1))
            (value (match-string 2)))
        (beginning-of-line)
        (delete-region (point) (line-end-position))
        (insert (concat (propertize key 'face 'mu4e-header-key-face) " "))
        (if (or (string= key "From:")
                (string= key "To:"))
            (insert (propertize value 'face 'mu4e-special-header-value-face))
          (insert (propertize value 'face 'mu4e-header-value-face)))))
    (forward-line)
    (beginning-of-line)
    (insert "\n")
    (read-only-mode)
    (local-set-key "q" 'kill-this-buffer)))

;;; message view action
(defun mu4e-msgv-action-view-in-browser (msg)
  "View the body of the message in a web browser."
  (interactive)
  (let ((html (mu4e-msg-field (mu4e-message-at-point t) :body-html))
        (tmpfile (format "%s/%d.html" temporary-file-directory (random))))
    (unless html (error "No html part for this message"))
    (with-temp-file tmpfile
      (insert
       "<html>"
       "<head><meta http-equiv=\"content-type\""
       "content=\"text/html;charset=UTF-8\">"
       html))
    (browse-url-firefox (concat "file://" tmpfile))))
(add-to-list 'mu4e-view-actions
             '("View in browser" . mu4e-msgv-action-view-in-browser) t)

(defun ed/get-mail-header (header-name path)
  (replace-regexp-in-string
   "[ \t\n]*$"
   ""
   (shell-command-to-string
    (concat "/usr/bin/sed -n '/^" header-name ":/I{:loop t;h;n;/^ /{H;x;s/\\n//;t loop};x;p}' '" path "' | sed -n 's/^" header-name ": \\(.*\\)$/\\1/Ip'"))))

(defun ed/get-openpgp-header (msg)
  (let ((path (or (mu4e-message-field msg :path) "")))
    (if (or (string= path "")
            (not (file-readable-p path)))
        "Mail file is not accessible"
      (ed/get-mail-header "openpgp" path))))

(defun ed/get-origin-mail-system-header (msg)
  (let ((path (or (mu4e-message-field msg :path) "")))
    (if (or (string= path "")
            (not (file-readable-p path)))
        "no path found"
      (let ((xmailer (ed/get-mail-header "x-mailer" path))
            (useragent (ed/get-mail-header "user-agent" path)))
        (if (string= xmailer useragent)
            xmailer
          (cond
           ((string= xmailer "") useragent)
           ((string= useragent "") xmailer)
           (t (concat xmailer " (xmailer)\n" useragent " (user-agent)"))))))))


(defvar ed/gpg-pub-keys nil)
(defun ed/insert-gpg-headers (sign-or-encrypt)
  (save-excursion
    (goto-char (point-min))
    (let ((pgp-info
           (cdr (assoc (mu4e-context-name (mu4e-context-current))
                       ed/gpg-pub-keys))))
      (when pgp-info
        (insert "Openpgp: " pgp-info)
        (if (string= sign-or-encrypt "encrypt")
            (mml-secure-message-sign-encrypt)
          (mml-secure-message-sign))))))

(defun ed/sign-this-message ()
  "Insert mml gpg command and gnupg header"
  (interactive)
  (ed/insert-gpg-headers "sign"))

(defun ed/encrypt-this-message ()
  "Insert mml gpg command and gnupg header"
  (interactive)
  (ed/insert-gpg-headers "encrypt"))

(defun ed/decrypt_attachment (msg attachnum)
  "Decrypt mail when encrypted part is attached."
  (mu4e-view-pipe-attachment msg attachnum "~/Applis/divers/gpg_mail_decrypt"))

(add-to-list 'mu4e-view-attachment-actions
             '("ddecrypt mail" . ed/decrypt_attachment) t)

(defun decrypt-inline-pgp ()
  "Decrypt a PGP MESSAGE block in the current buffer."
  (interactive)
  (save-excursion
    (let* ((pm (point-max))
           (beg (progn (re-search-forward "^-----BEGIN PGP MESSAGE-----$" pm t 1)
                       (match-beginning 0)))
           (end (re-search-forward "^-----END PGP MESSAGE-----$" pm t 1)))
      (if (and beg end)
          (epa-decrypt-region beg end)
        (message "No encrypted region found.")))))

(add-to-list 'mu4e-view-actions
             '("Decrypt inline PGP" . decrypt-inline-pgp) t)


;;;
;;; Multi-identity related functions
;;;

(defun ed/get-signature-for (email-addr)
  "Return the right signature for the given email"
  (let ((sig-path
         (cdr (assoc email-addr ed/signature-path))))
    (unless sig-path
      (setq sig-path ed/default-signature-path))
    (with-temp-buffer
      (insert-file-contents sig-path)
      (buffer-string))))

;;;
;;; Some custom headers
;;;

(add-to-list 'mu4e-header-info-custom
             '(:acctshortname . (:name "Account short name"
                                       :shortname "Acct"
                                       :help "3 first letter of related root maildir"
                                       :function (lambda (msg)
                                                   (let ((account-name (or (mu4e-message-field msg :maildir) "")))
                                                     (if (string= account-name "")
                                                         ""
                                                       (substring
                                                        (replace-regexp-in-string "^/\\(\\w+\\)/.*$" "\\1" account-name)
                                                        0 3)))))))
(add-to-list 'mu4e-header-info-custom
             '(:foldername . (:name "Folder information"
                                    :shortname "Folder"
                                    :help "Message short storage information"
                                    :function (lambda (msg)
                                                (let ((shortaccount)
                                                      (maildir (or (mu4e-message-field msg :maildir) ""))
                                                      (mailinglist (or (mu4e-message-field msg :mailing-list) "")))
                                                  (if (not (string= mailinglist ""))
                                                      (setq mailinglist (mu4e-get-mailing-list-shortname mailinglist)))
                                                  (when (not (string= maildir ""))
                                                    (setq shortaccount
                                                          (substring
                                                           (replace-regexp-in-string "^/\\(\\w+\\)/.*$" "\\1" maildir)
                                                           0 3))
                                                    (setq maildir (replace-regexp-in-string ".*/\\([^/]+\\)$" "\\1" maildir))
                                                    (if (> (length maildir) 8)
                                                        (setq maildir (concat (substring maildir 0 7) "…")))
                                                    (setq maildir (concat "[" shortaccount "]" maildir)))
                                                  (cond
                                                   ((and (string= maildir "")
                                                         (not (string= mailinglist "")))
                                                    mailinglist)
                                                   ((and (not (string= maildir ""))
                                                         (string= mailinglist ""))
                                                    maildir)
                                                   ((and (not (string= maildir ""))
                                                         (not (string= mailinglist "")))
                                                    (concat maildir " (" mailinglist ")"))
                                                   (t
                                                    "")))))))



(add-to-list 'mu4e-header-info-custom
             '(:useragent . (:name "User-Agent"
                                   :shortname "UserAgt."
                                   :help "Mail client used by correspondant"
                                   :function ed/get-origin-mail-system-header)))
(add-to-list 'mu4e-header-info-custom
             '(:openpgp . (:name "PGP Info"
                                 :shortname "PGP"
                                 :help "OpenPGP information found in mail header"
                                 :function ed/get-openpgp-header)))
(setq mu4e-view-fields '(:from :to  :cc :subject :flags :date :maildir
                               :mailing-list :tags :useragent :attachments
                               :openpgp :signature :decryption)
      mu4e-headers-fields '((:flags         . 5)
                            (:human-date    . 12)
                            ;(:acctshortname . 4)
                            (:foldername    . 25)
                            (:from-or-to    . 25)
                            (:size          . 6)
                            (:subject       . nil))
      mu4e-compose-hidden-headers '("^Face:" "^X-Face:" "^Openpgp:"
                                    "^X-Draft-From:" "^X-Mailer:"
                                    "^User-agent:"))


;;;
;;; Finally set some hooks
;;;

(add-hook 'mu4e-compose-mode-hook
          (lambda ()
            (set-fill-column 72)
            (local-set-key (kbd "C-c <return> C-s") 'ed/sign-this-message)
            (local-set-key (kbd "C-c <return> C-e") 'ed/encrypt-this-message)
            (save-excursion
              (goto-char (point-min))
              (insert "X-Mailer: mu4e " mu4e-mu-version "; emacs " emacs-version "\n"))))

(defun ed/all-possible-dests ()
  "Return the list of all possible dest addresses for an email"
  (let ((to (save-excursion
              (goto-char (point-min))
              (when (re-search-forward "^To: \\(.*\\)$" nil t)
                (match-string-no-properties 1))))
        (cc (save-excursion
              (goto-char (point-min))
              (when (re-search-forward "^Cc: \\(.*\\)$" nil t)
                (match-string-no-properties 1)))))
    (mapcar #'(lambda (str)
                (replace-regexp-in-string "[[:space:]]" "" str))
            (split-string (concat to ", " cc) ","))))

(defun ed/filter-to-and-cc ()
  "Prepare To: and Cc: address field

This function will reorder To and Cc fields when one of the dest is a
mailing list subscription"
  (when mu4e-compose-parent-message
    (let ((listdest
           (mapconcat
            'identity
            (delq nil
                  (mapcar
                   #'(lambda (addr)
                       (if (mu4e-message-contact-field-matches
                            mu4e-compose-parent-message
                            '(:to :cc)
                            addr) addr nil))
                   my-mailing-list-subscriptions))
            ", "))
          (otherdests
           (mapconcat
            'identity
            (delq nil
                  (mapcar
                   #'(lambda (addr)
                       (if (member addr my-mailing-list-subscriptions) nil addr))
                   (ed/all-possible-dests)))
            ", ")))
      (unless (string= listdest "")
        (save-excursion
          (goto-char (point-min))
          (re-search-forward "^Reply-to:")
          (kill-whole-line)
          (when (message-goto-to) ;; reset to-address, if needed
            (kill-whole-line))
          (message-add-header (concat "To: " listdest "\n"))
          ;; reset cc-address, as it has been
          ;; concatenated with to-address
          (when (message-goto-cc)
            (kill-whole-line))
          (message-add-header (concat "Cc: " otherdests "\n"))
          ;; remove cc line if it's empty
          (goto-char (point-min))
          (when (re-search-forward "^Cc:[[:space:]]*$" nil t)
            (kill-whole-line)))))))

(defvar my-mailing-list-subscriptions)
(add-hook 'mu4e-compose-mode-hook 'ed/filter-to-and-cc)

;; Waiting for mu4e to be shiped with this
(add-hook 'mu4e-compose-mode-hook
          (lambda ()
            (let ((msg mu4e-compose-parent-message))
              (when msg
                (cond
                 ((member 'encrypted (mu4e-message-field msg :flags))
                  (ed/encrypt-this-message))
                 ((member 'signed (mu4e-message-field msg :flags))
                  (ed/sign-this-message)))))))

(add-hook 'mu4e-compose-mode-hook 'flyspell-mode)
(add-hook 'mu4e-compose-mode-hook 'epa-mail-mode)
(add-hook 'mu4e-view-mode-hook 'epa-mail-mode)
(add-hook 'mu4e-view-mode-hook 'mu4e-view-fill-long-lines)

;; Be sure to only delete, not push to Trash
(add-hook 'mu4e-headers-mode-hook
          (lambda ()
            (local-set-key (kbd "<backspace>") 'mu4e-headers-mark-for-delete)
            (local-set-key (kbd "d") 'mu4e-headers-mark-for-delete)
            (local-set-key (kbd "D") 'mu4e-headers-mark-for-trash)))

(global-set-key [f5] 'mu4e)