path: root/email.org

#+property: header-args :lexical t :tangle yes :comments yes :results silent :shebang ";; -*- lexical-binding: t; -*-"
#+title: email handling (message mode, bbdb, notmuch)
#+auto_tangle: t

* message mode
*** Customization
    #+begin_src emacs-lisp
      (defvar jao-mails "")
      (defvar jao-mails-regexp)
      (setq jao-mails-regexp (regexp-opt jao-mails))

      (require 'message)
      (setq message-send-mail-function 'message-send-mail-with-sendmail
            message-sendmail-envelope-from 'header
            message-sendmail-f-is-evil nil)
      (setq imap-store-password t)
      (setq password-cache-expiry nil)
      (setq message-generate-headers-first t)
      (setq message-forward-before-signature nil)
      (setq message-alternative-emails jao-mails-regexp)
      (setq message-dont-reply-to-names
            (format "%s\\|%s" jao-mails-regexp (regexp-opt '("noreply@" "@noreply"
                                                             "no-reply@" "@no-reply"
                                                             "notifications@github"))))
      (setq message-citation-line-format "On %a, %b %d %Y, %N wrote:\n")
      (setq message-citation-line-function 'message-insert-formatted-citation-line)

      (setq message-user-fqdn "gnus.jao.io")

      ;; writing messages
      (setq message-kill-buffer-on-exit t)
      (setq message-max-buffers 5)
      (setq message-insert-signature t)
      (setq message-from-style 'angles
            user-mail-address (car jao-mails)
            mail-host-address system-name
            message-syntax-checks '((sender . disabled))
            message-default-headers
            (concat
             "X-Attribution: jao\n"
             "X-Clacks-Overhead: GNU Terry Pratchett\n"
             "X-URL: <http://jao.io/>\n")
            message-hidden-headers
            '("^References:" "^Face:" "^X-Face:" "^X-Draft-From:")
            message-make-forward-subject-function 'message-forward-subject-fwd)

      (setq message-expand-name-standard-ui t)
    #+end_src
*** Encryption
    #+BEGIN_SRC emacs-lisp
      (require 'gnutls)
      ;; avoiding bogus warning
      (setq gnutls-min-prime-bits nil)
      (setq gnus-buttonized-mime-types
            '("multipart/encrypted" "multipart/signed" "multipart/alternative"))

      (setq mm-verify-option 'always)
      (setq mm-decrypt-option 'always)

      (setq mm-sign-option 'guided)
      (setq mm-encrypt-option 'guided)

      (setq mml-secure-passphrase-cache-expiry (* 3600 24)
            password-cache-expiry (* 3600 24))

      (setq smime-CA-directory "/etc/ssl/certs/"
            smime-certificate-directory"/home/jao/.emacs.d/gnus/Mail/certs/")

      ;; Tells Gnus to inline the part
      (eval-after-load "mm-decode"
        '(add-to-list 'mm-inlined-types "application/pgp$"))
      ;; Tells Gnus how to display the part when it is requested
      (eval-after-load "mm-decode"
        '(add-to-list 'mm-inline-media-tests '("application/pgp$"
                                               mm-inline-text identity)))
      ;; Tell Gnus not to wait for a request, just display the thing
      ;; straight away.
      (eval-after-load "mm-decode"
        '(add-to-list 'mm-automatic-display "application/pgp$"))
      ;; But don't display the signatures, please.
      (eval-after-load "mm-decode"
        (quote (setq mm-automatic-display (remove "application/pgp-signature"
                                                  mm-automatic-display))))

      ;; decide whether to encrypt or just sign outgoing messages
      (defvar jao-message-try-sign nil)
      (defun jao-message-maybe-sign ()
        (when (and jao-message-try-sign (y-or-n-p "Sign message? "))
          (if (y-or-n-p "Encrypt message? ")
              (let ((recipient (message-fetch-field "To")))
                (if (or (pgg-lookup-key recipient)
                        (and (y-or-n-p (format "Fetch %s's key? " recipient))
                             (pgg-fetch-key pgg-default-keyserver-address
                                            recipient)))
                    (mml-secure-message-encrypt-pgp)
                  (mml-secure-message-sign-pgp)))
            (mml-secure-message-sign-pgp))))

      ;; for ma gnus
      (eval-after-load "rfc2047"
        '(add-to-list 'rfc2047-header-encoding-alist
                      '("User-Agent" . address-mime)))

      ;; (define-key message-mode-map [f7] 'mml-secure-message-sign-pgp)
      (define-key message-mode-map [f8] 'mml-secure-message-encrypt-pgp)
    #+END_SRC
*** Attach image to message
    Use ~C-c C-p~ in message-mode.
*** Check attachment
    #+BEGIN_SRC emacs-lisp
      (defvar jao-message-attachment-regexp "\\([Ww]e send\\|[Ii] send\\|attach\\)")
      (defun jao-message-check-attachment ()
        "Check if there is an attachment in the message if I claim it."
        (save-excursion
          (message-goto-body)
          (when (search-forward-regexp jao-message-attachment-regexp nil t nil)
            (message-goto-body)
            (unless (or (search-forward "<#part" nil t nil)
                        (message-y-or-n-p
                         "No attachment. Send the message? " nil nil))
              (error "No message sent")))))
    #+END_SRC
*** Check Fcc/Gcc
    #+begin_src emacs-lisp
      (defun jao-message-check-gcc ()
        "Ask whether to keep a copy of message."
        (save-excursion
          (save-restriction
            (message-narrow-to-headers)
            (when (and (or (message-fetch-field "Gcc")
                           (message-fetch-field "Fcc"))
                       (not (y-or-n-p "Archive? ")))
              (message-remove-header "Gcc")
              (message-remove-header "Fcc")))))
    #+end_src
*** Check recipient
    #+begin_src emacs-lisp
      (defun jao-message-check-recipient ()
        (save-excursion
          (save-restriction
            (message-narrow-to-headers)
            (when-let ((to (message-fetch-field "To")))
              (when (string-match-p jao-mails-regexp to)
                (unless (y-or-n-p "Message is addressed to yourself.  Continue?")
                  (error "Message not sent")))))))
    #+end_src
*** Randomsig
    #+begin_src emacs-lisp
      (when (require 'randomsig nil t)
        (define-key message-mode-map (kbd "C-c s") 'randomsig-replace-sig)
        (define-key message-mode-map (kbd "C-c S") 'randomsig-select-sig)
        (setq randomsig-dir (expand-file-name "~/etc/config/emacs"))
        (setq randomsig-files '("signatures.txt"))
        ;; or (setq randomsig-files (randomsig-search-sigfiles))
        ;; or (setq randomsig-files 'randomsig-search-sigfiles)
        (setq message-signature 'randomsig-signature)
        (setq randomsig-delimiter-pattern "^%$"
              randomsig-delimiter "%"))
    #+end_src
*** Send mail hooks
    #+begin_src emacs-lisp
      (dolist (h '(jao-message-check-gcc
                   jao-message-check-attachment
                   jao-message-check-recipient
                   jao-message-maybe-sign))
        (add-hook 'message-send-hook h))
    #+end_src
* sendmail/smtp
  #+begin_src emacs-lisp
    (require 'smtpmail)

    (defun jao-sendmail-gmail ()
      (setq smtpmail-auth-supported '(login cram-md5 plain))
      (setq smtpmail-smtp-server "smtp.gmail.com")
      (setq smtpmail-smtp-service 587))

    (defun jao-sendmail-local ()
      (setq smtpmail-auth-supported nil) ;; (cram-md5 plain login)
      (setq smtpmail-smtp-server "127.0.0.1")
      (setq smtpmail-smtp-service 25))

    (jao-sendmail-local)
  #+end_src
* mailcap
  #+begin_src emacs-lisp
    (use-package mailcap

      :config
      (add-to-list 'mailcap-mime-extensions '(".JPEG" . "image/jpeg"))
      (add-to-list 'mailcap-mime-extensions '(".JPG" . "image/jpeg"))

      (defun jao-icalendar-import-buffer ()
        (let ((icalendar-import-format "%s%u%l"))
          (icalendar-import-buffer diary-file))
        (kill-buffer))

      :custom ((mailcap-user-mime-data
                '((doc-view-mode "application/pdf" jao-browse-doc-use-emacs-p)
                  (jao-icalendar-import-buffer "application/ics")
                  ("zathura %s" "application/pdf")))))
  #+end_src
* bbdb
  #+begin_src emacs-lisp
    (use-package bbdb
      :ensure t
      :init (setq bbdb-complete-name-allow-cycling t
                  bbdb-completion-display-record nil
                  bbdb-gui t
                  bbdb-message-all-addresses t
                  bbdb-complete-mail-allow-cycling t
                  bbdb-north-american-phone-numbers-p nil
                  bbdb-add-aka t
                  bbdb-add-name 2
                  bbdb-message-all-addresses t
                  bbdb-mua-pop-up t ;; 'horiz
                  bbdb-mua-pop-up-window-size 0.3
                  bbdb-layout 'multi-line
                  bbdb-mua-update-interactive-p '(query . create)
                  bbdb-mua-auto-update-p 'bbdb-select-message
                  bbdb-user-mail-address-re jao-mails-regexp
                  bbdb-auto-notes-ignore-headers
                  `(("From" . ,jao-mails-regexp)
                    ("From" . ".*@.*github\.com.*")
                    ("To" . ".*@.*github\.com.*")
                    ("Reply-to" . ".*")
                    ("References" . ".*"))
                  bbdb-auto-notes-ignore-messages
                  `(("To" . ".*@.*github\\.com.*")
                    ("From" . ".*@.*github\\.com.*")
                    ("From" . "info-list")
                    ("From" . "no-?reply\\|deploy")
                    ("X-Mailer" . "MailChimp"))
                  bbdb-accept-message-alist
                  `(("To" . ,jao-mails-regexp)
                    ("Cc" . ,jao-mails-regexp)
                    ("BCc" . ,jao-mails-regexp))
                  bbdb-ignore-message-alist bbdb-auto-notes-ignore-messages)
      :config
      (add-hook 'message-setup-hook 'bbdb-mail-aliases)
      ;; (add-hook 'bbdb-notice-mail-hook 'bbdb-auto-notes)
      (add-hook 'bbdb-after-change-hook (lambda (arg) (bbdb-save)))
      (require 'bbdb-anniv) ;; BBDB 3.x this gets birthdays in org agenda
                            ;; and diary - clever stuff
      (add-hook 'diary-list-entries-hook 'bbdb-anniv-diary-entries))

    (require 'bbdb)
    (setq bbdb-file (expand-file-name "~/.emacs.d/bbdb"))
    (bbdb-initialize 'message 'pgp 'mail)
   #+end_src
* mailboxes
  #+begin_src emacs-lisp
    (defun jao-list-mailboxes (base)
      (let ((dir (expand-file-name base "~/var/mail")))
        (seq-difference (directory-files dir)
                        '("." ".." "sent" "inbox" "trash"))))
  #+end_src
* consult narrowing
  #+begin_src emacs-lisp
    (defvar jao-mail-consult-buffer-history nil)

    (defun jao-mail-buffer-p (b)
      (or (member (buffer-name b)
                  '("*Calendar*" "inbox.org" "*Org Agenda*"
                    "*Fancy Diary Entries*" "diary"))
          (with-current-buffer b
            (derived-mode-p 'notmuch-show-mode
		            'notmuch-search-mode
		            'notmuch-tree-mode
		            'notmuch-hello-mode
		            'notmuch-message-mode
                            'gnus-group-mode
                            'gnus-summary-mode
                            'gnus-article-mode))))

    (defvar jao-mail-consult-source
      (list :name "mail buffer"
            :category 'buffer
            :hidden t
            :narrow (cons ?n "mail buffer")
            :history 'jao-mail-consult-buffer-history
            :action (lambda (b)
                      (when (not (string-blank-p (or b "")))
                        (jao-afio--goto-mail)
                        (if (get-buffer-window b)
                            (pop-to-buffer b)
                          (pop-to-buffer-same-window b))))
            :items (lambda ()
                     (mapcar #'buffer-name
                             (seq-filter #'jao-mail-buffer-p (buffer-list))))))

    (jao-consult-add-buffer-source 'jao-mail-consult-source "Mail" ?n)
  #+end_src
* gnus
*** Directories
    #+begin_src emacs-lisp
      (setq gnus-init-file "~/.emacs.d/gnus.el"
            gnus-home-directory "~/.emacs.d/gnus"
            gnus-directory gnus-home-directory)
    #+end_src
*** Notifications
    #+begin_src emacs-lisp
      (defun jao-gnus-notify ()
        (interactive)
        (when (fboundp 'jao-gnus--notify)
          (unless (derived-mode-p 'gnus-summary-mode
                                  'gnus-article-mode
                                  'gnus-group-mode)
            (let ((inhibit-message t))
              (gnus-demon-scan-news)))))
    #+end_src
* notmuch
*** minibuffer notifications
    #+begin_src emacs-lisp
      (defvar jao-notmuch-minibuffer-string "")

      (defvar jao-notmuch-minibuffer-queries
        '((:name "" :query "tag:new" :face jao-themes-f00)
          (:name "B" :query "tag:new and tag:bigml and tag:inbox")
          (:name "b" :query "tag:new and tag:bigml and tag:bugs"
                 :face jao-themes-error)
          (:name "S" :query "tag:new and tag:bigml and tag:support")
          (:name "W" :query "tag:new and tag:bigml" :face jao-themes-dimm)
          (:name "I" :query "tag:new and tag:jao and tag:inbox")
          (:name "J" :query "tag:new and tag:jao" :face jao-themes-dimm)
          (:name "E" :query "tag:new and tag:feeds and tag:emacs"
                 :face jao-themes-dimm)
          (:name "N" :query "tag:new and tag:gmane" :face jao-themes-dimm)
          (:name "F" :query "tag:new and tag:feeds and not tag:emacs"
                 :face jao-themes-dimm)))

      (defun jao-notmuch-notify ()
        (let ((cnts (notmuch-hello-query-counts jao-notmuch-minibuffer-queries)))
          (setq jao-notmuch-minibuffer-string
                (mapconcat (lambda (c)
                             (propertize (format "%s%s"
                                                 (plist-get c :name)
                                                 (plist-get c :count))
                                         'face (plist-get c :face)))
                           cnts
                           " "))
          (jao-minibuffer-refresh)))

      (when (eq jao-afio-mail-function 'notmuch)
        (jao-minibuffer-add-variable 'jao-notmuch-minibuffer-string -20))
    #+end_src
*** searches
    #+begin_src emacs-lisp
      (setq notmuch-tree-result-format
            '(("date" . "%12s  ")
              ("authors" . "%-35s")
              ((("tree" . "%s ")("subject" . "%s")) . "  %-100s")
              ("tags" . "  (%s)"))
            notmuch-search-result-format
            '(("date" . "%12s ")
              ("count" . "%-7s ")
              ("authors" . "%-35s")
              ("subject" . "%-100s")
              ("tags" . "(%s)"))
            notmuch-unthreaded-result-format notmuch-tree-result-format)

      (defun jao-notmuch--q (d0 d1 &optional k qs st)
        (let ((q (or (when qs (mapconcat #'identity qs " AND "))
                     (format "folder:%s/%s and tag:unread" d0 d1))))
          (list :name (concat d0 (when d1 "/") d1)
                :key k :query q :search-type (or st 'tree)
                :sort-order 'oldest-first)))

      (defun jao-notmuch--mboxes-search (box &rest excluded)
        (let ((ms (seq-difference (jao-list-mailboxes box) excluded))
              (bp (substring box 0 1)))
          (mapcar `(lambda (m)
                     (jao-notmuch--q ,box (car m) (concat ,bp (cdr m))))
                  (shorten-strings (sort ms #'string<)))))

      (setq notmuch-saved-searches
            `(,(jao-notmuch--q "bigml" "inbox" "bi")
              ,@(jao-notmuch--mboxes-search "bigml" "inbox")
              ,(jao-notmuch--q "jao" "inbox" "ji")
              ,@(jao-notmuch--mboxes-search "jao" "inbox")
              ,@(jao-notmuch--mboxes-search "feeds")
              ,(jao-notmuch--q "gmane/emacs" nil "e"
                               '("tag:gmane" "tag:new" "tag:emacs"))
              ,(jao-notmuch--q "gmane" nil "g"
                               '("tag:gmane" "tag:new" "not tag:emacs"))
              ,(jao-notmuch--q "bml/today" nil "tb" '("tag:bigml" "date:1d..") t)
              ,(jao-notmuch--q "jao/today" nil "tj" '("tag:jao" "date:1d..") t)
              ,(jao-notmuch--q "flagged" nil "r" '("tag:flagged") t)
              ,(jao-notmuch--q "new" nil "n" '("tag:new"))
              ,(jao-notmuch--q "draft" nil "d" '("tag:draft"))))
    #+end_src
*** package
    #+begin_src emacs-lisp
      (when (< emacs-major-version 28)
        (jao-load-path "notmuch"))

      (use-package notmuch
        ;; :ensure t
        :init
        (setq notmuch-draft-folder "trove/drafts"
              notmuch-draft-quoted-tags '("part")
              notmuch-hello-sections '(notmuch-hello-insert-saved-searches
                                       notmuch-hello-insert-alltags
                                       notmuch-hello-insert-header)
              notmuch-hello-thousands-separator ","
              notmuch-hello-auto-refresh t
              notmuch-show-all-tags-list t
              notmuch-show-logo nil
              notmuch-show-empty-saved-searches nil
              notmuch-show-part-button-default-action 'notmuch-show-view-part
              notmuch-show-mark-read-tags '("-new" "-unread")
              notmuch-archive-tags '("+trove" "-new" "-unread" "-flagged")
              notmuch-fcc-dirs
              '((".*@bigml.com" . "bigml/inbox +bigml +sent -new")
                (".*" . "jao/inbox +jao +sent -new"))
              notmuch-maildir-use-notmuch-insert t
              notmuch-message-headers '("Subject" "To" "Cc" "Date" "List-Id")
              notmuch-wash-signature-lines-max 0
              notmuch-wash-wrap-lines-length 80
              notmuch-wash-citation-lines-prefix 10
              notmuch-wash-citation-lines-suffix 20)

        :config

        (when (eq 'notmuch jao-afio-mail-function)
          (setq mm-text-html-renderer 'shr))

        (defun jao-notmuch-refresh-agenda ()
          (interactive)
          (save-window-excursion (org-agenda-list)))

        (defun jao-notmuch-hello-first ()
          (interactive)
          (let ((inhibit-message t))
            (beginning-of-buffer)
            (widget-forward 2)))

        (defun jao-notmuch-refresh-hello ()
          (interactive)
          (ignore-errors
            (when (and (string= "Mail" (jao-afio-current-frame))
                       (derived-mode-p 'notmuch-hello-mode))
              (when (not (string-blank-p jao-notmuch-minibuffer-string))
                (let ((notmuch-hello-auto-refresh nil)) (notmuch-hello)))
              (jao-notmuch-hello-first))))

        (defun jao-notmuch-open-enclosure (add)
          (interactive "P")
          (with-current-notmuch-show-message
           (goto-char (point-min))
           (if (not (search-forward "Enclosure:" nil t))
               (user-error "No enclosure in message body")
             (re-search-forward "https?://" nil t)
             (if-let (url (thing-at-point-url-at-point))
                 (progn
                   (message "%s %s ..." (if add "Adding" "Playing") url)
                   (unless add (jao-mpc-clear))
                   (jao-mpc-add-url url)
                   (unless add (jao-mpc-play)))
               (error "Found an enclosure, but not a link!")))))

        :hook ((notmuch-hello-refresh . jao-notmuch-notify)
               (jao-afio-switch . jao-notmuch-refresh-hello))

        :bind (:map notmuch-hello-mode-map
               (("a" . jao-notmuch-refresh-agenda)
                ("S" . consult-notmuch)
                ("g" . jao-notmuch-refresh-hello)
                ("." . jao-notmuch-hello-first)
                ("SPC" . widget-button-press))
               :map notmuch-common-keymap
               (("E" . jao-notmuch-open-enclosure))))
    #+end_src
*** tree view
    #+begin_src emacs-lisp
      (defvar-local jao-notmuch--tree-buffer nil)

      (defun jao-notmuch-goto-message-buffer (&optional and-click)
        (interactive "P")
        (when (window-live-p notmuch-tree-message-window)
          (let ((b (current-buffer)))
            (select-window notmuch-tree-message-window)
            (setq-local jao-notmuch--tree-buffer b)
            (or (not and-click)
                (cond ((eww--url-at-point) (shr-browse-url) 'url)
                      ((button-at (point)) (push-button) 'button))))))

      (defun jao-notmuch-click-message-buffer ()
        (interactive)
        (let ((b (current-buffer)))
          (unless (eq 'url (jao-notmuch-goto-message-buffer t))
            (pop-to-buffer b))))

      (defun jao-notmuch-goto-index-buffer ()
        (interactive)
        (if (buffer-live-p jao-notmuch--tree-buffer)
            (pop-to-buffer jao-notmuch--tree-buffer)
          (user-error "No index for this buffer")))

      (defun jao-notmuch-browse-urls ()
        (interactive)
        (when (or (derived-mode-p 'notmuch-show-mode)
                  (jao-notmuch-goto-message-buffer))
          (notmuch-show-browse-urls)))

      (defun jao-notmuch-toggle-mime-parts ()
        (interactive)
        (when (jao-notmuch-goto-message-buffer)
         (goto-char (point-min))
         (let ((notmuch-show-text/html-blocked-images nil)
               (shr-inhibit-images nil)
               (shr-blocked-images nil))
           (save-excursion
             (when (re-search-forward "\\[ multipart/alternative \\]" nil t)
               (while (forward-button 1 nil nil t)
                 (notmuch-show-toggle-part-invisibility)))))
         (jao-notmuch-goto-index-buffer)))

      (defun jao-notmuch-toggle-images ()
        (interactive)
        (save-window-excursion
          (jao-notmuch-goto-message-buffer)
          (when (derived-mode-p 'notmuch-show-mode)
            (let ((notmuch-show-text/html-blocked-images nil)
                  (shr-inhibit-images nil)
                  (shr-blocked-images nil))
              (notmuch-refresh-this-buffer)))))

      (defun jao-notmuch--unread-count ()
        (save-excursion
          (goto-char (point-min))
          (let ((p) (cnt))
            (while (setq p (text-property-search-forward
                            :notmuch-message-properties))
              (unless cnt (setq cnt 0))
              (let ((tags (plist-get (prop-match-value p) :tags)))
                (when (or (member "unread" tags) (member "new" tags))
                  (setq cnt (1+ cnt)))))
            cnt)))

      (defun jao-notmuch-tree-update-buffer-name (&optional n)
        (when-let ((n (or n (jao-notmuch--unread-count))))
          (rename-buffer (format "*%s - {%s messages left}*"
                                 notmuch-tree-basic-query
                                 n))))

      (defun jao-notmuch-tree-next (thread &optional no-exit)
        "Next message or thread in forest or exit if none."
        (interactive "P")
        (if thread
            (progn (notmuch-tree-next-thread)
                   (notmuch-tree-show-message nil))
          (notmuch-tree-next-matching-message (not no-exit)))
        (jao-notmuch-tree-update-buffer-name))

      (defun jao-notmuch-tag-jump-and-next (reverse)
        (interactive "P")
        (notmuch-tag-jump reverse)
        (jao-notmuch-tree-next nil t))

      (defun jao-notmuch-tree--tag-and-next (tags reverse whole-thread)
        (let ((c (notmuch-tag-change-list tags reverse)))
          (if whole-thread (notmuch-tree-tag-thread c) (notmuch-tree-tag c)))
        (jao-notmuch-tree-next whole-thread t))

      (defun jao-notmuch-tree-delete-message (undelete)
        (interactive "P")
        (jao-notmuch-tree--tag-and-next '("+deleted" "-new" "-unread")
                                        undelete
                                        nil))

      (defun jao-notmuch-tree-delete-thread ()
        (interactive)
        (jao-notmuch-tree--tag-and-next '("+deleted" "-new"  "-unread") nil t))

      (defun jao-notmuch-tree-read-thread ()
        (interactive)
        (jao-notmuch-tree--tag-and-next '("-unread" "-new") nil t))

      (defun jao-notmuch-tree-scroll-or-next ()
        "Scroll or next message in forest or exit if none."
        (interactive)
        (if (notmuch-tree-scroll-message-window)
            (notmuch-tree-next-matching-message t)
          (when (not (window-live-p notmuch-tree-message-window))
            (notmuch-tree-show-message nil)))
        (jao-notmuch-tree-update-buffer-name))

      (defun jao-notmuch-tree-show-or-scroll ()
        "Show current message, or scroll it if visible."
        (interactive)
        (if (window-live-p notmuch-tree-message-window)
            (scroll-other-window 1)
          (notmuch-tree-show-message nil)
          (jao-notmuch-tree-update-buffer-name)))

      (use-package notmuch-tree
        :config

        (dolist (f '(notmuch-tree-match-tree-face
                     notmuch-tree-no-match-tree-face))
          (set-face-attribute f nil :family "Fira Code" :foreground "grey60"))

        (defun jao-notmuch--format-field (fun field &rest args)
          (let ((rs (apply fun field args)))
            (cond ((and (stringp field) (string= field "tree"))
                   (replace-regexp-in-string "►" "→" rs))
                  ((not (stringp field)) (truncate-string-to-width rs 100))
                  (t rs))))

        (advice-add 'notmuch-tree-format-field
                    :around #'jao-notmuch--format-field)

        (defun jao-notmuch-echo-count ()
          (interactive)
          (when-let ((n (jao-notmuch--unread-count)))
            (jao-notmuch-tree-update-buffer-name n)
            (message "%s messages left" n)))

        :bind (:map notmuch-tree-mode-map
                    (("." . jao-notmuch-toggle-mime-parts)
                     ("C" . jao-notmuch-echo-count)
                     ("d" . jao-notmuch-tree-delete-message)
                     ("D" . jao-notmuch-tree-delete-thread)
                     ("h" . jao-notmuch-goto-message-buffer)
                     ("H" . jao-notmuch-click-message-buffer)
                     ("i" . jao-notmuch-toggle-images)
                     ("K" . jao-notmuch-tag-jump-and-next)
                     ("k" . jao-notmuch-tree-read-thread)
                     ("n" . jao-notmuch-tree-next)
                     ("RET" . jao-notmuch-tree-show-or-scroll)
                     ("SPC" . jao-notmuch-tree-scroll-or-next))
                    :map notmuch-show-mode-map
                    (("h" . jao-notmuch-goto-index-buffer))
                    :map notmuch-common-keymap
                    (("B" . jao-notmuch-browse-urls))))
    #+end_src
*** address clean-ups
    #+begin_src emacs-lisp
      (defun jao-mail-clean-address (fun address)
          (let ((address (if (string-match ".+ updates on arXiv.org: \\(.+\\)"
                                           address)
                             (with-temp-buffer
                               (insert (match-string 1 address))
                               (let ((shr-width 1000))
                                 (shr-render-region (point-min) (point-max)))
                               (buffer-string))
                           (replace-regexp-in-string "^ElDiario.es - ElDiario.es"
                                                     "ElDiario.es"
                                                     address))))
            (funcall fun address)))

      (with-eval-after-load "notmuch"
        (advice-add 'notmuch-clean-address :around #'jao-mail-clean-address))
    #+end_src
*** mua
    #+begin_src emacs-lisp
      (when (eq jao-afio-mail-function 'notmuch)
        (setq message-directory "~/var/mail/"
              message-auto-save-directory "/tmp")
        (with-eval-after-load "notmuch-message"
          (define-key message-mode-map (kbd "C-c C-d")
            #'notmuch-draft-postpone)))
    #+end_src
*** consult
    #+begin_src emacs-lisp
      (when (< emacs-major-version 28)
        (jao-load-path "consult-notmuch"))

      (use-package consult-notmuch
        ;; :ensure t
        :init (setq consult-notmuch-authors-width 30)
        :config (consult-customize consult-notmuch :preview-key 'any))

      (defvar jao-consult-notmuch-folders
        (seq-mapcat (lambda (base)
                      (mapcar `(lambda (d) (format "%s/%s" ,base d))
                              (jao-list-mailboxes base)))
                    '("jao" "bigml" "feeds" "trove")))

      (defvar jao-consult-notmuch-history nil)

      (defun jao-consult-notmuch-folder (&optional tree folder)
        (interactive "P")
        (let* ((root "~/var/mail/")
               (folder (if folder
                           (file-name-as-directory folder)
                         (completing-read "Folder: "
                                          jao-consult-notmuch-folders
                                          nil nil nil
                                          jao-consult-notmuch-history
                                          ".")))
               (folder (replace-regexp-in-string "/\\(.\\)" ".\\1" folder))
               (init (read-string "Initial query: "))
               (init (format "folder:/%s/ %s" folder init)))
          (if tree (consult-notmuch-tree init) (consult-notmuch init))))

      (with-eval-after-load "notmuch-hello"
        (define-key notmuch-hello-mode-map "f" #'jao-consult-notmuch-folder))
    #+end_src
*** org mode integration
    Stolen and adapted from [[https://gist.github.com/fedxa/fac592424473f1b70ea489cc64e08911][Fedor Bezrukov]].
    #+begin_src emacs-lisp
      (with-eval-after-load "org"
        (with-eval-after-load "notmuch"
          (org-link-set-parameters "notmuch"
                                   :follow 'org-notmuch-open
                                   :store 'org-notmuch-store-link)

         (defun org-notmuch-open (id)
           "Visit the notmuch message or thread with id ID."
           (notmuch-show id))

         (defun org-notmuch-store-link ()
           "Store a link to a notmuch mail message."
           (case major-mode
             ((notmuch-show-mode notmuch-tree-mode)
              ;; Store link to the current message
              (let* ((id (notmuch-show-get-message-id))
                     (link (concat "notmuch:" id))
                     (description (format "Mail: %s"
                                          (notmuch-show-get-subject))))
                (org-store-link-props
	         :type "notmuch"
	         :link link
	         :description description)))
             (notmuch-search-mode
              ;; Store link to the thread on the current line
              (let* ((id (notmuch-search-find-thread-id))
                     (link (concat "notmuch:" id))
                     (description (format "Mail: %s"
                                          (notmuch-search-find-subject))))
                (org-store-link-props
                 :type "notmuch"
                 :link link
                 :description description)))))))
    #+end_src
*** tag shell script
    #+begin_src bash :shebang "#!/bin/bash" :tangle ./bin/notmuch-tags.sh :tangle-mode (identity #o755)
      notmuch new > $HOME/var/log/notmuch.log 2>&1

      function tag_folder {
        notmuch tag +$1 +$2 -- tag:new AND folder:$1/$2
      }

      function tag_directory {
        for f in ~/var/mail/$1/*; do
          tag_folder $1 $(basename $f);
        done
      }

      function tag_list () {
        notmuch tag "+$1" -- tag:new AND List:${2:-$1}
      }

      tag_directory bigml
      tag_directory jao
      tag_directory feeds

      nbml="tag:new AND tag:bigml AND"

      notmuch tag +bug -lists -drivel \
       -- "$nbml (List:bigmlcom/wintermute OR List:bigmlcom/universe)"
      notmuch tag +support -inbox -drivel -lists \
       -- "$nbml (List:support OR List:education)"

      notmuch tag +gmane -- tag:new AND folder:/gmane/

      for l in notmuch haskell emacs-devel emacs-diffs emacs; do
        tag_list $l
      done
      tag_list emacs-bugs bug-gnu-emacs

    #+end_src
*** expiry shell script
    #+begin_src bash :shebang "#!/bin/bash" :tangle ./bin/notmuch-expire.sh :tangle-mode (identity #o755)

      spared_tags="tag:\"/^(trove|new|flagged|unread|draft)$/\""

      function tag_deleted {
        notmuch tag +deleted -- "$1 AND date:..${2:-3d} AND NOT $spared_tags"
      }

      function tag_deleted_foldr {
        tag_deleted "folder:\"/$1/\"" $2
      }

      tag_deleted_foldr "bigml.(drivel|lists|deploys|bugs)" 3d
      tag_deleted_foldr "bigml.reports" 1d
      tag_deleted_foldr "jao.(drivel|lists|books|think|local)" 3d
      tag_deleted_foldr "feeds.+" 3d

      tag_deleted "tag:support AND tag:bigml" 7d

      notmuch new > $HOME/var/log/notmuch-expire.log 2>&1
      notmuch compact >> $HOME/var/log/notmuch-expire.log 2>&1
    #+end_src
*** delete shell script
    #+begin_src bash :shebang "#!/bin/bash" :tangle ./bin/notmuch-delete.sh :tangle-mode (identity #o755)
      notmuch search --output=files --format=text0 tag:deleted | xargs -r0 rm

      notmuch new > $HOME/var/log/notmuch-expire.log 2>&1
      notmuch compact >> $HOME/var/log/notmuch-expire.log 2>&1
    #+end_src