[PATCH v2] emacs: tree: support fold/unfold thread or sub-thread
This patch allow the user to fold/unfold a thread or a sub-thread in
the current tree buffer by pressing "t" key.
By default a string is displayed at the beginning of the overlay to
indicate that this thread/sub-thread is folded.
Pressing again "t" on a folded thread/sub-thread will unfold it.
This feature works accross all the queries which are in Tree View.
Signed-off-by: Julien Masson
---
Changes from V1:
https://notmuchmail.org/pipermail/notmuch/2019/027571.html
-> handle sub-thread folding
-> With Universal Argument (C-u), the user can fold the whole thread
when pressing "t"
-> replace seq-{find,filter} functions with their corresponding cl functions
emacs/notmuch-tree.el | 93 +++
1 file changed, 93 insertions(+)
diff --git a/emacs/notmuch-tree.el b/emacs/notmuch-tree.el
index c00315e..8867542 100644
--- a/emacs/notmuch-tree.el
+++ b/emacs/notmuch-tree.el
@@ -71,6 +71,11 @@ Note the author string should not contain
:type '(alist :key-type (string) :value-type (string))
:group 'notmuch-tree)
+(defcustom notmuch-tree-overlay-string " [...]"
+ "String displayed at the beginning of the overlay"
+ :type 'string
+ :group 'notmuch-tree)
+
;; Faces for messages that match the query.
(defface notmuch-tree-match-face
'((t :inherit default))
@@ -159,6 +164,13 @@ Note the author string should not contain
:group 'notmuch-tree
:group 'notmuch-faces)
+;; Faces for overlays
+(defface notmuch-tree-overlay-fold-face
+ '((t :inherit 'font-lock-keyword-face))
+ "Default face used to display `notmuch-tree-overlay-string'"
+ :group 'notmuch-tree
+ :group 'notmuch-faces)
+
(defvar notmuch-tree-previous-subject
"The subject of the most recent result shown during the async display")
(make-variable-buffer-local 'notmuch-tree-previous-subject)
@@ -196,6 +208,9 @@ if the user has loaded a different buffer in that window.")
(make-variable-buffer-local 'notmuch-tree-message-buffer)
(put 'notmuch-tree-message-buffer 'permanent-local t)
+(defvar notmuch-tree-overlays nil
+ "List of overlays used to fold/unfold thread")
+
(defun notmuch-tree-to-message-pane (func)
"Execute FUNC in message pane.
@@ -294,6 +309,7 @@ FUNC."
(define-key map " " 'notmuch-tree-scroll-or-next)
(define-key map (kbd "DEL") 'notmuch-tree-scroll-message-window-back)
(define-key map "e" 'notmuch-tree-resume-message)
+(define-key map "t" 'notmuch-tree-toggle-folding-thread)
map))
(fset 'notmuch-tree-mode-map notmuch-tree-mode-map)
@@ -415,6 +431,80 @@ NOT change the database."
(notmuch-draft-resume id)
(message "No message to resume!"
+(defun notmuch-tree-find-overlay (buffer start end)
+ "Return the first overlay found in `notmuch-tree-overlays'.
+
+The overlay found is located between START and END position in BUFFER."
+ (cl-find-if (lambda (ov)
+ (and (eq (overlay-buffer ov) buffer)
+ (<= (overlay-start ov) start)
+ (>= (overlay-end ov) end)))
+ notmuch-tree-overlays))
+
+(defun notmuch-tree-clean-up-overlays ()
+ "Remove overlays not referenced to any buffer"
+ (setq notmuch-tree-overlays (cl-remove-if #'overlay-buffer
notmuch-tree-overlays)))
+
+(defun notmuch-tree-remove-overlay (overlay)
+ "Delete OVERLAY and remove it from `notmuch-tree-overlays' list"
+ (setq notmuch-tree-overlays (remove overlay notmuch-tree-overlays))
+ (delete-overlay overlay))
+
+(defun notmuch-tree-add-overlay (start end)
+ "Add an overlay from START to END in the current buffer.
+
+If non nil, `notmuch-tree-overlay-string' is added at the end of the line.
+The overlay created is added to `notmuch-tree-overlays' list"
+ (let ((overlay (make-overlay start end)))
+(add-to-list 'notmuch-tree-overlays overlay)
+(overlay-put overlay 'invisible t)
+(when notmuch-tree-overlay-string
+ (overlay-put overlay 'before-string
+ (propertize notmuch-tree-overlay-string
+ 'face 'notmuch-tree-overlay-fold-face)
+
+(defun notmuch-tree-thread-range ()
+ "Return list of Start and End position of the current thread"
+ (let (start end)
+(save-excursion
+ (while (not (or (notmuch-tree-get-prop :first) (eobp)))
+ (forward-line -1))
+ (setq start (line-end-position))
+ (notmuch-tree-next-thread)
+ (setq end (- (point) 1))
+ (list start end
+
+(defun notmuch-tree-sub-thread-range ()
+ "Return list of Start and End position of the current sub-thread"
+ (if (notmuch-tree-get-prop :first)
+ (notmuch-tree-thread-range)
+(let ((level (length (notmuch-tree-get-prop :tree-status)))
+ (start (line-end-position))
+ end)
+ ;; find
[PATCH] emacs: tree: support fold/unfold thread
This patch allow the user to fold/unfold a thread in the current tree buffer by pressing "t" key. By default a string is displayed at the beginning of the overlay to indicate that this thread is folded. Pressing again "t" on a folded thread will unfold it. This feature works accross all the queries which are in Tree View. Signed-off-by: Julien Masson --- I started to write this feature only for myself and some people around me were interested so I thought it might be interesting to share with you as well :) Please tell me if you want to change some default value: -> notmuch-tree-overlay-string -> notmuch-tree-overlay-fold-face -> "t" key bind to notmuch-tree-toggle-folding-thread I personnaly bind to notmuch-tree-toggle-folding-thread emacs/notmuch-tree.el | 73 +++ 1 file changed, 73 insertions(+) diff --git a/emacs/notmuch-tree.el b/emacs/notmuch-tree.el index c00315e..7227692 100644 --- a/emacs/notmuch-tree.el +++ b/emacs/notmuch-tree.el @@ -71,6 +71,11 @@ Note the author string should not contain :type '(alist :key-type (string) :value-type (string)) :group 'notmuch-tree) +(defcustom notmuch-tree-overlay-string " [...]" + "String displayed at the beginning of the overlay" + :type 'string + :group 'notmuch-tree) + ;; Faces for messages that match the query. (defface notmuch-tree-match-face '((t :inherit default)) @@ -159,6 +164,13 @@ Note the author string should not contain :group 'notmuch-tree :group 'notmuch-faces) +;; Faces for overlays +(defface notmuch-tree-overlay-fold-face + '((t :inherit 'font-lock-keyword-face)) + "Default face used to display `notmuch-tree-overlay-string'" + :group 'notmuch-tree + :group 'notmuch-faces) + (defvar notmuch-tree-previous-subject "The subject of the most recent result shown during the async display") (make-variable-buffer-local 'notmuch-tree-previous-subject) @@ -196,6 +208,9 @@ if the user has loaded a different buffer in that window.") (make-variable-buffer-local 'notmuch-tree-message-buffer) (put 'notmuch-tree-message-buffer 'permanent-local t) +(defvar notmuch-tree-overlays nil + "List of overlays used to fold/unfold thread") + (defun notmuch-tree-to-message-pane (func) "Execute FUNC in message pane. @@ -294,6 +309,7 @@ FUNC." (define-key map " " 'notmuch-tree-scroll-or-next) (define-key map (kbd "DEL") 'notmuch-tree-scroll-message-window-back) (define-key map "e" 'notmuch-tree-resume-message) +(define-key map "t" 'notmuch-tree-toggle-folding-thread) map)) (fset 'notmuch-tree-mode-map notmuch-tree-mode-map) @@ -415,6 +431,60 @@ NOT change the database." (notmuch-draft-resume id) (message "No message to resume!" +(defun notmuch-tree-find-overlay (buffer start end) + "Return the first overlay found in `notmuch-tree-overlays'. + +The overlay found is located between START and END position in BUFFER." + (seq-find (lambda (ov) + (and (eq (overlay-buffer ov) buffer) + (<= (overlay-start ov) start) + (>= (overlay-end ov) end))) + notmuch-tree-overlays)) + +(defun notmuch-tree-clean-up-overlays () + "Remove overlays not referenced to any buffer" + (setq notmuch-tree-overlays (seq-filter #'overlay-buffer notmuch-tree-overlays))) + +(defun notmuch-tree-remove-overlay (overlay) + "Delete OVERLAY and remove it from `notmuch-tree-overlays' list" + (setq notmuch-tree-overlays (remove overlay notmuch-tree-overlays)) + (delete-overlay overlay)) + +(defun notmuch-tree-add-overlay (start end) + "Add an overlay from START to END in the current buffer. + +If non nil, `notmuch-tree-overlay-string' is added at the end of the line. +The overlay created is added to `notmuch-tree-overlays' list" + (let ((overlay (make-overlay start end))) +(add-to-list 'notmuch-tree-overlays overlay) +(overlay-put overlay 'invisible t) +(when notmuch-tree-overlay-string + (overlay-put overlay 'before-string + (propertize notmuch-tree-overlay-string + 'face 'notmuch-tree-overlay-fold-face) + +(defun notmuch-tree-thread-range () + "Return list of Start and End position of the current thread" + (let (start end) +(save-excursion + (while (not (or (notmuch-tree-get-prop :first) (eobp))) + (forward-line -1)) + (setq start (line-end-position)) + (notmuch-tree-next-thread) + (setq end (- (point) 1)) + (list start end + +(defun notmuch-tree-toggle-folding-thread () + "Fold / Unfold the current thread" + (interactive) + (cl-multiple-value-bind (start end) + (notmuch-tree-thread-range) +(unless (= start end) + (let ((overlay (notmuch-tree-find-ove
