From: jao <jao@gnu.org>
To: notmuch@notmuchmail.org
Cc: jao <jao@gnu.org>
Subject: [PATCH v5] emacs: notmuch-tree-outline-mode
Date: Sat, 24 Sep 2022 15:24:13 +0100 [thread overview]
Message-ID: <20220924142413.4019252-1-jao@gnu.org> (raw)
With this mode, one can fold trees in the notmuch-tree buffer as if
they were outlines, using all the commands provided by
outline-minor-mode. We also define a couple of movement commands
that, optional, will ensure that only the thread around point is
unfolded.
The implementation is based on registering a :level property in the
messages p-list, that is then used by outline-minor-mode to to
recognise headers.
---
This version supersedes v4 (id:20220923203449.3747562-1-jao@gnu.org)
by dispensing with the use of invisible text. Now, if desired,
notmuch-tree-outline-mode could live in its own
notmuch-tree-outline-mode.el without circular deps, but i don't see
a pressing need given that notmuch-tree.el is nicely outlined.
Signed-off-by: jao <jao@gnu.org>
---
doc/notmuch-emacs.rst | 23 ++++++
emacs/notmuch-tree.el | 181 ++++++++++++++++++++++++++++++++++++++++++
2 files changed, 204 insertions(+)
diff --git a/doc/notmuch-emacs.rst b/doc/notmuch-emacs.rst
index 846f5e67..b5f88a98 100644
--- a/doc/notmuch-emacs.rst
+++ b/doc/notmuch-emacs.rst
@@ -606,6 +606,29 @@ can be controlled by the variable ``notmuch-search-oldest-first``.
See also :el:defcustom:`notmuch-search-result-format` and
:el:defcustom:`notmuch-unthreaded-result-format`.
+It is also possible to enable outlines in notmuch tree buffers, via
+``notmuch-tree-outline-mode``.
+
+|docstring::notmuch-tree-outline-mode|
+
+The behaviour of this minor mode is affected by the following
+customizable variables:
+
+.. el:defcustom:: notmuch-tree-outline-enabled
+
+ |docstring::notmuch-tree-outline-enabled|
+
+.. el:defcustom:: notmuch-tree-outline-visibility
+
+ |docstring::notmuch-tree-outline-visibility|
+
+.. el:defcustom:: notmuch-tree-outline-auto-close
+
+ |docstring::notmuch-tree-outline-auto-close|
+
+.. el:defcustom:: notmuch-tree-outline-open-on-next
+
+ |docstring::notmuch-tree-outline-open-on-next|
.. _notmuch-unthreaded:
diff --git a/emacs/notmuch-tree.el b/emacs/notmuch-tree.el
index b3c2c992..3c92b839 100644
--- a/emacs/notmuch-tree.el
+++ b/emacs/notmuch-tree.el
@@ -1034,6 +1034,8 @@ message together with all its descendents."
(setq msg (plist-put msg :first (and first (eq 0 depth))))
(setq msg (plist-put msg :tree-status tree-status))
(setq msg (plist-put msg :orig-tags (plist-get msg :tags)))
+ (setq msg (plist-put msg
+ :level (1+ (if (and (eq 0 depth) (not first)) 1 depth))))
(notmuch-tree-goto-and-insert-msg msg)
(pop tree-status)
(pop tree-status)
@@ -1278,6 +1280,185 @@ search results and that are also tagged with the given TAG."
nil
notmuch-search-oldest-first)))
+;;; Tree outline mode
+;;;; Custom variables
+(defcustom notmuch-tree-outline-enabled nil
+ "Whether to automatically activate `notmuch-tree-outline-mode' in tree views."
+ :type 'boolean)
+
+(defcustom notmuch-tree-outline-visibility 'hide-others
+ "Default state of the forest outline for `notmuch-tree-outline-mode'.
+
+This variable controls the state of a forest initially and after
+a movement command. If set to nil, all trees are displayed while
+the symbol hide-all indicates that all trees in the forest should
+be folded and hide-other that only the first one should be
+unfolded."
+ :type '(choice (const :tag "Show all" nil)
+ (const :tag "Hide others" hide-others)
+ (const :tag "Hide all" hide-all)))
+
+(defcustom notmuch-tree-outline-auto-close nil
+ "Close message and tree windows when moving past the last message."
+ :type 'boolean)
+
+(defcustom notmuch-tree-outline-open-on-next nil
+ "Open new messages under point if they are closed when moving to next one.
+
+When this flag is set, using the command
+`notmuch-tree-outline-next' with point on a header for a new
+message that is not shown will open its `notmuch-show' buffer
+instead of moving point to next matching message."
+ :type 'boolean)
+
+;;;; Helper functions
+(defsubst notmuch-tree-outline--pop-at-end (pop-at-end)
+ (if notmuch-tree-outline-auto-close (not pop-at-end) pop-at-end))
+
+(defun notmuch-tree-outline--enable-mode ()
+ (when notmuch-tree-outline-enabled (notmuch-tree-outline-mode 1)))
+
+(add-hook 'notmuch-tree-mode-hook #'notmuch-tree-outline--enable-mode)
+
+(defun notmuch-tree-outline--set-visibility ()
+ (when (and notmuch-tree-outline-mode (> (point-max) (point-min)))
+ (cond ((eq notmuch-tree-outline-visibility 'hide-others)
+ (notmuch-tree-outline-hide-others))
+ ((eq notmuch-tree-outline-visibility 'hide-all)
+ (outline-hide-body)))))
+
+(defun notmuch-tree-outline--on-exit (proc)
+ (when (eq (process-status proc) 'exit)
+ (notmuch-tree-outline--set-visibility)))
+
+(add-hook 'notmuch-tree-process-exit-functions #'notmuch-tree-outline--on-exit)
+
+(defsubst notmuch-tree-outline--level (&optional props)
+ (or (plist-get (or props (notmuch-tree-get-message-properties)) :level) 0))
+
+(defsubst notmuch-tree-outline--message-open-p ()
+ (and (buffer-live-p notmuch-tree-message-buffer)
+ (get-buffer-window notmuch-tree-message-buffer)
+ (string-match-p (regexp-quote (or (notmuch-tree-get-message-id) ""))
+ (buffer-name notmuch-tree-message-buffer))))
+
+(defsubst notmuch-tree-outline--at-original-match-p ()
+ (and (notmuch-tree-get-prop :match)
+ (equal (notmuch-tree-get-prop :orig-tags)
+ (notmuch-tree-get-prop :tags))))
+
+(defun notmuch-tree-outline--next (prev thread pop-at-end &optional open-new)
+ (cond (thread
+ (notmuch-tree-thread-top)
+ (if prev
+ (outline-backward-same-level 1)
+ (outline-forward-same-level 1))
+ (when (> (notmuch-tree-outline--level) 0) (outline-show-branches))
+ (notmuch-tree-outline--next nil nil pop-at-end t))
+ ((and (or open-new notmuch-tree-outline-open-on-next)
+ (notmuch-tree-outline--at-original-match-p)
+ (not (notmuch-tree-outline--message-open-p)))
+ (notmuch-tree-outline-hide-others t))
+ (t (outline-next-visible-heading (if prev -1 1))
+ (unless (notmuch-tree-get-prop :match)
+ (notmuch-tree-matching-message prev pop-at-end))
+ (notmuch-tree-outline-hide-others t))))
+
+;;;; User commands
+(defun notmuch-tree-outline-hide-others (&optional and-show)
+ "Fold all threads except the one around point.
+If AND-SHOW is t, make the current message visible if it's not."
+ (interactive)
+ (save-excursion
+ (while (and (not (bobp)) (> (notmuch-tree-outline--level) 1))
+ (outline-previous-heading))
+ (outline-hide-sublevels 1))
+ (when (> (notmuch-tree-outline--level) 0)
+ (outline-show-subtree)
+ (when and-show (notmuch-tree-show-message nil))))
+
+(defun notmuch-tree-outline-next (&optional pop-at-end)
+ "Next matching message in a forest, taking care of thread visibility.
+A prefix argument reverses the meaning of `notmuch-tree-outline-auto-close'."
+ (interactive "P")
+ (let ((pop (notmuch-tree-outline--pop-at-end pop-at-end)))
+ (if (null notmuch-tree-outline-visibility)
+ (notmuch-tree-matching-message nil pop)
+ (notmuch-tree-outline--next nil nil pop))))
+
+(defun notmuch-tree-outline-previous (&optional pop-at-end)
+ "Previous matching message in forest, taking care of thread visibility.
+With prefix, quit the tree view if there is no previous message."
+ (interactive "P")
+ (if (null notmuch-tree-outline-visibility)
+ (notmuch-tree-prev-matching-message pop-at-end)
+ (notmuch-tree-outline--next t nil pop-at-end)))
+
+(defun notmuch-tree-outline-next-thread ()
+ "Next matching thread in forest, taking care of thread visibility."
+ (interactive)
+ (if (null notmuch-tree-outline-visibility)
+ (notmuch-tree-next-thread)
+ (notmuch-tree-outline--next nil t nil)))
+
+(defun notmuch-tree-outline-previous-thread ()
+ "Previous matching thread in forest, taking care of thread visibility."
+ (interactive)
+ (if (null notmuch-tree-outline-visibility)
+ (notmuch-tree-prev-thread)
+ (notmuch-tree-outline--next t t nil)))
+
+;;;; Mode definition
+(defvar notmuch-tree-outline-mode-lighter nil
+ "The lighter mark for notmuch-tree-outline mode.
+Usually empty since outline-minor-mode's lighter will be active.")
+
+(define-minor-mode notmuch-tree-outline-mode
+ "Minor mode allowing message trees to be folded as outlines.
+
+When this mode is set, each thread and subthread in the results
+list is treated as a foldable section, with its first message as
+its header.
+
+The mode just makes available in the tree buffer all the
+keybindings in `outline-minor-mode', and binds the following
+additional keys:
+
+\\{notmuch-tree-outline-mode-map}
+
+The customizable variable `notmuch-tree-outline-visibility'
+controls how navigation in the buffer is affected by this mode:
+
+ - If it is set to nil, `notmuch-tree-outline-previous',
+ `notmuch-tree-outline-next', and their thread counterparts
+ behave just as the corresponding notmuch-tree navigation keys
+ when this mode is not enabled.
+
+ - If, on the other hand, `notmuch-tree-outline-visibility' is
+ set to a non-nil value, these commands hiding the outlines of
+ the trees you are not reading as you move to new messages.
+
+To enable notmuch-tree-outline-mode by default in all
+notmuch-tree buffers, just set
+`notmuch-tree-outline-mode-enabled' to t."
+ :lighter notmuch-tree-outline-mode-lighter
+ :keymap `((,(kbd "TAB") . outline-cycle)
+ (,(kbd "M-TAB") . outline-cycle-buffer)
+ ("n" . notmuch-tree-outline-next)
+ ("p" . notmuch-tree-outline-previous)
+ (,(kbd "M-n") . notmuch-tree-outline-next-thread)
+ (,(kbd "M-p") . notmuch-tree-outline-previous-thread))
+ (outline-minor-mode notmuch-tree-outline-mode)
+ (unless (derived-mode-p 'notmuch-tree-mode)
+ (user-error "notmuch-tree-outline-mode is only meaningful for notmuch trees!"))
+ (if notmuch-tree-outline-mode
+ (progn (setq-local outline-regexp "^[^\n]+"
+ outline-level #'notmuch-tree-outline--level)
+ (notmuch-tree-outline--set-visibility))
+ (setq-local outline-regexp (default-value 'outline-regexp)
+ outline-level (default-value 'outline-level))))
+>>>>>>> 5e1083b7 (emacs: notmuch-tree-outline-mode)
+
;;; _
(provide 'notmuch-tree)
--
2.37.2
reply other threads:[~2022-09-24 14:30 UTC|newest]
Thread overview: [no followups] expand[flat|nested] mbox.gz Atom feed
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=20220924142413.4019252-1-jao@gnu.org \
--to=jao@gnu.org \
--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).