From 1012cb72328c0f31b3fc9b71fa5d4627928f0675 Mon Sep 17 00:00:00 2001 From: "Nicolas P. Rougier" Date: Wed, 19 Apr 2023 18:36:29 +0200 Subject: [PATCH] Added mu4e-thread.el --- mu4e/mu4e-thread.el | 326 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 326 insertions(+) create mode 100644 mu4e/mu4e-thread.el diff --git a/mu4e/mu4e-thread.el b/mu4e/mu4e-thread.el new file mode 100644 index 00000000..6f50a488 --- /dev/null +++ b/mu4e/mu4e-thread.el @@ -0,0 +1,326 @@ +;;; mu4e-thread.el --- Thread folding support for mu4e -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Nicolas P. Rougier + +;; Author: Nicolas P. Rougier +;; 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: + +;; mu4e-thread.el is a library that allows to fold and unfold threads +;; in mu4e headers mode. Folding works by creating an overlay over +;; thread children that display a summary (number of hidden messages +;; and possibly number of unread messages). Folding is perform just in +;; time such that it is quite fast to fold/unfold threads. When a +;; thread has unread messages, the folding stops at the first unread +;; message unless `mu4e-thread-fold-unread` has been set to t. +;; Similarly, when a thread has marked messages, the folding stops at +;; the first marked message and it is strongly advised to disable marking +;; on folded messages as explained in usage example. + +;;; Usage example: + +;; Key bindings +;; (bind-key "" #'mu4e-thread-goto-root 'mu4e-headers-mode-map) +;; (bind-key "" #'mu4e-thread-goto-next 'mu4e-headers-mode-map) +;; (bind-key "" #'mu4e-thread-goto-prev 'mu4e-headers-mode-map) +;; (bind-key "" #'mu4e-thread-fold-toggle-goto-next 'mu4e-headers-mode-map) +;; (bind-key "" #'mu4e-thread-fold-toggle-all 'mu4e-headers-mode-map) +;; +;; This enforces folding after a new search +;; (add-hook 'mu4e-headers-found-hook #'mu4e-thread-fold-apply-all) +;; +;; This prevents marking messages when folded +;; (advice-add #'mu4e-headers-mark-and-next :around #'mu4e-thread/mark-and-next) + + +;;; Code + +(defcustom mu4e-thread-fold-unread nil + "Whether to fold unread messages in a thread." + :group 'mu4e-headers) + +(defface mu4e-thread-fold-face + `((t :inherit mu4e-highlight-face)) + "Face for the information line of a folded thread" + :group 'mu4e-faces) + +(defvar mu4e-thread--fold-status nil + "Global folding status") + +(defvar mu4e-thread--docids nil + "Thread list whose folding has been set individually") + +(defun mu4e-thread-fold-info (count unread) + "Text to be displayed for a folded thread with COUNT hidden +messages and UNREAD messages." + + (let ((size (+ 2 (apply #'+ (mapcar (lambda (item) (or (cdr item) 0)) + mu4e-headers-fields)))) + (msg (concat (format"[%d hidden messages%s]\n" count + (if (> unread 0) + (format ", %d unread" unread) + ""))))) + (propertize (concat " " (make-string size ?•) " " msg)))) + +(defun mu4e-thread/mark-and-next (orig-fun &rest args) + "Advice function to prevent marking of folded messages" + + (if-let* ((overlay (mu4e-thread-is-folded)) + (beg (overlay-start overlay)) + (end (overlay-end overlay)) + (folded (and (>= (point) beg) (< (point) end)))) + (mu4e-warn "Cannot mark when folded") + (apply orig-fun args))) + + +(defun mu4e-thread-is-root () + "Test if message at point is the root of the current thread" + + (when-let* ((msg (get-text-property (point) 'msg)) + (meta (mu4e-message-field msg :meta))) + (let* ((orphan (plist-get meta :orphan)) + (first-child (plist-get meta :first-child)) + (root (plist-get meta :root))) + (or root (and orphan first-child))))) + +(defun mu4e-thread-goto-root () + "Go to the root of the current thread" + + (interactive) + (goto-char (mu4e-thread-root)) + (beginning-of-line)) + +(defun mu4e-thread-root () + "Get the root of the current thread" + + (interactive) + (let ((point)) + (save-excursion + (while (and (not (bobp)) + (not (mu4e-thread-is-root))) + (forward-line -1)) + (setq point (point))) + point)) + +(defun mu4e-thread-goto-prev () + "Go to the root of the previous thread, return nil if thread is the first." + + (interactive) + (mu4e-thread-goto-root) + (when-let ((point (mu4e-thread-prev))) + (goto-char point) + point)) + +(defun mu4e-thread-prev () + "Get the root of the previous thread (if any)" + + (let ((point)) + (save-excursion + (mu4e-thread-goto-root) + (unless (eq (point-min) (point)) + (forward-line -1) + (mu4e-thread-goto-root) + (point))))) + +(defun mu4e-thread-goto-next () + "Go to the root of the next thread, return t if there was a +next thread." + + (interactive) + (when-let ((point (mu4e-thread-next))) + (goto-char point))) + +(defun mu4e-thread-next () + "Get the root of the next thread (if any)" + + (let ((point)) + (save-excursion + (forward-line +1) + (while (and (not (eobp)) + (not (mu4e-thread-is-root))) + (forward-line +1)) + (setq point (point)) + point))) + +(defun mu4e-thread-is-folded () + "Test if thread at point is folded" + + (interactive) + (let* ((thread-beg (mu4e-thread-root)) + (thread-end (mu4e-thread-next)) + (overlays (overlays-in thread-beg thread-end))) + (catch 'folded + (dolist (overlay overlays) + (when (overlay-get overlay 'mu4e-thread-folded) + (throw 'folded overlay)))))) + + +(defun mu4e-thread-fold-toggle-all () + "Toggle all threads folding unconditionally and reset individual +folding states." + + (interactive) + (setq mu4e-thread--docids nil) + (if mu4e-thread--fold-status + (mu4e-thread-unfold-all) + (mu4e-thread-fold-all))) + +(defun mu4e-thread-fold-apply-all () + "Apply global folding status to all threads but those which have +been set individually." + + (interactive) + + ;; Global fold status + (if mu4e-thread--fold-status + (mu4e-thread-fold-all) + (mu4e-thread-unfold-all)) + + ;; Individual fold status + (save-excursion + (goto-char (point-min)) + (catch 'end-search + (while (not (eobp)) + (when-let* ((msg (get-text-property (point) 'msg)) + (docid (mu4e-message-field msg :docid)) + (state (cdr (assoc docid mu4e-thread--docids)))) + (if (eq state 'folded) + (mu4e-thread-fold) + (mu4e-thread-unfold))) + (unless (mu4e-thread-next) + (throw 'end-search t)) + (mu4e-thread-goto-next))))) + +(defun mu4e-thread-fold-all () + "Fold all threads unconditionally" + + (interactive) + (setq mu4e-thread--fold-status t) + + (save-excursion + (goto-char (point-min)) + (catch 'done + (while (not (eobp)) + (mu4e-thread-fold t) + (unless (mu4e-thread-goto-next) + (throw 'done t)))))) + +(defun mu4e-thread-unfold-all () + "Unfold all threads unconditionally" + + (interactive) + (setq mu4e-thread--fold-status nil) + (remove-overlays (point-min) (point-max) 'mu4e-thread-folded t)) + +(defun mu4e-thread-fold-toggle () + "Toggle folding for thread at point" + + (interactive) + (if (mu4e-thread-is-folded) + (mu4e-thread-unfold) + (mu4e-thread-fold))) + +(defun mu4e-thread-fold-toggle-goto-next () + "Toggle folding for thread at point and go to next thread." + + (interactive) + (if (mu4e-thread-is-folded) + (mu4e-thread-unfold-goto-next) + (mu4e-thread-fold-goto-next))) + +(defun mu4e-thread-unfold (&optional no-save) + "Unfold thread at point and store state unless NO-SAVE is t" + + (interactive) + (unless (eq (line-end-position) (point-max)) + (when-let ((overlay (mu4e-thread-is-folded))) + (unless no-save + (mu4e-thread--save-state 'unfolded)) + (delete-overlay overlay)))) + +(defun mu4e-thread--save-state (state) + "Save the folding STATE of thread at point" + + (save-excursion + (mu4e-thread-goto-root) + (when-let* ((msg (get-text-property (point) 'msg)) + (docid (mu4e-message-field msg :docid))) + + (setf (alist-get docid mu4e-thread--docids) state)))) + +(defun mu4e-thread-fold (&optional no-save) + "Fold thread at point and store state unless NO-SAVE is t" + + (interactive) + (unless (eq (line-end-position) (point-max)) + (let* ((thread-beg (mu4e-thread-root)) + (thread-end (mu4e-thread-next)) + (unread-count 0) + (fold-beg (save-excursion + (goto-char thread-beg) + (forward-line) + (point))) + (fold-end (save-excursion + (goto-char thread-beg) + (forward-line) + (catch 'fold-end + (while (and (not (eobp)) + (get-text-property (point) 'msg) + (and thread-end (< (point) thread-end))) + (let* ((msg (get-text-property (point) 'msg)) + (docid (mu4e-message-field msg :docid)) + (flags (mu4e-message-field msg :flags)) + (unread (memq 'unread flags))) + (when (mu4e-mark-docid-marked-p docid) + (throw 'fold-end (point))) + (when unread + (unless mu4e-thread-fold-unread + (throw 'fold-end (point))) + (setq unread-count (+ 1 unread-count)))) + (forward-line))) + (point)))) + (unless no-save + (mu4e-thread--save-state 'folded)) + (let ((child-count (count-lines fold-beg fold-end)) + (unread-count (if mu4e-thread-fold-unread unread-count 0))) + (when (> child-count 1) + (let ((inhibit-read-only t) + (overlay (make-overlay fold-beg fold-end)) + (info (mu4e-thread-fold-info child-count unread-count))) + (add-text-properties fold-beg (+ fold-beg 1) '(face mu4e-thread-fold-face)) + (overlay-put overlay 'mu4e-thread-folded t) + (overlay-put overlay 'display info))))))) + +(defun mu4e-thread-fold-goto-next () + "Fold the thread at point and go to next thread" + + (interactive) + (unless (eq (line-end-position) (point-max)) + (mu4e-thread-fold) + (mu4e-thread-goto-next))) + +(defun mu4e-thread-unfold-goto-next () + "Unfold the thread at point and go to next thread" + + (interactive) + (unless (eq (line-end-position) (point-max)) + (mu4e-thread-unfold) + (mu4e-thread-goto-next))) + + +(provide 'mu4e-thread) +;;; mu4e-thread.el ends here