From 1a54f19de471ac2f742e62d27f4438c1b098f3e2 Mon Sep 17 00:00:00 2001 From: jao Date: Sat, 12 Jun 2021 04:46:48 +0100 Subject: jao-notmuch.el, it had to happen (also, who said we cannot move msgs) --- lib/net/jao-notmuch.el | 216 +++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 216 insertions(+) create mode 100644 lib/net/jao-notmuch.el (limited to 'lib/net/jao-notmuch.el') 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 +;; 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 . + +;;; 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 -- cgit v1.2.3