diff options
| -rw-r--r-- | email.org | 147 | ||||
| -rw-r--r-- | lib/net/jao-notmuch.el | 216 |
2 files changed, 231 insertions, 132 deletions
@@ -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 |