notmuch saved searches macroified

1 files changed, 84 insertions, 124 deletions

diff --git a/custom/jao-custom-notmuch.el b/custom/jao-custom-notmuch.el
index 8faf753..6d6a6cb 100644
--- a/custom/jao-custom-notmuch.el
+++ b/custom/jao-custom-notmuch.el
@@ -57,40 +57,44 @@
 (defun jao-notmuch--sq (tag &optional k d0 d1)
   (jao-notmuch--qn (or d0 "feeds") (or d1 tag) k (list (concat "tag:" tag))))
 
-(defvar jao-notmuch--shared-tags
-  '("new" "unread" "flagged" "signed" "sent" "attachment" "forwarded"
-    "encrypted" "gmane" "gnus" "feeds" "rss" "mce" "trove" "prog" "emacs"))
-
-(defun jao-notmuch--subtags (tag &rest excl)
-  (let* ((cmd (concat "notmuch search --output=tags tag:" tag))
-         (ts (split-string (shell-command-to-string cmd))))
-    (seq-difference ts (append jao-notmuch--shared-tags (cons tag excl)))))
-
-(defvar jao-notmuch-feed-searches-news
-  (mapcar #'jao-notmuch--sq '("news" "fun" "words" "computers")))
+(defun jao-notmuch-tree-widen-search ()
+  (interactive)
+  (when-let ((query (notmuch-tree-get-query)))
+    (let ((notmuch-show-process-crypto (notmuch-tree--message-process-crypto)))
+      (notmuch-tree-close-message-window)
+      (notmuch-tree (string-replace jao-notmuch--newa "" query)))))
 
-(defvar jao-notmuch-feed-searches-hack
-  (mapcar #'jao-notmuch--sq
-          '("xmobar" "geiser" "mdk" "mailutils" "notmuch")))
+(defun jao-notmuch-widen-searches (searches &optional extra)
+  (mapcar (lambda (s)
+            (let* ((q (plist-get s :query))
+                   (qs (string-replace jao-notmuch--newa "" q)))
+              (plist-put (copy-sequence s) :query (concat qs extra))))
+          searches))
 
-(defvar jao-notmuch-feed-searches-lang
-  (append (mapcar #'jao-notmuch--sq
-                  '( "lobsters" "clojure"  "lisp" "scheme"
-                    "haskell" "idris" "erlang" "pharo"))
-          `(,(jao-notmuch--qn "feeds" "prog" "fp"
-                              '("tag:prog" "not tag:\"/emacs/\"")))))
+(defun jao-notmuch-hello--insert-searches (searches title)
+  (when-let (searches (notmuch-hello-query-counts searches))
+    (let* ((cnt (when title
+                  (seq-reduce (lambda (c q)
+                                (+ c (or (plist-get q :count) 0)))
+                              searches
+                              0)))
+           (title (if title (format "[ %d %s ]\n\n" cnt title) "\n"))
+           (notmuch-column-control 1.0))
+      (widget-insert (propertize title 'face 'jao-themes-f00))
+      (notmuch-hello-insert-buttons searches))))
 
-(defvar jao-notmuch-feed-searches-sci
-  (mapcar #'jao-notmuch--sq
-          '("philosophy" "math" "physics" "sci" "gr-qc" "quant-ph")))
+(defmacro jao-notmuch-def-searches (name searches)
+  (declare (indent 1))
+  (let ((name (and name (format "%s" name)))
+        (id (intern (format "jao-notmuch-%s-searches" (or name (gensym))))))
+    `(progn (defvar ,id ,searches)
+            (defun ,id () (jao-notmuch-hello--insert-searches ,id ,name))
+            (setq notmuch-saved-searches (append notmuch-saved-searches ,id))
+            (add-to-list 'notmuch-hello-sections ',id t))))
 
-(defvar jao-notmuch-feed-searches
-  (append jao-notmuch-feed-searches-news
-          jao-notmuch-feed-searches-hack
-          jao-notmuch-feed-searches-lang
-          jao-notmuch-feed-searches-sci))
+(setq notmuch-hello-sections nil notmuch-saved-searches nil)
 
-(defvar jao-notmuch-bigml-searches
+(jao-notmuch-def-searches bigml
   `(,(jao-notmuch--q "bigml" "inbox" "bi")
     ,(jao-notmuch--q "bigml" "alba" "ba")
     ,(jao-notmuch--q "bigml" "support" "bs")
@@ -98,22 +102,28 @@
     ,(jao-notmuch--q "bigml" "drivel" "bd")
     ,(jao-notmuch--q "bigml" "lists" "bl")))
 
-(defvar jao-notmuch-inbox-searches
+(jao-notmuch-def-searches inbox
   `(,(jao-notmuch--q "jao" "inbox" "ji")
-    ,(jao-notmuch--q "jao" "bills" "jb")
+    ,(jao-notmuch--qn "jao" "bills" "jb" '("tag:bills"))
     ,(jao-notmuch--q "jao" "drivel" "jd")
     ,(jao-notmuch--q "jao" "mdk" "jm")
-    ,(jao-notmuch--qn "jao" "hacking" "jh"
-                      '("tag:hacking" "not tag:\"/emacs/\""))
+    ,(jao-notmuch--qn "jao" "hacking" "jh" '("tag:hacking" "not tag:\"/emacs/\""))
     ,(jao-notmuch--qn "jao" "local" "jl" '("tag:local"))))
 
-(defvar jao-notmuch-mark-searches
-  `(,(jao-notmuch--q "jao" "drafts" "d" '("tag:draft"))
-    ,(jao-notmuch--q "bml" "flagged" "rb" '("tag:flagged" "tag:bigml"))
-    ,(jao-notmuch--q "jao" "flagged" "rj" '("tag:flagged" "tag:jao"))
-    ,(jao-notmuch--q "feeds" "flagged" "rf" '("tag:flagged" "tag:feeds"))))
+(jao-notmuch-def-searches news
+  (mapcar #'jao-notmuch--sq '("news" "fun" "words" "computers")))
+
+(jao-notmuch-def-searches hacking
+  (mapcar #'jao-notmuch--sq '("xmobar" "geiser" "mdk" "mailutils" "notmuch")))
+
+(jao-notmuch-def-searches lang
+  (append (mapcar #'jao-notmuch--sq
+                  '( "lobsters" "clojure"  "lisp" "scheme"
+                    "haskell" "idris" "erlang" "pharo"))
+          `(,(jao-notmuch--qn "feeds" "prog" "fp"
+                              '("tag:prog" "not tag:\"/emacs/\"")))))
 
-(defvar jao-notmuch-emacs-searches
+(jao-notmuch-def-searches emacs
   `(,(jao-notmuch--sq "emacs" "ee" "emacs" "feeds")
     ,(jao-notmuch--sq "emacs-help" "eh" "emacs" "help")
     ,(jao-notmuch--sq "emacs-github" "eg" "emacs" "github")
@@ -122,55 +132,42 @@
     ,(jao-notmuch--sq "emacs-diffs" "ec" "emacs" "diffs")
     ,(jao-notmuch--sq "emacs-orgmode" "eo" "emacs" "org")))
 
-(defvar jao-notmuch-trove-searches
-  (mapcar (lambda (m) (list :query (concat "tag:trove and tag:" m)
-                            :name (concat "trove/" m)
-                            :key (concat "t" (substring m 0 1))
-                            :search-type 'tree))
-          '("feeds" "hacking" "bills" "jao")))
+(jao-notmuch-def-searches sci
+  (mapcar #'jao-notmuch--sq
+          '("philosophy" "math" "physics" "sci" "gr-qc" "quant-ph")))
 
-(setq notmuch-saved-searches
-      (append jao-notmuch-inbox-searches
-              jao-notmuch-bigml-searches
-              jao-notmuch-mark-searches
-              jao-notmuch-feed-searches
-              jao-notmuch-emacs-searches
-              jao-notmuch-trove-searches))
+(jao-notmuch-def-searches flags
+  (jao-notmuch-widen-searches notmuch-saved-searches " AND tag:flagged"))
 
-(defvar jao-notmuch-dynamic-searches
-  `(,(jao-notmuch--q "bml" "today" "tb" '("tag:bigml" "date:24h.."))
-    ,(jao-notmuch--q "jao" "today" "tj"
-                     '("tag:jao" "date:24h.."
-                       "not tag:\"/(feeds|spam|local)/\""))))
+(jao-notmuch-def-searches nil
+  `(,(jao-notmuch--q "bml" "flagged" "rb" '("tag:flagged" "tag:bigml"))
+    ,(jao-notmuch--q "jao" "flagged" "rj" '("tag:flagged" "tag:jao"))
+    ,(jao-notmuch--q "feeds" "flagged" "rf" '("tag:flagged" "tag:feeds"))))
 
-(defvar jao-notmuch-new-searches
+(jao-notmuch-def-searches dynamic
   `(,(jao-notmuch--q "new" nil "nn" '("tag:new" "not tag:draft"))
     ,(jao-notmuch--q "unread" nil "nu" '("tag:unread"))
-    ,@jao-notmuch-trove-searches
-    (:query "*" :name "messages")))
+    ,(jao-notmuch--q "jao" "drafts" "d" '("tag:draft"))
+    ,(jao-notmuch--q "bml" "today" "tb" '("tag:bigml" "date:24h.."))
+    ,(jao-notmuch--q "jao" "today" "tj"
+                     '("tag:jao" "date:24h.."
+                       "not tag:\"/(feeds|spam|local)/\""))))
 
-(defun jao-notmuch-tree-widen-search ()
-  (interactive)
-  (when-let ((query (notmuch-tree-get-query)))
-    (let ((notmuch-show-process-crypto (notmuch-tree--message-process-crypto)))
-      (notmuch-tree-close-message-window)
-      (notmuch-tree (string-replace jao-notmuch--newa "" query)))))
+(jao-notmuch-def-searches trove
+  (mapcar (lambda (m) (list :query (concat "tag:trove and tag:" m)
+                            :name (concat "trove/" m)
+                            :key (concat "t" (substring m 0 1))
+                            :search-type 'tree))
+          '("feeds" "hacking" "bills" "jao")))
 
-(defun jao-notmuch-widen-searches (searches &optional extra)
-  (mapcar (lambda (s)
-            (let* ((q (plist-get s :query))
-                   (qs (string-replace jao-notmuch--newa "" q)))
-              (plist-put (copy-sequence s) :query (concat qs extra))))
-          searches))
+(jao-notmuch-def-searches nil
+  '((:query "not tag:gmane" :name "email")
+    (:query "tag:gmane" :name "gmane")
+    (:query "*" :name "messages")))
 
 (defvar jao-notmuch-widened-searches
   (jao-notmuch-widen-searches notmuch-saved-searches))
 
-(defvar jao-notmuch-flagged-searches
-  (let ((s (seq-difference notmuch-saved-searches
-                           jao-notmuch-mark-searches)))
-    (jao-notmuch-widen-searches s " AND tag:flagged")))
-
 (defun jao-notmuch-jump-search (&optional widen)
   (interactive "P")
   (let ((notmuch-saved-searches
@@ -178,6 +175,15 @@
     (notmuch-jump-search)))
 
 ;;; tags
+(defvar jao-notmuch--shared-tags
+  '("new" "unread" "flagged" "signed" "sent" "attachment" "forwarded" "inbox"
+    "encrypted" "gmane" "gnus" "feeds" "rss" "mce" "trove" "prog" "emacs"))
+
+(defun jao-notmuch--subtags (tag &rest excl)
+  (let* ((cmd (concat "notmuch search --output=tags tag:" tag))
+         (ts (split-string (shell-command-to-string cmd))))
+    (seq-difference ts (append jao-notmuch--shared-tags (cons tag excl)))))
+
 (setq notmuch-archive-tags '("+trove" "-new" "-inbox")
       notmuch-show-mark-read-tags '("-new" "-unread")
       notmuch-tag-formats
@@ -242,46 +248,7 @@
 (use-package jao-notmuch :demand t)
 
 ;;; hello
-(defun jao-notmuch-hello--insert-searches (searches title)
-  (when-let (searches (notmuch-hello-query-counts searches))
-    (let* ((cnt (when title
-                  (seq-reduce (lambda (c q)
-                                (+ c (or (plist-get q :count) 0)))
-                              searches
-                              0)))
-           (title (if title (format "[ %d %s ]\n\n" cnt title) "\n")))
-      (widget-insert (propertize title 'face 'jao-themes-f00))
-      (let ((notmuch-column-control 1.0)
-            (start (point)))
-        (notmuch-hello-insert-buttons searches)
-        (indent-rigidly start (point) notmuch-hello-indent))
-      cnt)))
-
-(defun jao-notmuch-hello-insert-inbox-searches ()
-  (jao-notmuch-hello--insert-searches jao-notmuch-inbox-searches "inbox"))
-
-(defun jao-notmuch-hello-insert-bigml-searches ()
-  (jao-notmuch-hello--insert-searches jao-notmuch-bigml-searches "bigml"))
-
-(defun jao-notmuch-hello-insert-mark-searches ()
-  (jao-notmuch-hello--insert-searches jao-notmuch-mark-searches "marks")
-  (jao-notmuch-hello--insert-searches jao-notmuch-flagged-searches nil))
-
-(defun jao-notmuch-hello-insert-feeds-searches ()
-  (let ((sect "feeds"))
-    (dolist (s `(,jao-notmuch-feed-searches-news
-                 ,jao-notmuch-feed-searches-hack
-                 ,jao-notmuch-feed-searches-lang
-                 ,jao-notmuch-feed-searches-sci))
-      (let ((i (funcall #'jao-notmuch-hello--insert-searches s sect)))
-        (setq sect (unless i sect))))))
-
-(defun jao-notmuch-hello-insert-emacs-searches ()
-  (jao-notmuch-hello--insert-searches jao-notmuch-emacs-searches "emacs"))
-
-(defun jao-notmuch-hello-insert-dynamic-searches ()
-  (jao-notmuch-hello--insert-searches jao-notmuch-dynamic-searches "dynamic")
-  (jao-notmuch-hello--insert-searches jao-notmuch-new-searches nil))
+(add-to-list 'notmuch-hello-sections 'notmuch-hello-insert-alltags t)
 
 (defun jao-notmuch-refresh-agenda ()
   (interactive)
@@ -333,13 +300,6 @@
 (use-package notmuch-hello
   :init
   (setq notmuch-column-control 1.0
-        notmuch-hello-sections '(jao-notmuch-hello-insert-bigml-searches
-                                 jao-notmuch-hello-insert-inbox-searches
-                                 jao-notmuch-hello-insert-feeds-searches
-                                 jao-notmuch-hello-insert-emacs-searches
-                                 jao-notmuch-hello-insert-mark-searches
-                                 jao-notmuch-hello-insert-dynamic-searches
-                                 notmuch-hello-insert-alltags)
         notmuch-hello-hide-tags nil
         notmuch-hello-thousands-separator ","
         notmuch-hello-auto-refresh t