;;; +notmuch.el --- Notmuch extras -*- lexical-binding: t; -*-

;;; Commentary:

;; This is stuff that I suppose /could/ go in notmuch/init.el, but ... doesn't.

;;; Code:

(require 'cl-lib)
(require 'notmuch)

(defvar +notmuch-send-dispatch-rules nil
  "Alist of from addresses and variables to set when sending.")

(defun +notmuch-query-concat (&rest queries)
  "Concatenate notmuch queries."
  (mapconcat #'identity queries " AND "))

(defun +send-mail-dispatch ()
  "Dispatch mail sender, depending on account."
  (let ((from (message-fetch-field "from")))
    (dolist (vars (cl-loop for (addr . vars) in +notmuch-send-dispatch-rules
                           if (string-match-p addr from) return vars))
      (set (car vars) (cdr vars)))))

(defun +notmuch-correct-tags (args)
  (list (car args) (mapcar #'string-trim (cadr args))))

(defun +notmuch-goto (&optional prefix)
  "Go straight to a `notmuch' search.
Without PREFIX argument, go to the first one in
`notmuch-saved-searches'; with a PREFIX argument, prompt the user
for which saved search to go to; with a double PREFIX
argument (\\[universal-argument] \\[universal-argument]), prompt
for search."
  (interactive "P")
  (pcase prefix
    ('nil (notmuch-search (plist-get (car notmuch-saved-searches) :query)))
    ('(4) (notmuch-search (plist-get (cl-find (completing-read "Saved Search: "
                                                               (mapcar (lambda (el)
                                                                         (plist-get el :name))
                                                                       notmuch-saved-searches))
                                              notmuch-saved-searches
                                              :key (lambda (el) (plist-get el :name))
                                              :test #'equal)
                                     :query)))
    (_ (notmuch-search))))

;; Don't add an initial input when completing addresses
(eval-after notmuch
  (cond ((featurep 'el-patch)
         (el-patch-feature notmuch)
         (el-patch-defun notmuch-address-selection-function (prompt collection initial-input)
                         "Call (`completing-read'
           PROMPT COLLECTION nil nil INITIAL-INPUT 'notmuch-address-history)"
                         (completing-read
                          prompt collection nil nil
                          (el-patch-swap initial-input
                                         nil)
                          'notmuch-address-history)))
        (:else
         (defun notmuch-address-selection-function (prompt collection initial-input)
           "Call (`completing-read'
           PROMPT COLLECTION nil nil INITIAL-INPUT 'notmuch-address-history)"
           (completing-read
            prompt collection nil nil nil
            'notmuch-address-history)))))

(defcustom +notmuch-spam-tags '("+spam" "+Spam")
  "A list of tag changes to apply when marking a thread as spam."
  :type '(repeat string))

(defun +notmuch-tree-mark-spam-then-next (&optional ham beg end)
  "Mark the current message as spam and move to the next."
  (interactive "P")
  (+notmuch-tree-mark-spam ham)
  (notmuch-tree-next-matching-message))

(defun +notmuch-tree-mark-spam (&optional ham)
  "Mark the current message as spam.
That is, apply the tag changes in `+notmuch-spam-tags' to it.  If
an optional prefix HAM argument is given, the message will be
marked as not-spam (\"ham\"), i.e., the tag changes in
`+notmuch-spam-tags' will be reversed."
  (interactive "P")
  (when +notmuch-spam-tags
    (notmuch-tree-tag
     (notmuch-tag-change-list +notmuch-spam-tags ham))))

(defun +notmuch-search-mark-spam (&optional ham beg end)
  "Mark the current thread or region as spam.
This adds the tags in `+notmuch-spam-tags' to the message.  With
an optional HAM prefix argument, mark the messages as
not-spam (\"ham\").

This function advances the next thread when finished."
  (interactive (cons current-prefix-arg (notmuch-interactive-region)))
  (when +notmuch-spam-tags
    (notmuch-search-tag
     (notmuch-tag-change-list +notmuch-spam-tags ham) beg end))
  (when (eq beg end)
    (notmuch-search-next-thread)))

(defun +notmuch-tree-beginning (&optional arg)
  "Move point to beginning of message or tree, depending on ARG."
  (interactive "P")
  (cond
   ((and (window-live-p notmuch-tree-message-window)
         (not arg))
    (with-selected-window notmuch-tree-message-window
      (beginning-of-buffer)))
   (:else (beginning-of-buffer))))

(defun +notmuch-tree-end (&optional arg)
  "Move point to end of message or tree, depending on ARG."
  (interactive "P")
  (cond
   ((and (window-live-p notmuch-tree-message-window)
         (not arg))
    (with-selected-window notmuch-tree-message-window
      (end-of-buffer)))
   (:else (end-of-buffer))))

(defun +notmuch-make-saved-search (name key search-type &rest queries)
  "Wrapper to ease `notmuch-saved-searches' defining.
NAME, KEY, and SEARCH-TYPE are paired with the corresponding keywords in
`notmuch-saved-searches', which see.  QUERIES are all concatenated together with
AND.  If QUERIES is prepended with more keyword arguments, those are added to
the saved search as well."
  (declare (indent 3))
  (let (extra-keywords)
    (while (keywordp (car queries))
      (push (cadr queries) extra-keywords)
      (push (car queries) extra-keywords)
      (setf queries (cddr queries)))
    (add-to-list 'notmuch-saved-searches
                 (append
                  (list :name name
                        :key key
                        :search-type search-type
                        :query (apply #'+notmuch-query-concat queries))
                  (reverse extra-keywords))
                 :append
                 (lambda (a b)
                   (equal (plist-get a :name)
                          (plist-get b :name))))))

(provide '+notmuch)
;;; +notmuch.el ends here