2023-04-19 18:36:29 +02:00
|
|
|
;;; mu4e-thread.el --- Thread folding support for mu4e -*- lexical-binding: t -*-
|
|
|
|
|
|
|
|
;; Copyright (C) 2023 Nicolas P. Rougier
|
|
|
|
|
|
|
|
;; Author: Nicolas P. Rougier <Nicolas.Rougier@inria.fr>
|
|
|
|
;; 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 <http://www.gnu.org/licenses/>.
|
|
|
|
|
|
|
|
;;; 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:
|
|
|
|
;;
|
|
|
|
;; 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)
|
|
|
|
|
|
|
|
|
2023-04-20 13:32:11 +02:00
|
|
|
;;; Code:
|
|
|
|
|
|
|
|
(require 'mu4e-vars)
|
|
|
|
|
|
|
|
(require 'mu4e-message)
|
|
|
|
(require 'mu4e-mark)
|
2023-04-19 18:36:29 +02:00
|
|
|
|
|
|
|
(defcustom mu4e-thread-fold-unread nil
|
|
|
|
"Whether to fold unread messages in a thread."
|
2023-04-20 13:32:11 +02:00
|
|
|
:type 'boolean
|
2023-04-19 18:36:29 +02:00
|
|
|
:group 'mu4e-headers)
|
|
|
|
|
|
|
|
(defface mu4e-thread-fold-face
|
|
|
|
`((t :inherit mu4e-highlight-face))
|
2023-04-20 13:32:11 +02:00
|
|
|
"Face for the information line of a folded thread."
|
2023-04-19 18:36:29 +02:00
|
|
|
:group 'mu4e-faces)
|
|
|
|
|
|
|
|
(defvar mu4e-thread--fold-status nil
|
2023-04-20 13:32:11 +02:00
|
|
|
"Global folding status.")
|
2023-04-19 18:36:29 +02:00
|
|
|
|
|
|
|
(defvar mu4e-thread--docids nil
|
2023-04-20 13:32:11 +02:00
|
|
|
"Thread list whose folding has been set individually.")
|
2023-04-19 18:36:29 +02:00
|
|
|
|
2023-04-20 13:32:11 +02:00
|
|
|
(defvar mu4e-headers-fields) ;; defined in mu4e-headers.el
|
2023-04-19 18:36:29 +02:00
|
|
|
(defun mu4e-thread-fold-info (count unread)
|
2023-04-20 13:32:11 +02:00
|
|
|
"Text to be displayed for a folded thread.
|
|
|
|
There are COUNT hidden and UNREAD messages overall."
|
2023-04-19 18:36:29 +02:00
|
|
|
(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)
|
2023-04-20 13:32:11 +02:00
|
|
|
"Advice function to prevent marking of folded messages.
|
|
|
|
ORIG-FUN is the original functions, taking ARGS."
|
2023-04-19 18:36:29 +02:00
|
|
|
(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 ()
|
2023-04-20 13:32:11 +02:00
|
|
|
"Test if message at point is the root of the current thread."
|
2023-04-19 18:36:29 +02:00
|
|
|
(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 ()
|
2023-04-20 13:32:11 +02:00
|
|
|
"Go to the root of the current thread."
|
2023-04-19 18:36:29 +02:00
|
|
|
(interactive)
|
|
|
|
(goto-char (mu4e-thread-root))
|
|
|
|
(beginning-of-line))
|
|
|
|
|
|
|
|
(defun mu4e-thread-root ()
|
2023-04-20 13:32:11 +02:00
|
|
|
"Get the root of the current thread."
|
2023-04-19 18:36:29 +02:00
|
|
|
(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 ()
|
2023-04-20 13:32:11 +02:00
|
|
|
"Get the root of the previous thread (if any)."
|
|
|
|
(let ((_point))
|
2023-04-19 18:36:29 +02:00
|
|
|
(save-excursion
|
|
|
|
(mu4e-thread-goto-root)
|
|
|
|
(unless (eq (point-min) (point))
|
|
|
|
(forward-line -1)
|
|
|
|
(mu4e-thread-goto-root)
|
|
|
|
(point)))))
|
|
|
|
|
|
|
|
(defun mu4e-thread-goto-next ()
|
2023-04-20 13:32:11 +02:00
|
|
|
"Go to the root of the next thread.
|
|
|
|
Return t if there was a next thread, nil otherwise."
|
2023-04-19 18:36:29 +02:00
|
|
|
(interactive)
|
|
|
|
(when-let ((point (mu4e-thread-next)))
|
|
|
|
(goto-char point)))
|
|
|
|
|
|
|
|
(defun mu4e-thread-next ()
|
2023-04-20 13:32:11 +02:00
|
|
|
"Get the root of the next thread (if any)."
|
2023-04-19 18:36:29 +02:00
|
|
|
(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 ()
|
2023-04-20 13:32:11 +02:00
|
|
|
"Test if thread at point is folded."
|
2023-04-19 18:36:29 +02:00
|
|
|
(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 ()
|
2023-04-20 13:32:11 +02:00
|
|
|
"Toggle all threads folding unconditionally.
|
|
|
|
Reset individual folding states."
|
2023-04-19 18:36:29 +02:00
|
|
|
(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 ()
|
2023-04-20 13:32:11 +02:00
|
|
|
"Apply global folding status to all threads not set individually."
|
2023-04-19 18:36:29 +02:00
|
|
|
(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)))))
|
|
|
|
|
2023-04-20 13:32:11 +02:00
|
|
|
(defun mu4e-thread-fold-all ()
|
|
|
|
"Fold all threads unconditionally."
|
2023-04-19 18:36:29 +02:00
|
|
|
(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 ()
|
2023-04-20 13:32:11 +02:00
|
|
|
"Unfold all threads unconditionally."
|
2023-04-19 18:36:29 +02:00
|
|
|
(interactive)
|
|
|
|
(setq mu4e-thread--fold-status nil)
|
|
|
|
(remove-overlays (point-min) (point-max) 'mu4e-thread-folded t))
|
|
|
|
|
|
|
|
(defun mu4e-thread-fold-toggle ()
|
2023-04-20 13:32:11 +02:00
|
|
|
"Toggle folding for thread at point."
|
2023-04-19 18:36:29 +02:00
|
|
|
(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)
|
2023-04-20 13:32:11 +02:00
|
|
|
"Unfold thread at point and store state unless NO-SAVE is t."
|
2023-04-19 18:36:29 +02:00
|
|
|
(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))))
|
|
|
|
|
2023-04-20 13:32:11 +02:00
|
|
|
(defun mu4e-thread--save-state (state)
|
|
|
|
"Save the folding STATE of thread at point."
|
2023-04-19 18:36:29 +02:00
|
|
|
(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)
|
2023-04-20 13:32:11 +02:00
|
|
|
"Fold thread at point and store state unless NO-SAVE is t."
|
2023-04-19 18:36:29 +02:00
|
|
|
(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)))
|
2023-04-20 13:32:11 +02:00
|
|
|
(add-text-properties fold-beg (+ fold-beg 1)
|
|
|
|
'(face mu4e-thread-fold-face))
|
2023-04-19 18:36:29 +02:00
|
|
|
(overlay-put overlay 'mu4e-thread-folded t)
|
|
|
|
(overlay-put overlay 'display info)))))))
|
|
|
|
|
|
|
|
(defun mu4e-thread-fold-goto-next ()
|
2023-04-20 13:32:11 +02:00
|
|
|
"Fold the thread at point and go to next thread."
|
2023-04-19 18:36:29 +02:00
|
|
|
(interactive)
|
|
|
|
(unless (eq (line-end-position) (point-max))
|
|
|
|
(mu4e-thread-fold)
|
|
|
|
(mu4e-thread-goto-next)))
|
|
|
|
|
|
|
|
(defun mu4e-thread-unfold-goto-next ()
|
2023-04-20 13:32:11 +02:00
|
|
|
"Unfold the thread at point and go to next thread."
|
|
|
|
|
2023-04-19 18:36:29 +02:00
|
|
|
(interactive)
|
|
|
|
(unless (eq (line-end-position) (point-max))
|
|
|
|
(mu4e-thread-unfold)
|
|
|
|
(mu4e-thread-goto-next)))
|
|
|
|
|
|
|
|
(provide 'mu4e-thread)
|
|
|
|
;;; mu4e-thread.el ends here
|