path: root/.emacs.d/init-notmuch.el

;;; init-notmuch.el --- Sean's notmuch-emacs config -*- lexical-binding: t -*-

;;; Code:

(require 'cl-lib)

(require 'notmuch)
(require 'notmuch-hello)
(require 'notmuch-message)


;;;; Preferences and variables

(setq notmuch-show-all-tags-list t
      notmuch-tagging-keys '(("u" ("+unread") "Mark as unread")
                             ("s" ("-unread" "+spam") "Mark as spam")

                             ;; 'm' for 'mute'
                             ("m" ("-unread" "+spw::killed") "Kill thread")

                             ;; for work mail sent to a personal
                             ;; address, or similar
                             ("w" ("+spw::work") "Mark as work-related")

                             ("b" ("+spw::browse") "Mark for browsing")
                             ("d" ("-unread" "+deleted") "Send to trash")
                             ("f" ("-unread" "+flagged") "Unread->flagged")
                             ("F" ("-flagged") "Unflag message"))

      ;; default is t, but given that notmuch searches run to the
      ;; beginning of time, and we are likely to want recent mail, we want
      ;; newer e-mails at the top
      notmuch-search-oldest-first nil

      ;; Don't collapse cited text.  We ought to be able to just remove
      ;; `notmuch-wash-excerpt-citations' from
      ;; `notmuch-show-insert-text/plain-hook', but that function is also
      ;; responsible for colouring cited text (this is an upstream bug:
      ;; that function does the colouring for performance reasons but the
      ;; right answer is to use fontlocking, not overlays, for the
      ;; colouring)
      notmuch-wash-citation-lines-prefix 10000
      notmuch-wash-citation-lines-suffix 10000

      send-mail-function 'sendmail-send-it

      ;; always decrypt & verify PGP parts
      notmuch-crypto-process-mime t

      ;; have Emacs set envelope-from to bypass my MTA rewriting of
      ;; user@localhost
      mail-specify-envelope-from t
      mail-envelope-from 'header
      message-sendmail-envelope-from 'header

      notmuch-archive-tags '("-unread")
      notmuch-maildir-use-notmuch-insert t
      notmuch-fcc-dirs "sent -unread"

      ;; when 'unread' is being used as an inbox, want manual resolution
      ;; of messages
      notmuch-show-mark-read-function 'ignore
      notmuch-show-mark-read-tags nil
      ;; but always resolve when I write a reply
      notmuch-message-replied-tags '("-unread" "+replied")

      notmuch-mua-user-agent-function 'notmuch-mua-user-agent-full

      ;; for compatibility
      message-forward-before-signature nil
      message-forward-as-mime nil
      message-forward-included-headers
      "^\\(From\\|To\\|Cc\\|Subject\\|Date\\|Message-ID\\):"
      message-make-forward-subject-function #'message-forward-subject-fwd

      notmuch-mua-cite-function #'message-cite-original-without-signature
      message-citation-line-function #'message-insert-formatted-citation-line
      message-citation-line-format "On %a %d %b %Y at %I:%M%p %Z, %N wrote:\n"

      ;; default dir for saving attachments
      mm-default-directory "~/tmp/"

      ;; encrypt messages to me too, so I can read copies in my sent mail folder
      mml-secure-openpgp-encrypt-to-self t

      mml-secure-openpgp-sign-with-sender t

      message-kill-buffer-on-exit t)

;; these three vars get set in notmuch-groups.el
(defvar spw/lists-readall nil
  "Lists where I want to read all posts as if they're addressed
directly to me -- these get inserted into my main inbox
views.")
(defvar spw/lists-browse nil
  "Lists I want to read like newsgroups, though with no expiry
and manual catchup.

Two ways to read:

1. Access saved searches from `notmuch-hello', then use
`notmuch-search-filter' to look for something in particular.

2. Access using `spw/next-unread-group' to read new postings.")
(defvar spw/lists-archiveonly nil
  "Lists for which I'm subscribed only because I want to
    archive all postings.  Sieve script should be configured to
    mark as read.")
;; indeed, marking as read of incoming mail should generally occur
;; server-side


;;;; Bindings and advising commands

(advice-add 'notmuch-tree-archive-thread :after #'notmuch-tree-next-thread)

(define-key notmuch-message-mode-map "\C-c\C-s" #'message-goto-subject)

(define-key notmuch-show-mode-map "\C-cg.g" #'spw/notmuch-import-gpg)
(define-key notmuch-show-mode-map "\C-cg.a" #'spw/notmuch-show-apply-part-to-project)

;; we want these not to be adjacent keys
(define-key notmuch-search-mode-map [f5] #'spw/spam-message)
(define-key notmuch-search-mode-map [f7] #'spw/kill-thread)
(define-key notmuch-search-mode-map [f9] #'spw/next-unread-group)

;; ditto
(define-key notmuch-show-mode-map   [f5] #'spw/spam-message)
(define-key notmuch-show-mode-map   [f7] #'spw/kill-thread)

;; ditto
(define-key notmuch-tree-mode-map   [f5] #'spw/spam-message)
(define-key notmuch-tree-mode-map   [f7] #'spw/kill-thread)
(define-key notmuch-tree-mode-map   [f9] #'spw/next-unread-group)

(define-key notmuch-hello-mode-map  [f9] #'spw/next-unread-group)

(define-key notmuch-tree-mode-map   "\C-cgo" #'spw/notmuch-reader)
(define-key notmuch-tree-mode-map   "\C-cC" #'spw/notmuch-catchup)

(define-key notmuch-show-mode-map   "\C-cgo" #'spw/notmuch-reader)
(define-key notmuch-search-mode-map "\C-cC" #'spw/notmuch-catchup)

(define-key notmuch-message-mode-map [remap notmuch-mua-send-and-exit]
  #'spw/notmuch-mua-send-and-exit)

(define-key notmuch-show-mode-map "\C-cgf"
  #'spw/notmuch-show-filter-thread-patches)
(define-key notmuch-show-mode-map "\C-cgi"
  #'spw/notmuch-show-with-remote-images)


;;;; Commands

(defun spw/notmuch-import-gpg ()
  (interactive)
  (when (get-buffer "*notmuch-pipe*")
    (with-current-buffer "*notmuch-pipe*"
      (let ((buffer-read-only nil))
        (erase-buffer))))
  (notmuch-show-pipe-message t "gpg --decrypt | gpg --import")
  (display-buffer "*notmuch-pipe*"))

;; unlike `notmuch-extract-thread-patches' and
;; `notmuch-extract-message-patches', it does not make sense to
;; check out a branch when performing an action which will not make
;; a commit.  If that's wanted, the code which calls
;; `spw/notmuch-show-apply-part-projectile' should perform the checkout
(defun spw/notmuch-show-apply-part-to-project ()
  (interactive)
  (let ((default-directory (expand-file-name (project-prompt-project-dir))))
    (notmuch-show-apply-to-current-part-handle
     (lambda (handle)
       (mm-pipe-part handle "git apply")))))

;; not available in `notmuch-search-mode' for now because we want to
;; apply spw::killed to only a single message, not a whole thread,
;; to minimise what gets committed to ~/lib/nmbug-spw
(defun spw/kill-thread ()
  (interactive)
  (case major-mode
    (notmuch-show-mode
     (notmuch-show-tag '("+spw::killed"))
     (notmuch-show-archive-thread-then-next))
    (notmuch-tree-mode
     (notmuch-tree-close-message-window)
     (notmuch-tree-tag '("+spw::killed"))
     (notmuch-tree-archive-thread)
     (unless (notmuch-tree-get-match)
       (notmuch-tree-next-matching-message))
     (notmuch-tree-show-message nil)))
  (message "Thread killed"))

(defun spw/spam-message ()
  (interactive)
  (case major-mode
    (notmuch-show-mode
     (notmuch-show-tag '("-unread" "+spam"))
     (notmuch-show-archive-message-then-next-or-next-thread))
    (notmuch-tree-mode
     (notmuch-tree-tag '("-unread" "+spam"))
     (notmuch-tree-next-matching-message)))
  (message "Message marked as spam"))

(defun spw/notmuch-reader ()
  (interactive)
  (with-current-buffer (or notmuch-tree-message-buffer (current-buffer))
    (save-excursion
      (re-search-forward "^URL:\\( \\|\n\\)")
      (let ((url (buffer-substring-no-properties (point) (line-end-position))))
	;; alternative to eww readable view:
	;; (start-process "firefox" nil "firefox"
	;;                "-new-window"
	;;                (concat "about:reader?url=" url))
	(spw/next-eww-readable)
	(eww url)))))

(defvar spw/lists-browse-searches nil
  "Internal cache variable.")
(defvar spw/readall nil
  "Internal cache variable.")

(cl-flet* ((connective (word)
                       (apply-partially
                        (lambda (connec &rest queries)
                          (mapconcat (lambda (query) (concat "(" query ")"))
				     (spw/flatten queries)
                                     (concat " " connec " ")))
                        word))
           (disjoin (connective "or"))
           (conjoin (connective "and"))
           (negate (query) (concat "not (" query ")"))
           (thread (query) (concat "thread:{" query "}")))
  (defvar spw/weekday-only-mail (disjoin "to:spwhitton@email.arizona.edu"
                                          "from:arizona.edu"
                                          (thread "tag:spw::work"))
    "Mail to be filtered out of processing views at the weekend.")

  (defun spw/standard-notmuch-saved-searches ()
    (interactive)
    (setq notmuch-saved-searches nil
          spw/lists-browse-searches nil)
    (when (file-exists-p (locate-user-emacs-file "notmuch-groups.el"))
      (load (locate-user-emacs-file "notmuch-groups"))
      (dolist (group spw/lists-browse)
        (let ((search
               (if (atom group)
                   ;; assume we got a List: search and extract the first
                   ;; component of the List-Id to use as the name of the
                   ;; search
                   (let ((name (if (string-match ":\\([^.]+\\)\\." group)
                                   (match-string 1 group)
                                 (error "Could not extract a list name"))))
                     `(:name ,name :search-type nil :sort-order newest-first
                             :query ,group))
                 ;; assume a plist and copy properties across
                 (let ((name (plist-get group :name))
                       (key (plist-get group :key))
                       (query (disjoin (plist-get group :queries))))
                   `(:name ,name :search-type nil :sort-order newest-first
                           :key ,key :query ,query)))))
          (add-to-list 'notmuch-saved-searches search t)
          (add-to-list 'spw/lists-browse-searches
                       (cons (plist-get search :name)
                             (conjoin "tag:unread" (plist-get search :query)))
                       t))))

    (setq spw/readall
          (conjoin
           (disjoin
            "folder:inbox"

            ;; can use this to include all mail addressed directly
            ;; to me in processing views, as an alternative to
            ;; relying on 'folder:inbox'
            ;; (mapcar (lambda (a) (concat "to:" a)) (notmuch-user-emails))

            spw/lists-readall)
           (negate (thread "tag:spw::browse"))))

    ;; now prepend views for processing the day's mail addressed to me
    (let* ((to-process (conjoin "tag:unread" spw/readall))
           (to-process-weekend (conjoin to-process
                                        (negate spw/weekday-only-mail))))
      (add-to-list 'notmuch-saved-searches
                   `(:name "weekend unread" :key "w" :search-type nil
                           :sort-order oldest-first
                           :query ,to-process-weekend))
      (add-to-list 'notmuch-saved-searches
                   `(:name "weekday unread" :key "u" :search-type nil
                           :sort-order oldest-first
                           :query ,to-process)))

    ;; append some miscellaneous views
    (add-to-list 'notmuch-saved-searches
                 '(:name "flagged" :key "f" :search-type tree
                         :query "tag:flagged" ) t)
    (add-to-list 'notmuch-saved-searches
                 `(:name "sent" :key "s" :search-type nil
                         :sort-order newest-first
                         :query ,(disjoin
                                  (mapcar
                                   (lambda (a) (concat "from:" a))
                                   (notmuch-user-emails))))
                 t)
    (add-to-list 'notmuch-saved-searches
                 '(:name "drafts" :key "D" :search-type nil
                         :sort-order newest-first
                         :query "tag:draft") t)
    (add-to-list 'notmuch-saved-searches
                 '(:name "imported series" :key "P" :search-type nil
                         :sort-order newest-first
                         :query "subject:\"/PATCH .+ imported/\"") t)

    ;; finally, groups/lists where I don't know how or whether I want to
    ;; follow them; I may have subscribed just to post something
    (let* ((categorised (disjoin
                         spw/readall
                         (mapcar (lambda (search)
                                   (if (atom search)
                                       search
                                     (plist-get search :queries)))
                                 spw/lists-browse)
                         spw/lists-archiveonly))
           (query `(:name "uncategorised unread" :key "U" :search-type nil
                          :sort-order newest-first
                          :query ,(conjoin "tag:unread"
                                           (negate categorised)))))
      (add-to-list 'notmuch-saved-searches query t)
      (add-to-list 'spw/lists-browse-searches
                   (cons "uncategorised unread"
                         (conjoin "tag:unread"
                                  (negate categorised))) t)))

  ;; use on views produced by `spw/next-unread-group'
  (defun spw/notmuch-catchup ()
    (interactive)
    (when (and (memq major-mode '(notmuch-tree-mode notmuch-search-mode))
               (y-or-n-p "Are you sure you want to mark all as read?")
               spw/readall)
      (let ((query (if (eq major-mode 'notmuch-tree-mode)
		       (notmuch-tree-get-query)
		     (notmuch-search-get-query))))
	(notmuch-tag (conjoin query (negate spw/readall)) '("-unread")))
      (notmuch-refresh-this-buffer))))

(defun spw/next-unread-group ()
  (interactive)
  (let ((already-looking (boundp 'spw/more-unread-groups))
        (queries (bound-and-true-p spw/more-unread-groups))
        (remaining))
    (when already-looking
      (when (eq major-mode 'notmuch-tree-mode)
	(notmuch-tree-close-message-window))
      (kill-buffer (current-buffer)))
    (if (or (and already-looking (not queries))
            (not (setq remaining (seq-drop-while
                                  (lambda (q)
                                    (zerop (string-to-number
                                            (notmuch-saved-search-count
                                             (cdr q)))))
                                  (or queries spw/lists-browse-searches)))))
        (notmuch-hello)
      ;; I think that a tree-style view is probably best for browsing groups,
      ;; but atm notmuch-tree's use of windows is a bit inflexible, so use
      ;; notmuch-search
      ;; (notmuch-tree (cdar remaining) nil nil
      ;;               (concat "*notmuch-tree-saved-search-"
      ;;                       (caar remaining) "*"))
      (notmuch-search (cdar remaining) t)
      ;; renaming the buffer seems to break refreshing it & reversing the
      ;; sort order
      ;; (rename-buffer (concat "*notmuch-saved-search-" (caar remaining) "*") t)
      (set (make-local-variable 'spw/more-unread-groups)
           (cdr remaining)))))

(defun spw/notmuch-mua-send-and-exit ()
  (interactive)
  (when (or spw/message-normalised
	    (y-or-n-p "Send message which has not been auto-formatted?"))
    (call-interactively #'notmuch-mua-send-and-exit)))


;; In a thread with patches, try to collapse messages not relevant for
;; reviewing those patches.  Optional numeric prefix argument specifies the
;; version of the series to review, in case there is more than one series in
;; the thread.  Include spw::unresolved mail, as these may contain unresolved
;; review comments on older versions of the series.
;;
;; In the case where you want to compare the new series against unresolved
;; review comments on the old series, and the series are in different threads,
;; open each thread in a separate buffer (probably in separate frames).  Run
;; this command in the new series' buffer and hit `l tag:spw::unresolved RET'
;; in the old series' buffer
(defun spw/notmuch-show-filter-thread-patches (&optional reroll-count)
  (interactive "P")
  (let ((subject-filter
         (if reroll-count
             (let ((n (prefix-numeric-value reroll-count)))
               (if (= n 1)
		   (concat "("
			   "subject:/\\[.*PATCH[^v]*\\]/"
			   "or"
			   "subject:/\\[.*PATCH.*v1.*\\]/"
			   ")")
                 (concat "subject:/\\[.*PATCH.*v"
			 (number-to-string n)
			 ".*\\]/")))
           "subject:/\\[.*PATCH.*\\]/ ")))
    (notmuch-show-filter-thread
     (concat "tag:unread or tag:spw::unresolved or ("
             subject-filter
             " and not subject:'Re:' and not subject:'Info received')"))))

(defun spw/notmuch-show-with-remote-images ()
  (interactive)
  (setq-local notmuch-show-text/html-blocked-images nil
	      notmuch-multipart/alternative-discouraged '("text/plain"))
  (notmuch-show-refresh-view))


;;;; Startup

(unless spw/lists-browse-searches
  (spw/standard-notmuch-saved-searches))

;;; init-notmuch.el ends here