path: root/notmuch.org

#+property: header-args:emacs-lisp :lexical t :tangle yes :comments yes :results silent :shebang ";; -*- lexical-binding: t; -*-" :tangle-mode (identity #o644)
#+title: notmuch configuration

* minibuffer
  #+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 "H" :query "tag:new and tag:jao and tag:hacking")
        (:name "E" :query "tag:new and tag:\"/emacs/\"" :face jao-themes-dimm)
        (:name "l" :query "tag:new and tag:local" :face jao-themes-dimm)
        (:name "J" :query
               "tag:new and tag:jao and not tag:\"/local|emacs|hacking|feeds/\""
               :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)))

    (jao-minibuffer-add-variable 'jao-notmuch-minibuffer-string -20)
  #+end_src
* saved searches
  #+begin_src emacs-lisp
    (defvar jao-notmuch--new "tag:\"/^(unread|new)$/\"")
    (defvar jao-notmuch--newa (concat jao-notmuch--new " AND "))

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

    (defun jao-notmuch--qn (d0 d1 k qs &optional st)
      (jao-notmuch--q d0 d1 k (cons jao-notmuch--new qs) st))

    (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--q "bigml" "support" "bs")
            ,(jao-notmuch--q "bigml" "bugs" "bb")
            ,@(jao-notmuch--mboxes-search "bigml" "inbox" "support")
            ,@(jao-notmuch--mboxes-search "jao")
            ,(jao-notmuch--qn "local" nil "l" '("tag:local"))
            ,(jao-notmuch--qn "emacs" "feeds" "ee" '("tag:emacs"))
            ,(jao-notmuch--qn "emacs" "github" "eg" '("tag:emacs-github"))
            ,(jao-notmuch--qn "emacs" "devel" "ed" '("tag:emacs-devel"))
            ,(jao-notmuch--qn "emacs" "bugs" "eb" '("tag:emacs-bugs"))
            ,(jao-notmuch--qn "emacs" "diffs" "ec" '("tag:emacs-diffs"))
            ,(jao-notmuch--qn "feeds" "lobsters" "fl" '("tag:lobsters"))
            ,(jao-notmuch--qn "feeds" "prog" "fp" '("tag:prog" "not tag:lobsters"))
            ,@(jao-notmuch--mboxes-search "feeds" "emacs" "prog")
            ,(jao-notmuch--q "bml" "today" "tb" '("tag:bigml" "date:24h..") t)
            ,(jao-notmuch--q "jao" "today" "tj"
                             '("tag:jao" "date:24h.."
                               "not tag:\"/(feeds|spam|local)/\"")
                             t)
            ,(jao-notmuch--q "bml" "flagged" "rb" '("tag:flagged" "tag:bigml") t)
            ,(jao-notmuch--q "jao" "flagged" "rj" '("tag:flagged" "not tag:bigml") t)
            ,(jao-notmuch--q "new" nil "n" '("tag:new"))))

    (defun jao-notmuch-tree-widen-search ()
      (interactive)
      (when-let ((query (notmuch-tree-get-query)))
        (let ((notmuch-show-process-crypto (notmuch-tree--message-process-crypto)))
          (notmuch-tree-close-message-window)
          (notmuch-tree (string-replace jao-notmuch--newa "" query)))))

    (defun jao-notmuch-widen-searches (searches)
      (mapcar (lambda (s)
                (let ((q (plist-get s :query)))
                  (plist-put (copy-sequence s)
                             :query (string-replace jao-notmuch--newa "" q))))
              searches))

    (defvar jao-notmuch-widened-searches
      (jao-notmuch-widen-searches notmuch-saved-searches))

    (defun jao-notmuch-jump-search (&optional widen)
      (interactive "P")
      (let ((notmuch-saved-searches
             (if widen jao-notmuch-widened-searches notmuch-saved-searches)))
        (notmuch-jump-search)))

  #+end_src
* tags
  #+begin_src emacs-lisp
    (setq notmuch-archive-tags '("+trove" "-new")
          notmuch-show-mark-read-tags '("-new" "-unread")
          notmuch-tag-formats
          (let ((d `(:foreground ,(face-attribute 'jao-themes-dimm :foreground)))
                (e `(:foreground ,(face-attribute 'jao-themes-error :foreground))))
            `(("unread")
              ("signed")
              ("new" "N")
              ("replied" "↩" (propertize tag 'face '(:family "Fira Code")))
              ("sent" "S")
              ("attachment" "📎")
              ("deleted" "×××" (propertize tag 'face '(:underline nil ,@e)))
              ("flagged" "*" (propertize tag 'face ',e))
              ("jao" "j")
              ("bigml" "b")
              ("feeds" "f")))
          notmuch-tag-deleted-formats
          '(("unread")
            ("new")
            (".*" (notmuch-apply-face tag 'notmuch-tag-deleted))))
  #+end_src
* package
  #+begin_src emacs-lisp
    (if (< emacs-major-version 28)
      (jao-load-path "notmuch")
      (add-to-list 'load-path "/usr/local/share/emacs/site-lisp/"))

    (use-package notmuch
      :init
      (setq notmuch-draft-folder "jao/drafts"
            notmuch-draft-quoted-tags '("part")
            notmuch-address-internal-completion '(received nil)
            notmuch-fcc-dirs
            '(("\\(support\\|education\\)@bigml.com" . nil)
              (".*@bigml.com" . "bigml/sent +bigml +sent -new")
              (".*" . "jao/trove +jao +sent +trove -new"))
            notmuch-maildir-use-notmuch-insert t
            notmuch-message-headers '("Subject" "To" "Cc" "Date" "List-Id"))

      :config

      (when (eq 'notmuch jao-afio-mail-function)
        (setq message-directory "~/var/mail/"
              message-auto-save-directory "/tmp"))

      :bind (:map notmuch-common-keymap
             (("E" . jao-notmuch-open-enclosure)
              ("B" . jao-notmuch-browse-urls))
             :filter (eq 'notmuch jao-afio-mail-function)
             :map message-mode-map
             (("C-c C-d" . notmuch-draft-postpone))))

    (use-package jao-notmuch :demand t)

  #+end_src
* hello
  #+begin_src emacs-lisp
    (defun jao-notmuch-hello-insert-searches ()
      (when-let (searches (notmuch-hello-query-counts notmuch-saved-searches))
        (widget-insert "Saved searches:\n\n")
        (let ((start (point)))
          (let ((notmuch-column-control t))
            (notmuch-hello-insert-buttons searches))
	(indent-rigidly start (point) notmuch-hello-indent))))

    (defun jao-notmuch-refresh-agenda ()
      (interactive)
      (save-window-excursion (org-agenda-list))
      (with-current-buffer "*Calendar*" (calendar-goto-today)))

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

    (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))))

    (use-package notmuch-hello
      :init
      (setq notmuch-column-control t
            notmuch-hello-sections '(jao-notmuch-hello-insert-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)

      :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)
              ("j" . jao-notmuch-jump-search)
              ("n" . widget-forward)
              ("p" . widget-backward)
              ("S" . consult-notmuch)
              ("g" . jao-notmuch-refresh-hello)
              ("." . jao-notmuch-hello-first)
              ("SPC" . widget-button-press))))

  #+end_src
* show
  #+begin_src emacs-lisp
    (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!")))))

    (defconst jao-mail-clean-rx
      (regexp-opt '("ElDiario.es - ElDiario.es: " "The Guardian: "
                    "The Conversation – Articles (UK): ")))

    (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)))
                   (replace-regexp-in-string "\"" "" (buffer-string)))
               (replace-regexp-in-string jao-mail-clean-rx "" address))))
        (funcall fun address)))

    (defun jao-notmuch-show-setup () (setq header-line-format nil))

    (use-package notmuch-show
      :init
      (setq gnus-blocked-images "."
            notmuch-show-only-matching-messages t
            notmuch-show-part-button-default-action 'notmuch-show-view-part
            notmuch-wash-signature-lines-max 0
            notmuch-wash-wrap-lines-length 80
            notmuch-wash-citation-lines-prefix 10
            notmuch-wash-citation-lines-suffix 20
            notmuch-show-text/html-blocked-images ".")

      :config

      (advice-add 'notmuch-clean-address :around #'jao-mail-clean-address)
      (add-hook 'notmuch-show-hook #'jao-notmuch-show-setup)
      (jao-notmuch-show-prefer-html)

      :bind
      (:map notmuch-show-mode-map
       (("h" . jao-notmuch-goto-tree-buffer)
        ("TAB" . jao-notmuch-show-next-button)
        ("S-TAB" . jao-notmuch-show-previous-button)
        ("RET" . jao-notmuch-show-ret))))

  #+end_src
* search
  #+begin_src emacs-lisp
    (use-package notmuch-search
      :init (setq notmuch-search-result-format
                  '(("date" . "%12s ")
                    ("count" . "%-7s ")
                    ("authors" . "%-35s")
                    ("subject" . "%-100s")
                    ("tags" . "(%s)")))
      :bind (:map notmuch-search-mode-map
             (("RET" . notmuch-tree-from-search-thread)
              ("M-RET" . notmuch-search-show-thread))))

  #+end_src
* tree
  #+begin_src emacs-lisp
    (use-package notmuch-tree
      :init

      (defun jao-notmuch--truncate (x)
        (truncate-string-to-width (format "%-102s" x) 102 nil nil t))

      (defun jao-notmuch--msg-ticks (msg)
        (let ((headers (plist-get msg :headers)))
          (cond ((string-match-p jao-mails-regexp (or (plist-get headers :To) ""))
                 (propertize " »" 'face 'notmuch-tree-match-tree-face))
                ((string-match-p jao-mails-regexp (or (plist-get headers :Cc) ""))
                 (propertize " ¬" 'face 'notmuch-tree-match-tree-face))
                (t "  "))))

      (defun jao-notmuch--tree-subject (msg)
        (thread-first '(("tree" . " %s") ("subject" . " %s"))
          (notmuch-tree-format-field-list msg)
          (jao-notmuch--truncate)))

      (setq notmuch-tree-result-format
            '(("date" . "%12s  ")
              ("authors" . "%-35s")
              (jao-notmuch--msg-ticks)
              (jao-notmuch--tree-subject)
              ("tags" . "  (%s)"))
            notmuch-unthreaded-result-format notmuch-tree-result-format
            notmuch-tree-thread-symbols
            '((prefix . "─") (top . "─") (top-tee . "┬")
              (vertical . "│") (vertical-tee . "├") (bottom . "╰")
              (arrow . "")))

      :config

      (let ((fg (face-attribute 'jao-themes-dimm :foreground)))
        (dolist (f '(notmuch-tree-match-tree-face
                     notmuch-tree-no-match-tree-face))
          (set-face-attribute f nil :family "Fira Code" :foreground fg)))

      (jao-notmuch-tree-setup "T")

      :bind (:map notmuch-tree-mode-map
             (("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-show-images)
              ("K" . jao-notmuch-tag-jump-and-next)
              ("k" . jao-notmuch-tree-read-thread)
              ("n" . jao-notmuch-tree-next)
              ("N" . jao-notmuch-tree-next-thread)
              ("O" . notmuch-tree-toggle-order)
              ("o" . jao-notmuch-tree-widen-search)
              ("p" . jao-notmuch-tree-previous)
              ("P" . jao-notmuch-tree-previous-thread)
              ("s" . jao-notmuch-tree-spam)
              ("u" . jao-notmuch-tree-flag)
              ("v" . notmuch-tree-scroll-message-window)
              ("V" . notmuch-tree-scroll-message-window-back)
              ("<" . jao-notmuch-tree-beginning-of-buffer)
              (">" . jao-notmuch-tree-end-of-buffer)
              ("/" . notmuch-tree-view-raw-message)
              ("." . jao-notmuch-toggle-mime-parts)
              ("=" . jao-notmuch-tree-toggle-message)
              ("RET" . jao-notmuch-tree-show-or-scroll)
              ("SPC" . jao-notmuch-tree-scroll-or-next))))
  #+end_src
* consult
  #+begin_src emacs-lisp
    (jao-load-path "consult-notmuch")
    (setq consult-notmuch-authors-width 30)
    (require 'consult-notmuch)
    (consult-customize consult-notmuch :preview-key 'any)

    (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-mailbox-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
    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
* hydras
  #+begin_src emacs-lisp
    (major-mode-hydra-define notmuch-search-mode nil
      ("Tagging"
       (("*" notmuch-search-tag-all "tag all")
        ("+" notmuch-search-add-tag "add tag")
        ("-" notmuch-search-remove-tag "add tag")
        ("k" notmuch-tag-jump "jump to tag"))
       "Search"
       (("l" notmuch-search-filter "filter with additional query")
        ("t" notmuch-search-filter-by-tag "filter by tag")
        ("y" notmuch-stash-query "stash current query"))
       "Moving around"
       (("b" notmuch-search-scroll-down "scroll down")
        ("<" notmuch-search-first-thread "first thread")
        (">" notmuch-search-last-thread "last thread"))))

    (major-mode-hydra-define notmuch-tree-mode nil
      ("View"
       (("." jao-notmuch-toggle-mime-parts "toggle mime parts")
        ("i" jao-notmuch-show-images "toggle images")
        ("a" notmuch-tree-archive-thread-then-next "archive thread")
        ("C" jao-notmuch-echo-count "echo unread count"))
       "Mark"
       (("d" jao-notmuch-tree-delete-message "delete message")
        ("D" jao-notmuch-tree-delete-thread "delete thread")
        ("u" (jao-notmuch-tree-delete-message t) "undelete message")
        ("k" jao-notmuch-tree-read-thread "kill thread"))
       "Edit/send"
       (("r" notmuch-tree-reply-sender "reply sender")
        ("R" notmuch-tree-reply "reply all")
        ("f" notmuch-tree-forward-message "forward")
        ("e" notmuch-tree-resume-message "edit draft"))))
  #+end_src