;;; 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 "S"		#'spw/spam-message)
(define-key notmuch-search-mode-map [f7]	#'spw/kill-thread)
(define-key notmuch-search-mode-map "\M-k"	#'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   "S"		#'spw/spam-message)
(define-key notmuch-show-mode-map   [f7]	#'spw/kill-thread)
(define-key notmuch-show-mode-map   "\M-k"	#'spw/kill-thread)

;; ditto
(define-key notmuch-tree-mode-map   [f5]	#'spw/spam-message)
(define-key notmuch-tree-mode-map   "S"		#'spw/spam-message)
(define-key notmuch-tree-mode-map   [f7]	#'spw/kill-thread)
(define-key notmuch-tree-mode-map   "\M-k"	#'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-show-mode-map   " "         #'spw/notmuch-show-advance-and-archive)

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

(defun spw/kill-thread ()
  (interactive)
  (cl-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))
    (notmuch-search-mode
     ;; here we want to avoid tagging every message in the thread to reduce
     ;; pressure on nmbug-spw.git -- so we just pick the first of the matched
     ;; messages
     (notmuch-tag
      (car (split-string (car (plist-get (notmuch-search-get-result) :query))))
      '("+spw::killed"))
     (notmuch-search-archive-thread)))
  (message "Thread killed"))

(defun spw/spam-message ()
  (interactive)
  (cl-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.")

(defun spw/notmuch-query-has-results-p (query)
  "Predicate testing whether any messages match notmuch query QUERY."
  (length> (process-lines notmuch-command
			  "search"
			  "--output=messages"
			  "--limit=1"
			  "--format=text"
			  "--format-version=4"
			  query)
	   0))

(cl-flet* ((connective (word)
                       (apply-partially
                        (lambda (connec &rest queries)
                          (mapconcat (lambda (query) (concat "(" query ")"))
				     (flatten-tree 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)
	  ;; also add the tag:unread version of the search as a saved search
	  ;; so that buffers created by `spw/next-unread-group' get a
	  ;; reasonable name
	  (let ((keyless-search (copy-sequence search)))
	    (plist-put keyless-search :key nil)
	    (plist-put keyless-search
		       :name
		       (concat (plist-get search :name) " unread"))
	    (plist-put keyless-search
		       :query
		       (conjoin "tag:unread" (plist-get search :query)))
	    (add-to-list 'notmuch-saved-searches keyless-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)
    (add-to-list 'notmuch-saved-searches
		 '(:name "phone notes" :key "N" :search-type nil
			 :sort-order newest-first
			 :query "folder:notes") t)

    (let* ((categorised (disjoin
                         spw/readall
                         (mapcar (lambda (search)
                                   (if (atom search)
                                       search
                                     (plist-get search :queries)))
                                 spw/lists-browse)
                         spw/lists-archiveonly))
	   ;; content not from mailing lists and not otherwise categorised --
	   ;; previously such items would fall into "uncategorised unread" but
	   ;; that's wrong because I've explicitly subscribed to each of these
	   (uncategorised-feeds (conjoin "tag:unread"
					 "from:rss@spwhitton.name"
					 (negate categorised)))
	   ;; finally, groups/lists where I don't know how or whether I want
	   ;; to follow them; I may have subscribed just to post something
	   (uncategorised-other (conjoin "tag:unread"
					 (negate "from:rss@spwhitton.name")
					 (negate categorised)))
	   (feeds-query `(:name "uncategorised feeds"
				:key "R" :search-type nil
				:sort-order newest-first
				:query ,uncategorised-feeds))
	   (other-query `(:name "uncategorised unread"
				:key "U" :search-type nil
				:sort-order newest-first
				:query ,uncategorised-other)))
      ;; splice it in just after "weekday unread" and "weekend unread"
      (setcdr (cdr notmuch-saved-searches)
	      (cons (cons "uncategorised feeds" uncategorised-feeds)
		    (cddr notmuch-saved-searches)))
      (add-to-list 'notmuch-saved-searches other-query t)
      (add-to-list 'spw/lists-browse-searches
                   (cons "uncategorised feeds" uncategorised-feeds))
      (add-to-list 'spw/lists-browse-searches
                   (cons "uncategorised unread" uncategorised-other)
		   t)))

  (defun spw/notmuch-catchup-by-archive ()
    (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")))
      (spw/next-unread-group)))

  (defun spw/notmuch-catchup-by-killing ()
    (interactive)
    (when (and (eq major-mode 'notmuch-search-mode)
	       (y-or-n-p "Are you sure you want to kill all threads?")
	       spw/readall)
      (cl-loop initially (goto-char (point-min))
               for r = (notmuch-search-get-result)
                 then (and (notmuch-search-next-thread)
                           (notmuch-search-get-result))
               for ids = (car (plist-get r :query))
               while r
               if (and ;; Don't touch if any messages in the thread match
                       ;; `spw/readall' as we don't catchup such threads
                       (not (spw/notmuch-query-has-results-p
                             (conjoin (concat "thread:" (plist-get r :thread))
                                      spw/readall)))
                       ;; Don't touch unless there are unread messages, so
                       ;; that we skip over threads which have been manually
                       ;; processed -- this is in case I just archived the
                       ;; thread without killing it, and want any new messages
                       ;; to show up as unread.
                       ;;
                       ;; We can't rely on (plist-get r :tags) here because
                       ;; that might be out-of-date if the thread was archived
                       ;; from `notmuch-show-mode' rather than this buffer,
                       ;; and we can't refresh the buffer as we don't want to
                       ;; kill any newly-arrived threads
                       (spw/notmuch-query-has-results-p
                        (conjoin "tag:unread" ids)))
               do ;; Only catchup the messages that were part of this saved
		  ;; search
		  (notmuch-tag ids '("-unread"))
                  ;; As in `spw/kill-thread' for `notmuch-search-mode', want
                  ;; to tag only single messages with spw::killed
                  (notmuch-tag (car (split-string ids)) '("+spw::killed"))
	       finally (spw/next-unread-group))))

  (defun spw/notmuch-show-advance-and-archive ()
    "Like `notmuch-show-advance-and-archive' but confirm thread archive.

Note that this does not archive individual messages are you
scroll through them."
    (interactive)
    (when (or ;; since we have a confirmation, it's fine to archive when point
	      ;; it not yet at the bottom of the window
	      (pos-visible-in-window-p (point-max))
	      (notmuch-show-advance))
      (if (let ((map (make-sparse-keymap)))
	    (set-keymap-parent map query-replace-map)
	    (define-key map " " 'ignore)
	    ;; override usual map so SPC cannot confirm the archive, to avoid
	    ;; accidental archives
	    (let ((query-replace-map map))
	      (y-or-n-p "Mark all as read before moving on?")))
	  (when (and notmuch-show-thread-id notmuch-archive-tags)
	    ;; only tag messages which would have been expanded when we opened
	    ;; the thread
	    (notmuch-tag
	     (conjoin notmuch-show-query-context notmuch-show-thread-id)
	     (notmuch-tag-change-list notmuch-archive-tags nil))
	    (notmuch-show-next-thread t))
	(notmuch-show-next-thread-show)))))

;; use on views produced by `spw/next-unread-group'
(defun spw/notmuch-catchup (arg)
  (interactive "P")
  (if arg
      (spw/notmuch-catchup-by-archive)
    (spw/notmuch-catchup-by-killing))
  (message "Group caught up"))

(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))
      (put 'spw/more-unread-groups 'permanent-local t))))

(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