jao-notmuch.el, it had to happen (also, who said we cannot move msgs)

2 files changed, 231 insertions, 132 deletions

diff --git a/email.org b/email.org
index 3b044a6..f527f9b 100644
--- a/email.org
+++ b/email.org
@@ -253,6 +253,15 @@
     (defun jao-list-mailboxes (base)
       (let ((dir (expand-file-name base "~/var/mail")))
         (seq-difference (directory-files dir) '("." ".." "trash" "spam"))))
+
+    (defun jao-mailbox-folders ()
+      (seq-mapcat (lambda (base)
+                    (mapcar `(lambda (d) (format "%s/%s" ,base d))
+                            (jao-list-mailboxes base)))
+                  '("jao" "bigml" "feeds" "trove")))
+
+    (defvar jao-mailbox-folders (jao-mailbox-folders))
+    (defvar jao-mailbox-folders-rx (regexp-opt jao-mailbox-folders))
   #+end_src
 * consult narrowing
   #+begin_src emacs-lisp
@@ -474,131 +483,9 @@
     #+end_src
 *** tree view
     #+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)
-            (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)))))
-
-      (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))
-
-      (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-spam ()
-        (interactive)
-        (jao-notmuch-tree--tag-and-next '("+spam" "-new" "-unread") nil 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))
-
-      (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)))
+      (use-package jao-notmuch
+        :demand t
+        :config (setq jao-notmuch-mailboxes jao-mailbox-folders))
 
       (use-package notmuch-tree
         :config
@@ -633,6 +520,7 @@
                      ("i" . jao-notmuch-toggle-images)
                      ("K" . jao-notmuch-tag-jump-and-next)
                      ("k" . jao-notmuch-tree-read-thread)
+                     ("M" . jao-notmuch-move-message)
                      ("n" . jao-notmuch-tree-next)
                      ("s" . jao-notmuch-tree-spam)
                      ("RET" . jao-notmuch-tree-show-or-scroll)
@@ -711,12 +599,6 @@
         :init (setq consult-notmuch-authors-width 30)
         :config (consult-customize consult-notmuch :preview-key 'any))
 
-      (defvar jao-consult-notmuch-folders
-        (seq-mapcat (lambda (base)
-                      (mapcar `(lambda (d) (format "%s/%s" ,base d))
-                              (jao-list-mailboxes base)))
-                    '("jao" "bigml" "feeds" "trove")))
-
       (defvar jao-consult-notmuch-history nil)
 
       (defun jao-consult-notmuch-folder (&optional tree folder)
@@ -725,7 +607,7 @@
                (folder (if folder
                            (file-name-as-directory folder)
                          (completing-read "Folder: "
-                                          jao-consult-notmuch-folders
+                                          jao-mailbox-folders
                                           nil nil nil
                                           jao-consult-notmuch-history
                                           ".")))
@@ -774,6 +656,7 @@
                  :link link
                  :description description)))))))
     #+end_src
+* notmuch tagging scripts
 *** tag shell script
     #+begin_src bash :tangle ./bin/notmuch-tags.sh
       notmuch new > $HOME/var/log/notmuch.log 2>&1
diff --git a/lib/net/jao-notmuch.el b/lib/net/jao-notmuch.el
new file mode 100644
index 0000000..5916840
--- /dev/null
+++ b/lib/net/jao-notmuch.el
@@ -0,0 +1,216 @@
+;;; 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