notmuch take 2

1 files changed, 253 insertions, 17 deletions

diff --git a/email.org b/email.org
index 3fdddcf..335652f 100644
--- a/email.org
+++ b/email.org
@@ -1,5 +1,5 @@
 #+property: header-args :lexical t :tangle yes :comments yes :results silent :shebang ";; -*- lexical-binding: t; -*-"
-#+title: email handling (message mode, bbdb, notmuch, mu4e et al.)
+#+title: email handling (message mode, bbdb, notmuch)
 #+auto_tangle: t
 
 * message mode
@@ -282,32 +282,77 @@
                                        notmuch-hello-insert-alltags
                                        notmuch-hello-insert-header)
               notmuch-hello-thousands-separator ","
+              notmuch-hello-auto-refresh t
               notmuch-show-all-tags-list t
               notmuch-show-logo nil
               notmuch-show-empty-saved-searches nil
+              notmuch-show-part-button-default-action 'notmuch-show-view-part
               notmuch-show-mark-read-tags '("-new" "-unread")
               notmuch-archive-tags '("+trove" "-new" "-unread" "-flagged")
               notmuch-fcc-dirs
               '((".*@bigml.com" . "trove/bigml +bigml +sent -new")
                 (".*" . "trove/jao +jao +sent -new"))
-              notmuch-maildir-use-notmuch-insert t)
-        :bind (:map notmuch-hello-mode-map (("S" . consult-notmuch)
-                                            ("SPC" . widget-button-press))))
+              notmuch-maildir-use-notmuch-insert t
+              notmuch-message-headers '("Subject" "To" "Cc" "Date" "List-Id")
+              notmuch-wash-signature-lines-max 0
+              notmuch-wash-wrap-lines-length 80
+              notmuch-wash-citation-lines-prefix 10
+              notmuch-wash-citation-lines-suffix 20)
+
+        :config
+
+        (defun jao-notmuch-refresh-hello ()
+          (interactive)
+          (notmuch-refresh-this-buffer)
+          (let ((inhibit-message t))
+            (save-window-excursion (org-agenda-list))
+            (beginning-of-buffer)
+            (widget-forward 2)))
+
+        (defun jao-notmuch-open-enclosure (add)
+          (interactive "P")
+          (with-current-notmuch-show-message
+           (goto-char (point-min))
+           (if (not (search-forward "Enclosure:" nil t))
+               (user-error "No enclosure in message body")
+             (re-search-forward "https?://" nil t)
+             (if-let (url (thing-at-point-url-at-point))
+                 (progn
+                   (message "%s %s ..." (if add "Adding" "Playing") url)
+                   (unless add (jao-mpc-clear))
+                   (jao-mpc-add-url url)
+                   (unless add (jao-mpc-play)))
+               (error "Found an enclosure, but not a link!")))))
+
+        :hook ((notmuch-hello-refresh . jao-notmuch-notify))
+
+        :bind (:map notmuch-hello-mode-map
+               (("S" . consult-notmuch)
+                ("g" . jao-notmuch-refresh-hello)
+                ("SPC" . widget-button-press))
+               :map notmuch-common-keymap
+               (("E" . jao-notmuch-open-enclosure))))
     #+end_src
 *** searches
     #+begin_src emacs-lisp
-      (setq notmuch-search-result-format
+      (setq notmuch-tree-result-format
+            '(("date" . "%12s  ")
+              ("authors" . "%-35s")
+              ((("tree" . "%s ")("subject" . "%s")) . "  %-100s")
+              ("tags" . "  (%s)"))
+            notmuch-search-result-format
             '(("date" . "%12s ")
               ("count" . "%-7s ")
               ("authors" . "%-35s")
               ("subject" . "%-100s")
-              ("tags" . "(%s)")))
+              ("tags" . "(%s)"))
+            notmuch-unthreaded-result-format notmuch-tree-result-format)
 
