From: Julien Masson <massonju.eseo@gmail.com>
To: notmuch@notmuchmail.org
Subject: [PATCH] emacs: tree: support fold/unfold thread
Date: Thu, 21 Mar 2019 15:26:44 +0100 [thread overview]
Message-ID: <86h8bwgueb.fsf@julienm-ubuntu-20JES0UQ00.i-did-not-set--mail-host-address--so-tickle-me> (raw)
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 <massonju.eseo@gmail.com>
---
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 <TAB> 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-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 +1036,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
next reply other threads:[~2019-03-21 14:43 UTC|newest]
Thread overview: 3+ messages / expand[flat|nested] mbox.gz Atom feed top
2019-03-21 14:26 Julien Masson [this message]
2019-03-23 8:07 ` [PATCH] emacs: tree: support fold/unfold thread Mark Walters
2019-03-25 15:16 ` Masson, Julien
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://notmuchmail.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=86h8bwgueb.fsf@julienm-ubuntu-20JES0UQ00.i-did-not-set--mail-host-address--so-tickle-me \
--to=massonju.eseo@gmail.com \
--cc=notmuch@notmuchmail.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://yhetil.org/notmuch.git/
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).