[PATCH] emacs: Re-apply an old patch to fold/unfold threads in tree-view

[PATCH] emacs: Re-apply an old patch to fold/unfold threads in tree-view

[inwit]

---
 emacs/notmuch-tree.el | 92 +++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 92 insertions(+)

diff --git a/emacs/notmuch-tree.el b/emacs/notmuch-tree.el
index b48a132d..24b4105b 100644
--- a/emacs/notmuch-tree.el
+++ b/emacs/notmuch-tree.el
@@ -131,6 +131,11 @@ Note that the author string should not contain whitespace
       notmuch-unthreaded-result-format
     notmuch-tree-result-format))
 
+(defcustom notmuch-tree-overlay-string " [...]"
+  "String displayed at the beginning of the overlay"
+  :type 'string
+  :group 'notmuch-tree)
+
 ;;; Faces
 ;;;; Faces for messages that match the query
 
@@ -222,10 +227,18 @@ Note that the author string should not contain whitespace
   :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)
+
 ;;; Variables
 
 (defvar-local notmuch-tree-previous-subject
   "The subject of the most recent result shown during the async display.")
+(make-variable-buffer-local 'notmuch-tree-previous-subject)
 
 (defvar-local notmuch-tree-basic-query nil
   "A buffer local copy of argument query to the function notmuch-tree.")
@@ -256,6 +269,9 @@ This is used to try and make sure we don't close the message pane
 if the user has loaded a different buffer in that window.")
 (put 'notmuch-tree-message-buffer 'permanent-local t)
 
+(defvar notmuch-tree-overlays nil
+  "List of overlays used to fold/unfold thread")
+
 ;;; Tree wrapper commands
 
 (defmacro notmuch-tree--define-do-in-message-window (name cmd)
@@ -385,6 +401,7 @@ then NAME behaves like CMD."
     (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)
   "Keymap for \"notmuch tree\" buffers.")
 
@@ -513,6 +530,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
@@ -1173,6 +1264,7 @@ The arguments are:
     (pop-to-buffer-same-window buffer))
   ;; Don't track undo information for this buffer
   (setq buffer-undo-list t)
+  (notmuch-tree-clean-up-overlays)
   (notmuch-tree-worker query query-context target open-target unthreaded oldest-first)
   (setq notmuch-tree-parent-buffer parent-buffer)
   (setq truncate-lines t))
-- 
2.30.2

Re: [PATCH] emacs: Re-apply an old patch to fold/unfold threads in tree-view

[David Bremner]

inwit <inwit@sindominio.net> writes:

Thanks for reviving this. Eventually you'll want to add a proper commit
message and address some of the previous review. But first, I think I
found a bug, see below
> ---
>  emacs/notmuch-tree.el | 92 +++++++++++++++++++++++++++++++++++++++++++
>  1 file changed, 92 insertions(+)
>
> diff --git a/emacs/notmuch-tree.el b/emacs/notmuch-tree.el
> index b48a132d..24b4105b 100644
> --- a/emacs/notmuch-tree.el
> +++ b/emacs/notmuch-tree.el
> @@ -131,6 +131,11 @@ Note that the author string should not contain whitespace
>        notmuch-unthreaded-result-format
>      notmuch-tree-result-format))
>  
> +(defcustom notmuch-tree-overlay-string " [...]"
> +  "String displayed at the beginning of the overlay"
> +  :type 'string
> +  :group 'notmuch-tree)

There seems to be problems introducing this overlay. I either don't see
it, or it is added to the wrong buffer.

To reproduce, go to *scratch*, write

(notmuch-tree "thread:{id:20210831110111.3148499-1-inwit@sindominio.net}")

at the end, of the line, C-x C-e

in the resulting tree-view, type 't' to toggle thread hiding.

For me the tree-view goes away and [...] is applied to the *scratch*
buffer. I suspect this bug was in the original patch.

About the binding, have a look at devel/emacs-key-bindings.org to help
choose a key; a final version of the patch should update that file and
doc/notmuch-emacs.rst

Re: [PATCH] emacs: Re-apply an old patch to fold/unfold threads in tree-view

[inwit]

On Tue Aug 31, 2021 at 5:15 PM CEST, David Bremner wrote:
> Thanks for reviving this.
My pleasure.

> Eventually you'll want to add a proper commit
> message and address some of the previous review.
Will do, eventually (see below).

> There seems to be problems introducing this overlay. I either don't
> see it, or it is added to the wrong buffer.
I've seen it too. From what I've tried, it happens when you try to fold
the last thread on a buffer.

> For me the tree-view goes away and [...] is applied to the *scratch*
> buffer. I suspect this bug was in the original patch.
Yeah, since I haven't really done anything, the original patch is indeed
to blame.

My main problem is that I don't really know where to start debugging it.
I'm afraid my elisp powers don't reach that far. :(

> About the binding, have a look at devel/emacs-key-bindings.org to help
> choose a key; a final version of the patch should update that file and
> doc/notmuch-emacs.rst
Will do. In case we can fix the bug.

Regards,