diff options
Diffstat (limited to 'lib/net/jao-notmuch.el')
| -rw-r--r-- | lib/net/jao-notmuch.el | 315 |
1 files changed, 138 insertions, 177 deletions
diff --git a/lib/net/jao-notmuch.el b/lib/net/jao-notmuch.el index bd48e8f..aef9757 100644 --- a/lib/net/jao-notmuch.el +++ b/lib/net/jao-notmuch.el @@ -1,6 +1,6 @@ -;;; jao-notmuch.el --- Extensions for notmuch -*- lexical-binding: t; -*- +;;; jao-notmuch.el --- Extensions for notmuch -*- lexical-binding: t; -*- -;; Copyright (C) 2021, 2022 jao +;; Copyright (C) 2021, 2022, 2023, 2024 jao ;; Author: jao <mail@jao.io> ;; Keywords: mail @@ -18,11 +18,9 @@ ;; 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 -;; Extensions to vanilla notmuch, mostly for tree view - -;;; Code: +;;; require: (require 'outline) (require 'mm-decode) @@ -32,8 +30,8 @@ (require 'notmuch-tree) (require 'notmuch-show) - -;;;; Targetting the displayed message from the tree view + +;;; targetting the displayed message from the tree view (defvar-local jao-notmuch--tree-buffer nil) (declare eww--url-at-point "eww") @@ -54,12 +52,6 @@ (notmuch-tree-close-message-window) (notmuch-tree-show-message nil))) -(defun jao-notmuch-click-message-buffer () - (interactive) - (let ((b (current-buffer))) - (unless (eq 'url (jao-notmuch-goto-message-buffer t t)) - (pop-to-buffer b)))) - (defun jao-notmuch-tree--find-tree-buffer () (or jao-notmuch--tree-buffer (let ((mb (current-buffer))) @@ -87,7 +79,7 @@ (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) + (notmuch-tree-outline-next) (when (not (window-live-p notmuch-tree-message-window)) (notmuch-tree-show-message nil))))) @@ -130,8 +122,8 @@ (completing-read "Browse URL: " urls)) (message "No URLs in this message"))) - -;;;; Navigating URLs + +;;; navigating URLs (require 'ffap) @@ -157,8 +149,8 @@ (thing-at-point-url-at-point))) (browse-url url))) - -;;;; Toggling mime parts and images + +;;; toggling mime parts and images (defun jao-notmuch--toggle-mime () (save-excursion @@ -207,15 +199,20 @@ (defun jao-notmuch-toggle-images () (interactive) - (cond ((eq mm-text-html-renderer 'w3m) - (when (fboundp 'jao-notmuch--w3m-toggle-images) - (jao-notmuch--w3m-toggle-images))) + (cond ((memq mm-text-html-renderer '(w3m jao-w3m-html-renderer)) + (when (fboundp 'jao-notmuch--w3m-toggle-images) + (jao-notmuch--w3m-toggle-images))) (window-system (jao-notmuch--shr-toggle-images)) - (t (with-current-buffer notmuch-tree-message-buffer - (jao-notmuch--view-html))))) + (notmuch-tree-message-buffer + (if nil ;;(fboundp 'jao-open-in-x-frame) + (let ((w (get-buffer-window notmuch-tree-message-buffer))) + (jao-open-in-x-frame (window-width w) (window-height w)) + (jao-notmuch--shr-toggle-images) + (delete-window)) + (with-current-buffer notmuch-tree-message-buffer + (jao-notmuch--view-html)))))) - -;;;; Keeping track of unread messages in current tree view +;;; header line with thread message counts (defun jao-notmuch--looking-at-new-p (&optional p) (when-let (ts (if p (plist-get p :tags) (notmuch-show-get-tags))) @@ -224,23 +221,24 @@ (defsubst jao-notmuch-tree--first-p (&optional msg) (plist-get (or msg (notmuch-tree-get-message-properties)) :first)) -(defun jao-notmuch--message-counts (&optional thread) - (let ((cnt) (total 0) (match 0) (msg)) - (save-excursion - (if thread - (while (and (not (jao-notmuch-tree--first-p)) - (zerop (forward-line -1)))) - (goto-char (point-min))) - (while (and (setq msg (notmuch-tree-get-message-properties)) - (or (not cnt) - (not thread) - (not (jao-notmuch-tree--first-p msg)))) - (unless cnt (setq cnt 0)) - (setq total (1+ total)) - (when (plist-get msg :match) (setq match (1+ match))) - (when (jao-notmuch--looking-at-new-p msg) (setq cnt (1+ cnt))) - (forward-line 1))) - (when cnt (list total match cnt)))) +(defun jao-notmuch--message-counts (tree-buffer &optional thread) + (with-current-buffer tree-buffer + (let ((cnt) (total 0) (match 0) (msg)) + (save-excursion + (if thread + (while (and (not (jao-notmuch-tree--first-p)) + (zerop (forward-line -1)))) + (goto-char (point-min))) + (while (and (setq msg (notmuch-tree-get-message-properties)) + (or (not cnt) + (not thread) + (not (jao-notmuch-tree--first-p msg)))) + (unless cnt (setq cnt 0)) + (setq total (1+ total)) + (when (plist-get msg :match) (setq match (1+ match))) + (when (jao-notmuch--looking-at-new-p msg) (setq cnt (1+ cnt))) + (forward-line 1))) + (when cnt (list total match cnt))))) (defvar jao-notmuch-header-line-format "%Q [%N / %M / %T] %n / %m / %t") @@ -249,186 +247,149 @@ `((?Q . ,query) (?T . ,total) (?N . ,new) (?M . ,match) (?t . ,ttotal) (?n . ,tnew) (?m . ,tmatch)))) -(defun jao-notmuch--update-header-line (mb) - (let* ((n (or (jao-notmuch--message-counts) '(0 0 0))) - (nc (append n (or (jao-notmuch--message-counts t) '(0 0 0)))) - (q (buffer-name))) - (with-current-buffer mb +(defun jao-notmuch--format-header-line (tree-buffer buffer subject) + (let* ((n (jao-notmuch--message-counts tree-buffer)) + (nc (jao-notmuch--message-counts tree-buffer t))) + (with-current-buffer buffer (when (derived-mode-p 'notmuch-show-mode) - (let* ((s (thread-last (notmuch-show-get-subject) - (notmuch-show-strip-re) - (notmuch-sanitize))) + (let* ((nc (append (or n '(0 0 0)) (or nc '(0 0 0)))) + (q (if (string= tree-buffer subject) "" tree-buffer)) (c (apply 'jao-notmuch--format-counts q nc)) - (n (- (window-width) 3 (string-width s) (string-width c))) - (s (if (< n 0) (substring s 0 (- n 4)) s)) - (n (if (< n 0) 5 (1+ n)))) - (setq-local header-line-format - (concat " " s (make-string n ? ) c))))))) - -(defun jao-notmuch-tree--find-update-header-line (&rest _args) - (when-let ((mb (if (derived-mode-p 'notmuch-show-mode) - (current-buffer) - (window-buffer notmuch-tree-message-window)))) - (seq-find (lambda (b) - (with-current-buffer b - (and (derived-mode-p 'notmuch-tree-mode) - (or (null notmuch-tree-message-buffer) - (eq notmuch-tree-message-buffer mb)) - (jao-notmuch--update-header-line mb)))) - (buffer-list)))) - -(add-hook 'notmuch-after-tag-hook #'jao-notmuch-tree--find-update-header-line) -(add-hook 'notmuch-show-hook #'jao-notmuch-tree--find-update-header-line) - - -;;;; Outline mode for tree view - -(defun jao-notmuch-tree--msg-prefix (msg) - (insert (propertize (if (plist-get msg :first) "> " " ") 'display " "))) - -(defun jao-notmuch-tree--mode-setup () - (setq-local outline-regexp "^> \\|^En") - (outline-minor-mode t)) - -(defun jao-notmuch-tree-hide-others (&optional and-show) - (interactive) - (outline-hide-body) - (outline-show-entry) - (when and-show (notmuch-tree-show-message nil))) - -(defun jao-notmuch-tree--next (prev thread no-exit &optional ignore-new) - (let ((line-move-ignore-invisible nil)) - (cond ((and (not ignore-new) (jao-notmuch--looking-at-new-p))) - (thread - (notmuch-tree-next-thread prev) - (unless (or (not (notmuch-tree-get-message-properties)) - (jao-notmuch--looking-at-new-p)) - (notmuch-tree-matching-message prev (not no-exit)))) - (t (notmuch-tree-matching-message prev (not no-exit))))) - (when (notmuch-tree-get-message-id) - (jao-notmuch-tree-hide-others t)) - (when prev (forward-char 2))) - -(defvar jao-notmuch-tree--prefix-map - (let ((m (make-keymap "Thread operations"))) - (define-key m (kbd "TAB") #'outline-cycle) - (define-key m (kbd "t") #'outline-toggle-children) - (define-key m (kbd "s") #'outline-show-entry) - (define-key m (kbd "S") #'outline-show-all) - (define-key m (kbd "h") #'outline-hide-entry) - (define-key m (kbd "H") #'outline-hide-body) - (define-key m (kbd "o") #'jao-notmuch-tree-hide-others) - (define-key m (kbd "n") #'outline-hide-other) - m)) - -(defun jao-notmuch-tree-outline-setup (&optional prefix) - (define-key notmuch-tree-mode-map (kbd (or prefix "T")) - jao-notmuch-tree--prefix-map) - (define-key notmuch-tree-mode-map (kbd "TAB") #'outline-cycle) - (define-key notmuch-tree-mode-map (kbd "M-TAB") #'outline-cycle-buffer) - (add-hook 'notmuch-tree-mode-hook #'jao-notmuch-tree--mode-setup) - (advice-add 'notmuch-tree-insert-msg :before #'jao-notmuch-tree--msg-prefix)) - -(defun jao-notmuch-tree-next (thread &optional no-exit) - "Next message or thread in forest, taking care of thread visibility." - (interactive "P") - (jao-notmuch-tree--next nil thread no-exit)) + (n (- (window-width) 2 (string-width subject) (string-width c))) + (subject (if (< n 0) (substring subject 0 n) subject)) + (n (if (< n 0) 2 (+ n 2)))) + (concat (when window-system " ") subject (make-string n ? ) c)))))) -(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 exit)) +(defun jao-notmuch-message-header-line (subject) + (if-let* ((cb (buffer-name (current-buffer))) + (tb (seq-find (lambda (b) + (with-current-buffer b + (and (derived-mode-p 'notmuch-tree-mode) b))) + (buffer-list)))) + `((:eval (jao-notmuch--format-header-line ,(buffer-name tb) ,cb ,subject))) + (concat " " subject))) -(defun jao-notmuch-tree-previous (thread) - "Previous message or thread in forest, taking care of thread visibility." - (interactive "P") - (jao-notmuch-tree--next t thread t)) +(defun jao-notmuch--format-lighter () + (when (derived-mode-p 'notmuch-tree-mode) + (let* ((n (jao-notmuch--message-counts (current-buffer))) + (nc (jao-notmuch--message-counts (current-buffer) t)) + (nc (append (or n '(0 0 0)) (or nc '(0 0 0))))) + (apply 'jao-notmuch--format-counts "" nc)))) -(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 exit)) - - -;;;; Updating the tree window after insertion - -(defun jao-notmuch--tree-sentinel (proc &rest _) - (when (eq (process-status proc) 'exit) - (jao-notmuch-tree-hide-others))) +(define-minor-mode jao-notmuch-thread-info-mode "" + :lighter (:eval (format " %s" (jao-notmuch--format-lighter)))) -(defun jao-notmuch-tree-setup (&optional prefix) - "Set up display of trees, with PREFIX key for outline commands." - (jao-notmuch-tree-outline-setup prefix) - (advice-add 'notmuch-tree-process-sentinel :after #'jao-notmuch--tree-sentinel)) - -;;;; Tagging +;;; tagging (defsubst jao-notmuch--has-tag (tag) (member tag (notmuch-tree-get-tags))) -(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 (tags reverse whole-thread) +(defun jao-notmuch-tree--tag (tags reverse) (let ((c (notmuch-tag-change-list tags reverse))) - (if whole-thread (notmuch-tree-tag-thread c) (notmuch-tree-tag c)))) - -(defun jao-notmuch-tree--tag-and-next (tags reverse whole-thread) - (jao-notmuch-tree--tag tags reverse whole-thread) - (jao-notmuch-tree-next whole-thread t)) + (notmuch-tree-tag c))) + +(defun jao-notmuch-tree-tag-thread (tags reverse full) + (when full (notmuch-tree-thread-top)) + (let ((c (notmuch-tag-change-list tags reverse)) + (level (or (notmuch-tree-get-prop :level) 0)) + (go t)) + (while go + (notmuch-tree-tag c) + (forward-line) + (setq go (> (or (notmuch-tree-get-prop :level) 0) level))) + (when notmuch-tree-outline-mode + (ignore-errors (outline-show-branches)) + (notmuch-tree-outline-next)))) + +(defun jao-notmuch-tree--tag-and-next (tags reverse) + (jao-notmuch-tree--tag tags reverse) + (notmuch-tree-outline-next t)) (defun jao-notmuch-tree-toggle-delete () (interactive) (let ((undo (jao-notmuch--has-tag "deleted"))) - (jao-notmuch-tree--tag-and-next '("+deleted" "-new" "-unread") undo nil))) + (jao-notmuch-tree--tag-and-next '("+deleted" "-new" "-unread") undo))) -(defun jao-notmuch-tree-toggle-delete-thread () - (interactive) +(defun jao-notmuch-tree-toggle-delete-thread (full) + (interactive "P") (let ((undo (jao-notmuch--has-tag "deleted"))) - (jao-notmuch-tree--tag-and-next '("+deleted" "-new" "-unread") undo t))) + (jao-notmuch-tree-tag-thread '("+deleted" "-new" "-unread") undo full))) -(defun jao-notmuch-tree-read-thread (unread) +(defun jao-notmuch-tree-read-thread (full) (interactive "P") - (jao-notmuch-tree--tag-and-next '("-unread" "-new") unread t)) + (jao-notmuch-tree-tag-thread '("-unread" "-new") nil full)) (defun jao-notmuch-tree-toggle-flag () (interactive) (let ((tags (if (jao-notmuch--has-tag "flagged") '("-flagged") '("-unread" "-new" "-deleted" "+flagged")))) - (jao-notmuch-tree--tag-and-next tags nil nil))) + (jao-notmuch-tree--tag-and-next tags nil))) (defun jao-notmuch-tree-toggle-spam () (interactive) (let ((tags (if (jao-notmuch--has-tag "spam") '("-spam") '("-unread" "-new" "+spam")))) - (jao-notmuch-tree--tag-and-next tags nil nil))) + (jao-notmuch-tree--tag-and-next tags nil))) (defun jao-notmuch-tree-reset-tags () (interactive) (let ((tags (plist-get (notmuch-tree-get-message-properties) :orig-tags))) - (jao-notmuch-tree--tag tags nil nil) - (jao-notmuch-tree--next nil nil t t))) - - -;;;; Results formatters + (jao-notmuch-tree--tag tags nil))) + +;;; fcc +(defvar jao-notmuch-mua-reply-not-inherited + '("attachment" "sent" "new" "bigml" "jao" "trove")) + +(defun jao-notmuch-mua--fcc-dirs () + (let* ((otags (notmuch-show-get-tags)) + (trove (or (seq-some (lambda (x) (and (member x otags) x)) + '("hacking" "bills" "feeds" "jao")) + "jao")) + (tags (seq-difference otags jao-notmuch-mua-reply-not-inherited)) + (tagstr (mapconcat (lambda (s) (concat "+" s)) tags " ")) + (fcc (concat "trove/" trove " " tagstr " -new +sent +trove")) + (fcc-dirs (assoc-delete-all ".*" (copy-alist notmuch-fcc-dirs)))) + (append fcc-dirs `((".*" . ,fcc))))) + +(defun jao-notmuch-mua--inherited-fcc () + (let* ((fn (notmuch-show-get-filename)) + (dest (and (string-match ".*/var/mail/\\(.+?\\)/.+" fn) + (match-string 1 fn))) + (tags (seq-difference (notmuch-show-get-tags) + '("attachment" "sent" "new" "flagged"))) + (tagstr (mapconcat (lambda (s) (concat "+" s)) tags " ")) + (fcc (concat dest " " tagstr " -new +sent +trove")) + (fcc-dirs (assoc-delete-all ".*" (copy-alist notmuch-fcc-dirs)))) + (append fcc-dirs `((".*" . ,fcc))))) + +(defun jao-notmuch-mua-new-reply (fun &rest args) + (let ((notmuch-fcc-dirs (and (not (notmuch-show-get-header :List-Id)) + (jao-notmuch-mua--inherited-fcc)))) + (apply fun args))) + +(advice-add 'notmuch-mua-new-reply :around #'jao-notmuch-mua-new-reply) + +;;; results formatters + +(defun jao-notmuch-cmp-tags (a b) + (or (> (length a) (length b)) (string-lessp a b))) (defun jao-notmuch-format-tags (fmt msg) (let ((ts (thread-last (notmuch-tree-format-field "tags" "%s" msg) (split-string) - (seq-sort-by #'length #'<)))) + ;; (seq-sort-by #'length #'<) + (seq-sort #'jao-notmuch-cmp-tags)))) (format-spec fmt `((?s . ,(mapconcat #'identity ts " ")))))) -(defun jao-notmuch-tree-and-subject (fmt msg) +(defun jao-notmuch-format-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) +(defun jao-notmuch-format-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)) |