;;; jao-notmuch.el --- Extensions for notmuch        -*- lexical-binding: t; -*-

;; Copyright (C) 2021  jao

;; Author: jao <mail@jao.io>
;; Keywords: mail

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <https://www.gnu.org/licenses/>.

;;; Commentary:

;;  Extensions to vanilla notmuch, mostly for tree view

;;; Code:

(require 'notmuch)
(require 'notmuch-tree)
(require 'notmuch-show)


;; Moving messages around

(defvar jao-notmuch-mailboxes nil)
(defvar jao-notmuch-mailboxes-rx nil)

(defun jao-notmuch--path-to-mailbox (full-path)
  (unless jao-notmuch-mailboxes-rx
    (setq jao-notmuch-mailboxes-rx (regexp-opt jao-notmuch-mailboxes)))
  (if (string-match jao-notmuch-mailboxes-rx full-path)
      (match-string 0 full-path)
    (user-error "Message not in any mailbox!")))

(defun jao-notmuch-msg-props ()
  (if-let ((p (save-excursion
                (text-property-search-forward :notmuch-message-properties))))
      (prop-match-value p)
    (user-error "No message at point")))

(defun jao-notmuch--move (full-path &optional d)
  (let* ((ff (jao-notmuch--path-to-mailbox full-path))
         (d (or d (completing-read (format "From %s to: " ff)
                                   (remove ff jao-notmuch-mailboxes)
                                   nil
                                   t)))
         (dest (string-replace ff d full-path))
         (dest (replace-regexp-in-string ",U=.+$" "" dest))
         (fnd (file-name-nondirectory full-path))
         (dnd (file-name-nondirectory dest))
         (prompt (format "%s/%s -> %s/%s? " ff fnd d dnd)))
    (when (y-or-n-p prompt)
      (let ((c (notmuch-tag-change-list (split-string ff "/") t))
            (cc (notmuch-tag-change-list (split-string d "/"))))
        (notmuch-tree-tag (append c cc)))
      (notmuch-tree-close-message-window)
      (rename-file full-path dest)
      (shell-command-to-string "notmuch new")
      (notmuch-refresh-this-buffer))))

(defun jao-notmuch-move-message ()
  (interactive)
  (let* ((p (jao-notmuch-msg-props))
         (f (car (plist-get p :filename))))
    (jao-notmuch--move (or f ""))))

(defun jao-notmuch-tree-spam ()
  (interactive)
  (let* ((p (jao-notmuch-msg-props))
         (f (car (plist-get p :filename)))
         (mbox (car (split-string (jao-notmuch--path-to-mailbox f) "/"))))
    (notmuch-tree-tag '("-new" "-unread"))
    (jao-notmuch--move f (concat mbox "/spam"))))


;; Targetting the displayed message from the tree view

(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)
      (or (not and-click)
          (cond ((eww--url-at-point) (shr-browse-url) 'url)
                ((button-at (point)) (push-button) 'button))))))

(defun jao-notmuch-click-message-buffer ()
  (interactive)
  (let ((b (current-buffer)))
    (unless (eq 'url (jao-notmuch-goto-message-buffer t))
      (pop-to-buffer b))))

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


;; Keeping track of unread messages in current tree view

(defun jao-notmuch--unread-count ()
  (save-excursion
    (goto-char (point-min))
    (let ((p) (cnt))
      (while (setq p (text-property-search-forward
                      :notmuch-message-properties))
        (unless cnt (setq cnt 0))
        (let ((tags (plist-get (prop-match-value p) :tags)))
          (when (or (member "unread" tags) (member "new" tags))
            (setq cnt (1+ cnt)))))
      cnt)))

(defun jao-notmuch-tree-update-buffer-name (&optional n)
  (when-let ((n (or n (jao-notmuch--unread-count))))
    (rename-buffer (format "*%s - {%s messages left}*"
                           notmuch-tree-basic-query
                           n))
    (jao-minibuffer-refresh)))

(defun jao-notmuch-tree-next (thread &optional no-exit)
  "Next message or thread in forest or exit if none."
  (interactive "P")
  (if thread
      (progn (notmuch-tree-next-thread)
             (notmuch-tree-show-message nil))
    (notmuch-tree-next-matching-message (not no-exit)))
  (jao-notmuch-tree-update-buffer-name))

;; Tagging

(defun jao-notmuch-tag-jump-and-next (reverse)
  (interactive "P")
  (notmuch-tag-jump reverse)
  (jao-notmuch-tree-next nil t))

(defun jao-notmuch-tree--tag-and-next (tags reverse whole-thread)
  (let ((c (notmuch-tag-change-list tags reverse)))
    (if whole-thread (notmuch-tree-tag-thread c) (notmuch-tree-tag c)))
  (jao-notmuch-tree-next whole-thread t))

(defun jao-notmuch-tree-delete-message (undelete)
  (interactive "P")
  (jao-notmuch-tree--tag-and-next '("+deleted" "-new" "-unread") undelete nil))

(defun jao-notmuch-tree-delete-thread ()
  (interactive)
  (jao-notmuch-tree--tag-and-next '("+deleted" "-new"  "-unread") nil t))

(defun jao-notmuch-tree-read-thread ()
  (interactive)
  (jao-notmuch-tree--tag-and-next '("-unread" "-new") nil t))

;; Scrolling the shown message

(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)))
  (jao-notmuch-tree-update-buffer-name))

(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)
    (jao-notmuch-tree-update-buffer-name)))


(provide 'jao-notmuch)
;;; jao-notmuch.el ends here