Mu4e customization

(autoload 'mu4e "/usr/share/emacs/site-lisp/mu4e/mu4e"
  "Start mu4e daemon and show its main window." t)

(global-set-key (kbd "<f5>") #'mu4e)

(with-eval-after-load 'mu4e
  ;; Only if mu4e.elc has not been already loaded
  (unless (fboundp 'ed/compose-new-mail)
    (let ((gc-cons-threshold most-positive-fixnum))
      (load (expand-file-name "mu4e" user-emacs-directory)))))

(setq mu4e-attachment-dir "~/Téléchargements"
      mu4e-compose-complete-only-after "2012-01-01"
      mu4e-compose-context-policy 'ask
      mu4e-compose-crypto-reply-policy 'sign-and-encrypt
      mu4e-compose-dont-reply-to-self t
      mu4e-compose-format-flowed t
      mu4e-compose-reply-to-address nil ;; will be configured later by context
      mu4e-compose-signature nil ;; will be configured later by context
      mu4e-confirm-quit nil
      mu4e-context-policy 'pick-first
      mu4e-drafts-folder nil ;; will be configured later by context
      mu4e-get-mail-command "offlineimap -o -u quiet"
      mu4e-headers-date-format "%d/%m/%Y"
      mu4e-headers-include-related t
      mu4e-headers-skip-duplicates t
      mu4e-headers-thread-child-prefix '("L " . "│ ")
      mu4e-headers-thread-connection-prefix '("| " . "│ ")
      mu4e-headers-thread-duplicate-prefix '("= " . "≡ ")
      mu4e-headers-thread-first-child-prefix '("L " . "⚬ ")
      mu4e-headers-thread-last-child-prefix '("L " . "└ ")
      mu4e-headers-time-format "%R"
      mu4e-hide-index-messages t
      ;;mu4e-html2text-command "html2text -utf8 -nobs -width 72"
      mu4e-html2text-command "w3m -dump -T text/html -cols 80 -o display_link_number=true -o auto_image=false -o display_image=false -o ignore_null_img_alt=true"
      mu4e-split-view 'horizontal
      mu4e-trash-folder nil ;; will be configured later by context
      mu4e-update-interval 600 ;; in seconds or nil to desactivate
      mu4e-view-show-addresses t)

(defvar ed/mu4e~original-message)

(defun ed/message-insert-citation-line (&optional from date _tz)
  (when ed/mu4e~original-message
    (unless date
      (setq date (mu4e-message-field ed/mu4e~original-message :date)))
    ;;(unless from
    ;;  (pcase-let ((`(,name . ,email) (car (mu4e-message-field ed/mu4e~original-message :from))))
    ;;    (setq from (format "%s <%s>" name email))))
    (message-insert-formatted-citation-line from date)))

(defun ed/mu4e-setup-original-message ()
  "Put `mu4e-compose-parent-message' in `ed/mu4e~original-message'.

Because the parent message is lost when it become usefull for inserting
citation line."
  (when (member mu4e-compose-type '(reply forward))
    (setq ed/mu4e~original-message mu4e-compose-parent-message)))

(defun ed/mu4e-reset-original-message ()
  "Reset `ed/mu4e~original-message' to avoid weird thing."
  (setq ed/mu4e~original-message nil))

(add-hook 'mu4e-compose-pre-hook #'ed/mu4e-setup-original-message)
(add-hook 'mu4e-compose-mode-hook #'ed/mu4e-reset-original-message)

(setq gnus-inhibit-images t
      gnus-article-date-headers 'user-defined
      gnus-article-time-format "%A %d %B %Y à %R"
      gnus-cite-attribution-suffix "\\(\\(a écrit[  ]?\\|wrote\\|writes\\|said\\|says\\|>\\)\\(:\\|\\.\\.\\.\\)\\|----- ?Original Message ?-----\\)[ \t]*$"
      gnus-header-face-alist '(("From" nil gnus-header-from)
                               ("Subject" nil gnus-header-subject)
                               ("Newsgroups:.*," nil gnus-header-newsgroups)
                               ("To:" nil gnus-header-from)
                               ("Flags:" nil font-lock-builtin-face)
                               ("" gnus-header-name gnus-header-content))
      gnus-sorted-header-list '("^From:" "^Reply-To:" "^To:" "^Cc:" "^Subject"
                                "^Date:" "^Flags:")
      mail-user-agent 'mu4e-user-agent
      message-cite-reply-position 'below
      message-citation-line-format "%a %d %b %Y à %R, %n a écrit :\n"
      message-citation-line-function #'ed/message-insert-citation-line
      message-kill-buffer-on-exit t
      message-send-mail-function 'smtpmail-send-it
      mm-discouraged-alternatives '("text/html"))

(defun ed/mm-inline-text-html-render-with-mu4e-html2text (handle)
  "Call `mu4e-message-body-text' to render HTML email hold by HANDLE in text."
  (mm-insert-inline
   handle
   ;; mu4e~view-message contain the currently viewed message plist, allowing
   ;; me to call this mu4e-only function.
   (mu4e-message-body-text mu4e~view-message nil)))

;; (with-eval-after-load 'mm-view
;;   (add-to-list 'mm-text-html-renderer-alist
;;                '(ed-mu4e-html2text . ed/mm-inline-text-html-render-with-mu4e-html2text)))
;; (setq mm-text-html-renderer 'ed-mu4e-html2text)

(setq smtpmail-auth-credentials (expand-file-name "~/.authinfo.gpg"))

(setq mml-secure-openpgp-sign-with-sender t
      mml-secure-openpgp-encrypt-to-self t)

(defun ed/flyspell-skip-mail-headers (begin _end _ignored)
  "Returns non-nil if BEGIN position is in mail header."
  (save-excursion
    (goto-char (point-min))
    (let ((end-header
           (re-search-forward "^--text follows this line--[[:space:]]*$" nil t)))
      (when end-header
        (< begin end-header)))))
(add-hook 'flyspell-incorrect-hook #'ed/flyspell-skip-mail-headers)

(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 (equal key "From:")
                (equal 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 (kbd "q") #'kill-this-buffer)))

(defun ed/mu4e-view-save-all-attachments (&optional arg)
  "Save all attachments of a given message.

If ARG is nil, all attachments will be saved in
`mu4e-attachment-dir'. When non-nil, user will be prompted to
choose a specific directory where to save all the files."
  (interactive "P")
  (when (and (eq major-mode 'mu4e-view-mode)
             (derived-mode-p 'gnus-article-mode))
    (let ((parts (mu4e~view-gather-mime-parts))
          (handles '())
          (files '())
          (directory (if arg
                         (read-directory-name "Save to directory: ")
                       mu4e-attachment-dir)))
      (dolist (part parts)
        (let ((fname (or (cdr (assoc 'filename (assoc "attachment" (cdr part))))
                         (cl-loop for item in part
                                  for name = (and (listp item) (assoc-default 'name item))
                                  thereis (and (stringp name) name)))))
          (when fname
            (push `(,fname . ,(cdr part)) handles)
            (push fname files))))
      (if files
          (cl-loop for (f . h) in handles
                   when (member f files)
                   do (mm-save-part-to-file
                       h (let ((file (expand-file-name f directory)))
                           (if (file-exists-p file)
                               (let (newname (count 1))
                                 (while (and
                                         (setq newname
                                               (format "%s-%s%s"
                                                       (file-name-sans-extension file)
                                                       count
                                                       (file-name-extension file t)))
                                         (file-exists-p newname))
                                   (cl-incf count))
                                 newname)
                             file))))
        (mu4e-message "No attached files found")))))
(define-key mu4e-view-mode-map "X" #'ed/mu4e-view-save-all-attachments)

(defun ed/mu4e-view-go-to-private-url (&optional multi)
  "Offer to go to url(s) in a private window of Firefox.

If MULTI (prefix-argument) is nil, go to a single one, otherwise,
offer to go to a range of urls."
  (interactive "P")
  (mu4e~view-handle-urls
   "URL to visit" multi
   (lambda (url)
     (start-process
      "private-firefox" nil
      "firefox" "--private-window" (ed/cleanup-url url)))))

(define-key mu4e-view-mode-map "G" #'ed/mu4e-view-go-to-private-url)

(defcustom ed/signalspam-login nil
  "Login used to connect to the Signal Spam API."
  :type 'string
  :group 'mu4e)
(defcustom ed/signalspam-pass nil
  "Password file name used to connect to the Signal Spam API."
  :type 'string
  :group 'mu4e)

(defun ed/send-message-to-signal-spam (msg)
  (if (or (not ed/signalspam-login)
          (not ed/signalspam-pass)
          (equal ed/signalspam-login "")
          (equal ed/signalspam-pass ""))
      (message "Please add your signal-spam login and password")
    (let ((path (or (mu4e-message-field msg :path) ""))
          (auth-token (base64-encode-string
                       (format "%s:%s"
                               ed/signalspam-login
                               (car (process-lines "pass" ed/signalspam-pass))))))
      (if (or (equal path "")
              (not (file-readable-p path)))
          (message "Mail file `%s' is not accessible" path)
        (with-temp-buffer
          (insert-file-contents path)
          (let ((url-request-method "POST")
                (url-request-extra-headers
                 `(("Content-Type" . "application/x-www-form-urlencoded")
                   ("Authorization" . ,(format "Basic %s" auth-token))))
                (url-request-data
                 (format "message=%s"
                         (base64-encode-string
                          (encode-coding-string
                           (buffer-string)
                           (select-safe-coding-system (point-min) (point-max)))
                          'no-line-break))))
            (url-retrieve
             "https://www.signal-spam.fr/api/signaler"
             ;; discard any result
             (lambda (_status) (kill-buffer (current-buffer)))
             nil t t))))))
  ;; In any case, mark it as deleted
  (when (eq major-mode 'mu4e-headers-mode)
    (mu4e-mark-set 'delete msg)
    (mu4e-headers-next)))

(add-to-list 'mu4e-headers-actions
             '("Signal spam" . ed/send-message-to-signal-spam) t)
(add-to-list 'mu4e-view-actions
             '("Signal spam" . ed/send-message-to-signal-spam) t)

(defun ed/get-mail-header (header-name path)
  (replace-regexp-in-string
   "[ \t\n]*$"
   ""
   (shell-command-to-string
    (concat "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-origin-mail-system-header (msg)
  (let ((path (or (mu4e-message-field msg :path) "")))
    (if (or (equal 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 (equal xmailer useragent)
            xmailer
          (cond
           ((equal xmailer "") useragent)
           ((equal useragent "") xmailer)
           (t (concat xmailer " (xmailer)\n" useragent " (user-agent)"))))))))

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

(defcustom ed/gpg-pub-keys '()
  "List of GnuPG public keys used to sign or encrypt my email."
  :type '(alist :key-type (string :tag "mu4e context name")
                :value-type (string :tag "gpg mail header content"))
  :group 'mu4e-crypto)
(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 (equal 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-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" . ed/decrypt-inline-pgp) t)

(defun ed/get-signature-for (email-addr)
  "Return the right signature for the given EMAIL-ADDR.

The signatures must be stored in a list named `ed/signature-paths-list'."
  (let ((sig-path
         (cdr (assoc email-addr ed/signature-paths-list))))
    (unless sig-path
      (setq sig-path ed/default-signature-path))
    (with-temp-buffer
      (insert-file-contents sig-path)
      (buffer-string))))

(defun ed/parse-mailto-string (mailto-string)
  (let ((data (split-string mailto-string "[ :?&=]"))
        to is-subject subject)
    (setq to (pop data))
    (when (equal to "mailto")
      (setq to (pop data)))
    (dolist (item data)
      (cond ((equal "subject" item)
             (setq is-subject t))
            (is-subject
             (setq is-subject nil)
             (setq subject item))))
    (list to subject)))

(defun ed/quick-mu4e-pong-handler (data)
  "Handle 'pong' responses from the mu server."
  (setq mu4e~server-props (plist-get data :props)) ;; save info from the server
  (let ((doccount (plist-get mu4e~server-props :doccount)))
    (mu4e~check-requirements)))

(defun ed/quick-mu4e-start ()
  "Quickly start mu4e, avoiding as trouble as possible."
  ;; Load a context as soon as possible to avoid error messages about
  ;; missing folders
  (mu4e~context-autoswitch nil mu4e-context-policy)
  (setq mu4e-pong-func (lambda (info) (ed/quick-mu4e-pong-handler info)))
  (mu4e~proc-ping))

(defun ed/compose-new-mail (mailto-string)
  "Compose a new mail with metadata extracted from MAILTO-STRING."
  (ed/quick-mu4e-start)
  (let* ((mailto (ed/parse-mailto-string mailto-string))
         (to (car mailto))
         (subject (cadr mailto)))
    (mu4e~compose-mail to subject)))

(defun ed/setup-emacs-mailto-target-desktop-file ()
  "Write xdg desktop file allowing emacs to be used as mailto target."
  (interactive)
  (with-temp-file
      (expand-file-name "~/.local/share/applications/emacsmail.desktop")
    (insert "[Desktop Entry]
Name=Compose message in Emacs
GenericName=Compose a new message with Mu4e in Emacs
Comment=Open mu4e compose window
MimeType=x-scheme-handler/mailto;
Exec=emacs -l /usr/share/emacs/site-lisp/mu4e/mu4e.elc --eval '(ed/compose-new-mail \"%u\")'
Icon=emacs
Type=Application
Terminal=false
Categories=Network;Email;
StartupWMClass=Emacs
"))
  (with-temp-buffer
    (call-process "update-desktop-database" nil (current-buffer) nil
                  (expand-file-name "~/.local/share/applications"))
    (buffer-string)))