notmuch: separate formatters and co.

2 files changed, 87 insertions, 61 deletions

diff --git a/lib/net/jao-notmuch.el b/lib/net/jao-notmuch.el
index 9a8ba5c..d5e239e 100644
--- a/lib/net/jao-notmuch.el
+++ b/lib/net/jao-notmuch.el
@@ -65,19 +65,28 @@
       (pop-to-buffer jao-notmuch--tree-buffer nil no-record)
     (user-error "No tree view for this buffer")))
 
+(defun jao-notmuch-tree--looking-at-message ()
+  (when-let (id (plist-get (notmuch-tree-get-message-properties) :id))
+    (equal (concat "*notmuch-id:" id "*")
+           (buffer-name (window-buffer notmuch-tree-message-window)))))
+
 (defun jao-notmuch-tree-scroll-or-next ()
   "Scroll or next message in forest or exit if none."
   (interactive)
-  (if (notmuch-tree-scroll-message-window)
-      (jao-notmuch-tree-next nil)
-    (when (not (window-live-p notmuch-tree-message-window))
-      (notmuch-tree-show-message nil)))
-  (jao-notmuch--tree-update-buffer-name))
+  (if (not (jao-notmuch-tree--looking-at-message))
+      (jao-notmuch-tree-show-or-scroll t)
+      (if (notmuch-tree-scroll-message-window)
+          (jao-notmuch-tree-next nil)
+        (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 (force)
   "Show current message, or scroll it if visible."
   (interactive "P")
-  (if (and (not force) (window-live-p notmuch-tree-message-window))
+  (if (and (not force)
+           (window-live-p notmuch-tree-message-window)
+           (jao-notmuch-tree--looking-at-message))
       (scroll-other-window 1)
     (notmuch-tree-show-message nil)
     (jao-notmuch--tree-update-buffer-name)))
@@ -320,7 +329,7 @@
 (defun jao-notmuch-tree-next-thread (&optional exit)
   "Next thread in forest, taking care of thread visibility."
   (interactive "P")
-  (jao-notmuch-tree--next nil t (not exit)))
+  (jao-notmuch-tree--next nil t exit))
 
 (defun jao-notmuch-tree-previous (thread)
   "Previous message or thread in forest, taking care of thread visibility."
@@ -330,7 +339,7 @@
 (defun jao-notmuch-tree-previous-thread (&optional exit)
   "Previous thread in forest, taking care of thread visibility."
   (interactive "P")
-  (jao-notmuch-tree--next t t (not exit)))
+  (jao-notmuch-tree--next t t exit))
 
 ;;;; Updating the tree window after insertion
 
@@ -378,6 +387,26 @@
   (let ((tags (if unmark '("-spam") '("-unread" "-new" "+spam"))))
     (jao-notmuch-tree--tag-and-next tags nil nil)))
 
+;;;; Results formatters
+
+(defun jao-notmuch-format-tags (fmt msg)
+  (let ((ts (thread-last (notmuch-tree-format-field "tags" "%s" msg)
+              (split-string)
+              (seq-sort-by #'length #'<))))
+    (format-spec fmt `((?s . ,(mapconcat #'identity ts " "))))))
+
+(defun jao-notmuch-tree-and-subject (fmt msg)
+  (let ((tr (notmuch-tree-format-field "tree" " %s" msg))
+        (sb (notmuch-tree-format-field "subject" " %s" msg)))
+    (format-spec fmt `((?s . ,(concat tr sb))))))
+
+(defun jao-notmuch-msg-ticks (mails-rx msg)
+  (let ((headers (plist-get msg :headers)))
+    (cond ((string-match-p mails-rx (or (plist-get headers :To) ""))
+           (propertize " »" 'face 'notmuch-tree-match-tree-face))
+          ((string-match-p mails-rx (or (plist-get headers :Cc) ""))
+           (propertize " ¬" 'face 'notmuch-tree-match-tree-face))
+          (t "  "))))
 
 (provide 'jao-notmuch)
 ;;; jao-notmuch.el ends here
diff --git a/notmuch.org b/notmuch.org
index 435a617..463bcac 100644
--- a/notmuch.org
+++ b/notmuch.org
@@ -112,15 +112,16 @@
           notmuch-show-mark-read-tags '("-new" "-unread")
           notmuch-tag-formats
           (let ((d `(:foreground ,(face-attribute 'jao-themes-dimm :foreground)))
-                (e `(:foreground ,(face-attribute 'jao-themes-error :foreground))))
+                (e `(:foreground ,(face-attribute 'jao-themes-error :foreground)
+                     :weight bold)))
             `(("unread")
               ("signed")
               ("new" "N")
               ("replied" "↩" (propertize tag 'face '(:family "Fira Code")))
               ("sent" "S")
               ("attachment" "📎")
-              ("deleted" "×××" (propertize tag 'face '(:underline nil ,@e)))
-              ("flagged" "*" (propertize tag 'face ',e))
+              ("deleted" "🗙" (propertize tag 'face '(:underline nil ,@e)))
+              ("flagged" "!" (propertize tag 'face ',e))
               ("jao" "j")
               ("bigml" "b")
               ("feeds" "f")))
@@ -302,35 +303,19 @@
     (use-package notmuch-tree
       :init
 
-      (defun jao-notmuch--truncate (x)
-        (truncate-string-to-width (format "%-102s" x) 102 nil nil t))
-
-      (defun jao-notmuch--msg-ticks (_ msg)
-        (let ((headers (plist-get msg :headers)))
-          (cond ((string-match-p jao-mails-regexp (or (plist-get headers :To) ""))
-                 (propertize " »" 'face 'notmuch-tree-match-tree-face))
-                ((string-match-p jao-mails-regexp (or (plist-get headers :Cc) ""))
-                 (propertize " ¬" 'face 'notmuch-tree-match-tree-face))
-                (t "  "))))
-
-      (defun jao-notmuch--tree-subject (_ msg)
-        (thread-first '(("tree" . " %s") ("subject" . " %s"))
-          (notmuch-tree-format-field-list msg)
-          (jao-notmuch--truncate)))
-
       (setq notmuch-tree-result-format
-            '(("date" . "%12s  ")
+            `(("date" . "%12s  ")
               ("authors" . "%-35s")
-              (jao-notmuch--msg-ticks . "%s")
-              (jao-notmuch--tree-subject . "%s")
-              ("tags" . "  (%s)"))
+              (jao-notmuch-msg-ticks . ,jao-mails-regexp)
+              (jao-notmuch-tree-and-subject . "%>-102s")
+              (jao-notmuch-format-tags . "  (%s)"))
             notmuch-unthreaded-result-format notmuch-search-result-format
             consult-notmuch-result-format
-            '((jao-notmuch--msg-ticks)
+            `((jao-notmuch-msg-ticks . ,jao-mails-regexp)
               ("date" . "%12s  ")
               ("authors" . "%-35s")
               ("subject" . " %-100s")
-              ("tags" . "  (%s)"))
+              (jao-notmuch-format-tags . "  (%s)"))
             notmuch-tree-thread-symbols
             '((prefix . "─") (top . "─") (top-tee . "┬")
               (vertical . "│") (vertical-tee . "├") (bottom . "╰")
@@ -345,35 +330,44 @@
 
       (jao-notmuch-tree-setup "T")
 
+      (defun jao-notmuch-tree--forward (&optional prev)
+        (interactive)
+        (forward-line (if prev -1 1))
+        (jao-notmuch-tree-scroll-or-next))
+
+      (defun jao-notmuch-tree--backward ()
+        (interactive)
+        (jao-notmuch-tree--forward t))
+
       :bind (:map notmuch-tree-mode-map
-             (("b" . jao-notmuch-browse-urls)
-              ("C" . jao-notmuch-echo-count)
-              ("d" . jao-notmuch-tree-delete-message)
-              ("D" . jao-notmuch-tree-delete-thread)
-              ("h" . jao-notmuch-goto-message-buffer)
-              ("H" . jao-notmuch-click-message-buffer)
-              ("i" . jao-notmuch-show-images)
-              ("K" . jao-notmuch-tag-jump-and-next)
-              ("k" . jao-notmuch-tree-read-thread)
-              ("n" . jao-notmuch-tree-next)
-              ("N" . jao-notmuch-tree-next-thread)
-              ("O" . notmuch-tree-toggle-order)
-              ("o" . jao-notmuch-tree-widen-search)
-              ("p" . jao-notmuch-tree-previous)
-              ("P" . jao-notmuch-tree-previous-thread)
-              ("r" . notmuch-tree-reply)
-              ("R" . notmuch-tree-reply-sender)
-              ("s" . jao-notmuch-tree-spam)
-              ("u" . jao-notmuch-tree-flag)
-              ("v" . notmuch-tree-scroll-message-window)
-              ("V" . notmuch-tree-scroll-message-window-back)
-              ("<" . jao-notmuch-tree-beginning-of-buffer)
-              (">" . jao-notmuch-tree-end-of-buffer)
-              ("/" . notmuch-tree-view-raw-message)
-              ("." . jao-notmuch-toggle-mime-parts)
-              ("=" . jao-notmuch-tree-toggle-message)
-              ("RET" . jao-notmuch-tree-show-or-scroll)
-              ("SPC" . jao-notmuch-tree-scroll-or-next))))
+                  (("b" . jao-notmuch-browse-urls)
+                   ("C" . jao-notmuch-echo-count)
+                   ("d" . jao-notmuch-tree-delete-message)
+                   ("D" . jao-notmuch-tree-delete-thread)
+                   ("h" . jao-notmuch-goto-message-buffer)
+                   ("H" . jao-notmuch-click-message-buffer)
+                   ("i" . jao-notmuch-show-images)
+                   ("K" . jao-notmuch-tag-jump-and-next)
+                   ("k" . jao-notmuch-tree-read-thread)
+                   ("n" . jao-notmuch-tree-next)
+                   ("N" . jao-notmuch-tree--forward)
+                   ("O" . notmuch-tree-toggle-order)
+                   ("o" . jao-notmuch-tree-widen-search)
+                   ("p" . jao-notmuch-tree-previous)
+                   ("P" . jao-notmuch-tree--backward)
+                   ("r" . notmuch-tree-reply)
+                   ("R" . notmuch-tree-reply-sender)
+                   ("s" . jao-notmuch-tree-spam)
+                   ("u" . jao-notmuch-tree-flag)
+                   ("v" . notmuch-tree-scroll-message-window)
+                   ("V" . notmuch-tree-scroll-message-window-back)
+                   ("<" . jao-notmuch-tree-beginning-of-buffer)
+                   (">" . jao-notmuch-tree-end-of-buffer)
+                   ("/" . notmuch-tree-view-raw-message)
+                   ("." . jao-notmuch-toggle-mime-parts)
+                   ("=" . jao-notmuch-tree-toggle-message)
+                   ("RET" . jao-notmuch-tree-show-or-scroll)
+                   ("SPC" . jao-notmuch-tree-scroll-or-next))))
   #+end_src
 * consult
   #+begin_src emacs-lisp
@@ -424,6 +418,9 @@
                      (link (concat "notmuch:" id))
                      (description (format "Mail: %s"
                                           (notmuch-show-get-subject))))
+                (if (derived-mode-p 'notmuch-show-mode)
+                    (notmuch-show-archive-message)
+                  (notmuch-tree-archive-message))
                 (org-store-link-props
 	         :type "notmuch"
 	         :link link