[PATCH v2] emacs: tree: support fold/unfold thread or sub-thread

[Julien Masson]

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 <massonju.eseo at gmail.com>
---

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 end position
+      (save-excursion
+	(forward-line)
+	(while (and (< level (length (notmuch-tree-get-prop :tree-status)))
+		    (not (eobp)))
+	  (forward-line))
+	(setq end (- (point) 1)))
+      (list start end))))
+
+(defun notmuch-tree-toggle-folding-thread (&optional arg)
+  "Fold / Unfold the current thread or sub-thread.
+
+With prefix arg (C-u) the whole thread is folded"
+  (interactive "p")
+  (cl-multiple-value-bind (start end)
+      (if (and arg (= arg 1))
+	  (notmuch-tree-sub-thread-range)
+	(notmuch-tree-thread-range))
+    (unless (= start end)
+      (let ((overlay (notmuch-tree-find-overlay (current-buffer) start end)))
+	(if overlay
+	    (notmuch-tree-remove-overlay overlay)
+	  (notmuch-tree-add-overlay start end))))))
+
 ;; The next two functions close the message window before calling
 ;; notmuch-search or notmuch-tree but they do so after the user has
 ;; entered the query (in case the user was basing the query on
@@ -966,6 +1056,9 @@ The arguments are:
   ;; Don't track undo information for this buffer
   (set 'buffer-undo-list t)
 
+  ;; clean-up overlays in case where some overlays reference to no buffer
+  (notmuch-tree-clean-up-overlays)
+
   (notmuch-tree-worker query query-context target open-target)
 
   (setq truncate-lines t))
-- 
2.7.4