path: root/notmuch.org

#+title: notmuch configuration
#+property: header-args :tangle no :comments no :results silent :shebang "#!/bin/bash"
#+auto_tangle: t

* notmuch
*** jumping from/to index
    #+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)
            (when (and and-click (button-at (point)))
              (push-button))
            t)))

      (defun jao-notmuch-goto-message-buffer* ()
        (interactive)
        (save-window-excursion (jao-notmuch-goto-message-buffer t)))

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

    #+end_src
*** shared commands
    #+begin_src emacs-lisp
      (defun jao-notmuch-tag-jump (reverse)
        "Create a jump menu for tagging operations, ensuring minibuffer can grow."
        (interactive "P")
        (let ((resize-mini-windows t)) (notmuch-tag-jump reverse)))

      (defun jao-notmuch-tree-by-tag (&optional new)
        "Jump to a tag tree search, using its key, and ensuring minibuffer can grow."
        (interactive "P")
        (when-let (tag (notmuch-select-tag-with-completion "Forest of tag: "))
          (notmuch-tree (concat "tag:" tag) (when new "tag:/unread|new/"))))

      (defun jao-notmuch-tree--tag-next (tags reverse &optional thread)
        (if thread
            (notmuch-tree-tag-thread (notmuch-tag-change-list tags reverse))
          (notmuch-tree-tag (notmuch-tag-change-list tags reverse)))
        (if thread
            (notmuch-tree-next-thread)
          (notmuch-tree-next-matching-message))
        (notmuch-tree-show-message nil))

      (defun jao-notmuch-tree-flagged-next (reverse)
        (interactive "P")
        (jao-notmuch-tree--tag-next '("+flagged") reverse))

      (defun jao-notmuch-follow-link (&optional external)
        (interactive "P")
        (with-current-notmuch-show-message
         (goto-char (point-min))
         (if (not (or (search-forward-regexp "\\bVia: " nil t)
                      (search-forward-regexp "\\bURL: " nil t)
                      (and (search-forward-regexp "\\bLink$" nil t)
                           (not (beginning-of-line)))))
             (user-error "No standard Via/URL/Link")
           (re-search-forward "https?://" nil t)
           (if external
               (jao-browse-with-external-browser)
             (browse-url (jao-url-around-point))))))

      (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)
                 (if add
                     (emms-add-url url)
                   (emms-play-url url)
                   (sit-for 1)
                   (jao-emms-echo)))
             (error "Found an enclosure, but not a link!")))))
    #+end_src