-      (defun jao-notmuch--q (d0 d1 &optional k qs)
+      (defun jao-notmuch--q (d0 d1 &optional k qs st)
         (let ((q (or (when qs (mapconcat #'identity qs " AND "))
                      (format "folder:%s/%s and tag:unread" d0 d1))))
           (list :name (concat d0 (when d1 "/") d1)
-                :key k :query q
+                :key k :query q :search-type (or st 'tree)
                 :sort-order 'oldest-first)))
 
       (defun jao-notmuch--mboxes-search (box &rest excluded)
@@ -323,12 +368,196 @@
               ,(jao-notmuch--q "jao" "inbox" "ji")
               ,@(jao-notmuch--mboxes-search "jao" "inbox")
               ,@(jao-notmuch--mboxes-search "feeds")
+              ,(jao-notmuch--q "gmane" nil "g" '("tag:gmane" "tag:new"))
               ,(jao-notmuch--q "bml/today" nil "tb" '("tag:bigml" "date:1d.."))
               ,(jao-notmuch--q "jao/today" nil "tj" '("tag:jao" "date:1d.."))
               ,(jao-notmuch--q "flagged" nil "r" '("tag:flagged"))
               ,(jao-notmuch--q "new" nil "n" '("tag:new"))
               ,(jao-notmuch--q "draft" nil "d" '("tag:draft"))))
     #+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)
+            (when (and and-click (button-at (point)))
+              (push-button))
+            t)))
+
+      (defun jao-notmuch-click-message-buffer ()
+        (interactive)
+        (save-window-excursion (jao-notmuch-goto-message-buffer t)))
+
+      (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-tree-next (thread &optional no-exit)
+        "Next message or thread in forest or exit if none."
+        (interactive "P")
+        (if thread
+            (notmuch-tree-next-thread)
+          (notmuch-tree-next-matching-message (not no-exit))))
+
+      (defun jao-notmuch-tag-jump-and-next (reverse)
+        (interactive "P")
+        (notmuch-tag-jump reverse)
+        (jao-notmuch-tree-next))
+
+      (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") undelete nil))
+
+      (defun jao-notmuch-tree-delete-thread ()
+        (interactive "P")
+        (jao-notmuch-tree--tag-and-next '("+deleted" "-new") t nil))
+
+      (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))))
+
+      (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)))
+
+      (use-package notmuch-tree
+        :config
+        (dolist (f '(notmuch-tree-match-tree-face
+                     notmuch-tree-no-match-tree-face))
+          (set-face-attribute f nil
+                              :family "Source Code Pro" :foreground "grey60"))
+
+        (defun jao-notmuch--format-field (fun field &rest args)
+          (let ((rs (apply fun field args)))
+            (cond ((and (stringp field) (string= field "tree"))
+                   (replace-regexp-in-string "►" "" rs))
+                  ((not (stringp field)) (truncate-string-to-width rs 100))
+                  (t rs))))
+
+        (advice-add 'notmuch-tree-format-field
+                    :around #'jao-notmuch--format-field)
+
+        :bind (:map notmuch-tree-mode-map
+               (("." . jao-notmuch-toggle-mime-parts)
+                ("d" . jao-notmuch-tree-delete-message)
+                ("D" . jao-notmuch-tree-delete-thread)
+                ("i" . jao-notmuch-toggle-images)
+                ("h" . jao-notmuch-goto-message-buffer)
+                ("H" . jao-notmuch-click-message-buffer)
+                ("n" . jao-notmuch-tree-next)
+                ("k" . jao-notmuch-tag-jump-and-next)
+                ("RET" . jao-notmuch-tree-show-or-scroll)
+                ("SPC" . jao-notmuch-tree-scroll-or-next))
+               :map notmuch-show-mode-map
+               (("h" . jao-notmuch-goto-index-buffer))
+               :map notmuch-common-keymap
+               (("B" . jao-notmuch-browse-urls))))
+    #+end_src
+*** address clean-ups
+    #+begin_src emacs-lisp
+      (defun jao-mail-clean-address (fun address)
+          (let ((address (if (string-match ".+ updates on arXiv.org: \\(.+\\)"
+                                           address)
+                             (with-temp-buffer
+                               (insert (match-string 1 address))
+                               (let ((shr-width 1000))
+                                 (shr-render-region (point-min) (point-max)))
+                               (buffer-string))
+                           (replace-regexp-in-string "^ElDiario.es - ElDiario.es"
+                                                     "ElDiario.es"
+                                                     address))))
+            (funcall fun address)))
+
+      (with-eval-after-load "notmuch"
+        (advice-add 'notmuch-clean-address :around #'jao-mail-clean-address))
+    #+end_src
+*** minibuffer notifications
+    #+begin_src emacs-lisp
+      (defvar jao-notmuch-minibuffer-string "")
+
+      (defvar jao-notmuch-minibuffer-queries
+        '((:name "" :query "tag:new" :face jao-themes-f00)
+          (:name "B" :query "tag:new and tag:bigml and tag:inbox")
+          (:name "b" :query "tag:new and tag:bigml and tag:bugs"
+                 :face jao-themes-error)
+          (:name "S" :query "tag:new and tag:bigml and tag:support")
+          (:name "W" :query "tag:new and tag:bigml" :face jao-themes-dimm)
+          (:name "I" :query "tag:new and tag:jao and tag:inbox")
+          (:name "J" :query "tag:new and tag:jao" :face jao-themes-dimm)
+          (:name "E" :query "tag:new and tag:feeds and tag:emacs"
+                 :face jao-themes-dimm)
+          (:name "N" :query "tag:new and tag:gmane" :face jao-themes-dimm)
+          (:name "F" :query "tag:new and tag:feeds and not tag:emacs"
+                 :face jao-themes-dimm)))
+
+      (defun jao-notmuch-notify ()
+        (let ((cnts (notmuch-hello-query-counts jao-notmuch-minibuffer-queries)))
+          (setq jao-notmuch-minibuffer-string
+                (mapconcat (lambda (c)
+                             (propertize (format "%s%s"
+                                                 (plist-get c :name)
+                                                 (plist-get c :count))
+                                         'face (plist-get c :face)))
+                           cnts
+                           " "))
+          (jao-minibuffer-refresh)))
+
+      (when (eq jao-afio-mail-function 'notmuch)
+        (jao-minibuffer-add-variable 'jao-notmuch-minibuffer-string -20))
+    #+end_src
+*** shr
+    #+begin_src emacs-lisp
+      (when (eq 'notmuch jao-afio-mail-function)
+        (setq mm-text-html-renderer 'shr))
+    #+end_src
 *** consult
     #+begin_src emacs-lisp
       (use-package consult-notmuch
@@ -360,6 +589,9 @@
                (init (read-string "Initial query: "))
                (init (format "folder:/%s/ %s" folder init)))
           (if tree (consult-notmuch-tree init) (consult-notmuch init))))
+
+      (with-eval-after-load "notmuch-hello"
+        (define-key notmuch-hello-mode-map "f" #'jao-consult-notmuch-folder))
     #+end_src
 *** org mode integration
     Stolen and adapted from [[https://gist.github.com/fedxa/fac592424473f1b70ea489cc64e08911][Fedor Bezrukov]].
@@ -402,12 +634,6 @@
     #+begin_src bash :shebang "#!/bin/bash" :tangle ./bin/notmuch-tags.sh :tangle-mode (identity #o755)
       notmuch new > $HOME/var/log/notmuch.log 2>&1
 
-      function tag_deleted {
-        notmuch tag +deleted -- \
-                "folder:\"/$1/\"" AND date:..${2:-3d} \
-                AND NOT "tag:\"/^(trove|new|flagged|unread)$/\""
-      }
-
       function tag_folder {
         notmuch tag +$1 +$2 -- tag:new AND folder:$1/$2
       }
@@ -424,6 +650,17 @@
 
       notmuch tag +gmane -- tag:new AND folder:/gmane/
 
+      XDG_RUNTIME_DIR='/run/user/1000' \
+        /usr/local/bin/emacsclient -e '(jao-notmuch-notify)' > /dev/null
+    #+end_src
+*** expiry shell script
+    #+begin_src bash :shebang "#!/bin/bash" :tangle ./bin/notmuch-expire.sh :tangle-mode (identity #o755)
+      function tag_deleted {
+        notmuch tag +deleted -- \
+                "folder:\"/$1/\"" AND date:..${2:-3d} \
+                AND NOT "tag:\"/^(trove|new|flagged|unread)$/\""
+      }
+
       tag_deleted "bigml.(drivel|lists|deploys|bugs)" 3d
       tag_deleted "bigml.reports" 1d
       tag_deleted "bigml.support$" 7d
@@ -431,10 +668,9 @@
       tag_deleted "feeds.+" 3d
 
       notmuch tag +deleted +trash -new -unread -- "folder:trash and tag:new"
-    #+end_src
-*** delete tagged shell script
-    #+begin_src bash :shebang "#!/bin/bash" :tangle ./bin/notmuch-expire.sh :tangle-mode (identity #o755)
+
       notmuch search --output=files --format=text0 tag:deleted | xargs -r0 rm
+
       notmuch new > $HOME/var/log/notmuch-expire.log 2>&1
       notmuch compact >> $HOME/var/log/notmuch-expire.log 2>&1
     #+end_src