*** 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 "F" :query "tag:new and tag:feeds and not tag:emacs"
                 :face jao-themes-dimm)))

      (defun jao-notmuch-update-minibuffer ()
        (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 (or (plist-get c :face) 'default)))
                           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
      (defun jao-notmuch--and (frags)
        (when frags (mapconcat #'identity frags " AND ")))

      (defvar jao-notmuch-alt-searches '())

      (defun jao-notmuch-saved-search-jump ()
        "Jump to a saved search, using its key, for the alt list."
        (interactive)
        (let ((resize-mini-windows t)
              (notmuch-saved-searches jao-notmuch-alt-searches))
          (notmuch-jump-search)))

      (defun jao-notmuch--q-base (d0 d1 k q)
        (list :name (concat d0 (when d1 "/") d1)
              :search-type 'tree :key k :query q
              :sort-order 'oldest-first))

      (defun jao-notmuch--q (d0 d1 &optional k qs)
        (when (null qs)
          (add-to-list 'jao-notmuch-alt-searches
                       (jao-notmuch--q-base d0 d1 k
                                            (format "folder:%s/%s" d0 d1))
                       t))
        (let ((q (or (jao-notmuch--and qs)
                     (format "folder:%s/%s and tag:unread" d0 d1))))
          (jao-notmuch--q-base d0 d1 nil q)))

      (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" "deploys")
              ,(jao-notmuch--q "jao" "inbox" "ji")
              ,@(jao-notmuch--mboxes-search "jao" "inbox")
              ,@(jao-notmuch--mboxes-search "feeds")
              ,(jao-notmuch--q "bml/today" nil "tb" '("tag:bigml" "date:1d.."))
              ,(jao-notmuch--q "jao/today" nil "tj" '("tag:jao" "date:1d.."))
              ,(jao-notmuch--q "flagged" nil "r" '("tag:flagged"))
              ,(jao-notmuch--q "new" nil "n" '("tag:new"))
              ,(jao-notmuch--q "draft" nil "d" '("tag:draft"))))
    #+end_src
*** hello
    #+begin_src emacs-lisp
      (use-package notmuch-hello
        :init
        (setq notmuch-hello-sections '(notmuch-hello-insert-saved-searches
                                       notmuch-hello-insert-alltags
                                       ;; notmuch-hello-insert-recent-searches
                                       notmuch-hello-insert-header)
              notmuch-hello-thousands-separator ","
              notmuch-hello-recent-searches-max 5
              notmuch-show-all-tags-list t
              notmuch-show-logo nil
              notmuch-show-empty-saved-searches nil)
        (defun jao--refresh-agenda () (save-window-excursion (org-agenda-list)))

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

        :config

        (with-eval-after-load "consult-notmuch"
          (define-key notmuch-hello-mode-map "S" #'consult-notmuch))

        :hook ((notmuch-hello-refresh . jao-notmuch-update-minibuffer)
               (notmuch-hello-refresh . jao--refresh-agenda))

        :bind (:map notmuch-hello-mode-map
               (("g" . jao-notmuch-refresh-hello)
                ("k" . nil)
                ("SPC" . widget-button-press))))

    #+end_src
*** show
    #+begin_src emacs-lisp
      (use-package notmuch-show
        :init
        (setq notmuch-message-headers '("Subject" "To" "Cc" "Date" "List-Id")
              notmuch-show-all-multipart/alternative-parts nil
              notmuch-show-indent-messages-width 0
              notmuch-show-imenu-indent t
              notmuch-show-part-button-default-action 'notmuch-show-view-part
              notmuch-show-only-matching-messages t
              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

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

        (advice-add 'notmuch-clean-address :around #'jao-mail-clean-address)

        :bind (:map notmuch-show-mode-map
               (("h" . jao-notmuch-goto-index-buffer)
                ("i" . jao-notmuch-toggle-images)
                ("j" . jao-notmuch-saved-search-jump)
                ("k" . jao-notmuch-tag-jump))))
    #+end_src
*** tree
    #+begin_src emacs-lisp
      (use-package notmuch-tree
        :init
        (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)

        :config

        (defun jao-notmuch-tree-next (no-exit)
          "Next message in forest or exit if none."
          (interactive "P")
          (notmuch-tree-next-matching-message (not no-exit)))

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

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

        (defun jao-notmuch-tree-delete (reverse &optional next)
          "Mark as deleted current message. Prefix undeletes."
          (interactive "P")
          (notmuch-tree-tag
           (notmuch-tag-change-list '("+deleted" "-unread" "-new") reverse))
          (when next (notmuch-tree-next-message)))

        (defun jao-notmuch-tree-undelete (reverse)
          "Mark as not-deleted current message and move to next."
          (interactive "P")
          (jao-notmuch-tree-delete (not reverse)))

        (defun jao-notmuch-tree-read-thread-next (&optional delete)
          "Mark the current thread as read and move to next one."
          (interactive "P")
          (jao-notmuch-tree--tag-next (if delete
                                          '("+deleted" "-unread" "-new")
                                        '("-unread" "-new"))
                                      nil t))

        (dolist (f '(notmuch-tree-match-tree-face
                     notmuch-tree-no-match-tree-face))
          (set-face-attribute f nil
                              :family "Source Code Pro" :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)

        :bind (:map notmuch-tree-mode-map
               (("." . jao-notmuch-toggle-mime-parts)
                ("i" . jao-notmuch-toggle-images)
                ("d" . jao-notmuch-tree-delete)
                ("D" . jao-notmuch-tree-undelete)
                ("h" . jao-notmuch-goto-message-buffer)
                ("H" . jao-notmuch-goto-message-buffer*)
                ("K" . jao-notmuch-tag-jump)
                ("k" . jao-notmuch-tree-read-thread-next)
                ("n" . jao-notmuch-tree-next)
                ("RET" . jao-notmuch-tree-show-or-scroll)
                ("SPC" . jao-notmuch-tree-scroll-or-next))))
    #+end_src
*** message
    #+begin_src emacs-lisp
      (use-package notmuch-message
        :init (setq notmuch-fcc-dirs
                    '((".*@bigml.com" . "bigml/sent +bigml +sent -new")
                      (".*" . "jao/sent +jao +sent -new"))
                    notmuch-maildir-use-notmuch-insert t))

      (when (eq jao-afio-mail-function 'notmuch)
        (setq message-directory "~/var/mail/"
              message-auto-save-directory nil)
        (eval-after-load "notmuch-message"
          '(define-key message-mode-map (kbd "C-c C-d")
             #'notmuch-draft-postpone)))
    #+end_src
*** main
    #+begin_src emacs-lisp
      (use-package notmuch
        :init
        (setq notmuch-crypto-process-mime t
              notmuch-show-mark-read-tags '("-new" "-unread")
              notmuch-archive-tags '("+trove" "-new" "-unread" "-flagged")
              notmuch-tagging-keys
              '(("a" notmuch-archive-tags "Archive")
                ("d" notmuch-show-mark-read-tags "Mark read")
                ("u" ("+new" "+unread") "Mark unread")
                ("f" ("+flagged") "Flag")
                ("x" ("+deleted" "-new" "-flagged" "-unread") "Deleted")))

        :config

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

        :bind (:map notmuch-common-keymap
                    (("B" . jao-notmuch-browse-urls)
                     ("E" . jao-notmuch-open-enclosure)
                     ("M-g" . jao-notmuch-follow-link)
                     ("j" . jao-notmuch-saved-search-jump)
                     ("k" . jao-notmuch-tag-jump)
                     ("s" . notmuch-tree)
                     ("T" . notmuch-search-by-tag)
                     ("t" . jao-notmuch-tree-by-tag)
                     ("u" . jao-notmuch-tree-flagged-next)
                     ("U" . notmuch-unthreaded)
                     ("z" . notmuch-search))))
    #+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
*** expire shell script
    #+begin_src bash :tangle ./bin/notmuch-expire.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
*** gpgsm.conf (decrypt smime)
    #+begin_src conf :tangle ~/.gnupg/gpgsm.conf :shebang ""
      # needed to avoid remote checks of smime signatures
      # and notmuch-crypto-process-mime to work with them
      disable-crl-checks
    #+end_src