[PATCH] emacs: notmuch-tree-outline-mode

Subject: [PATCH] emacs: notmuch-tree-outline-mode

Date: Sun, 18 Sep 2022 21:36:58 +0100

To: notmuch@notmuchmail.org

Cc: jao

From: jao

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

The implementation is based on the trick of inserting an invisible
character before each thread head that is then used as the regexp used
by outline-minor-mode to recognise headers.


I've been using this mode for a while and seems to work well for my
needs, although every now and then navigation with commands other than
the ones it defines puts point in a bad place... usually it's very
easy to go back to where you were (e.g., a simple C-a), but maybe i'm
having stockholm syndrome :)

I think the same trick i'm playing could be used to allow folding of
subtrees at more than one level (just insert several hidden > instead
of just one), but i'm not sure it would be of much use or introduce
any problem, so i've not done it here.  Perhaps we could add it under
an opt-in option if people think it useful.

Signed-off-by: jao <jao@gnu.org>
 doc/notmuch-emacs.rst |  20 ++++++
 emacs/notmuch-tree.el | 157 ++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 177 insertions(+)

diff --git a/doc/notmuch-emacs.rst b/doc/notmuch-emacs.rst
index 846f5e67..53e68c4d 100644
--- a/doc/notmuch-emacs.rst
+++ b/doc/notmuch-emacs.rst
@@ -606,6 +606,26 @@ can be controlled by the variable ``notmuch-search-oldest-first``.
    See also :el:defcustom:`notmuch-search-result-format` and
+It is also possible to enable outlines in notmuch tree buffers, via
+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|
 .. _notmuch-unthreaded:
diff --git a/emacs/notmuch-tree.el b/emacs/notmuch-tree.el
index 7ceddee2..50139589 100644
--- a/emacs/notmuch-tree.el
+++ b/emacs/notmuch-tree.el
@@ -984,11 +984,17 @@ unchanged ADDRESS if parsing fails."
 	(setq result-string (concat result-string field-string))))
     (notmuch-apply-face result-string face t)))
+(defvar notmuch-tree--insert-pre-fun nil
+  "Function called before every message header in the forest view.
+Mainly for internal use (e.g. by outline mode).")
 (defun notmuch-tree-insert-msg (msg)
   "Insert the message MSG according to notmuch-tree-result-format."
   ;; We need to save the previous subject as it will get overwritten
   ;; by the insert-field calls.
   (let ((previous-subject notmuch-tree-previous-subject))
+    (when (functionp notmuch-tree--insert-pre-fun)
+      (funcall notmuch-tree--insert-pre-fun msg))
     (insert (notmuch-tree-format-field-list (notmuch-tree-result-format) msg))
     (notmuch-tree-set-message-properties msg)
     (notmuch-tree-set-prop :previous-subject previous-subject)
@@ -1265,6 +1271,157 @@ search results and that are also tagged with the given TAG."
+;;; Tree outline mode
+;;;; Custom variables
+(defcustom notmuch-tree-outline-mode-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
+  :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 window when moving past the last message or before the first one."
+  :type 'boolean)
+;;;; Helper functions
+(defun notmuch-tree-outline--enable-mode ()
+  (when notmuch-tree-outline-mode-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 (not (looking-at-p "^$")))
+    (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)
+(defun notmuch-tree-outline--insert-prefix (msg)
+  (insert (propertize (if (plist-get msg :first) "> " "  ") 'display " ")))
+(defun notmuch-tree-outline--message-open-p ()
+  (and (buffer-live-p notmuch-tree-message-buffer)
+       (get-buffer-window notmuch-tree-message-buffer)))
+(defun notmuch-tree-outline--looking-at-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 ignore-new)
+  (let ((pop (if notmuch-tree-outline-auto-close (not pop-at-end) pop-at-end)))
+    (cond ((and (not ignore-new)
+		(notmuch-tree-outline--looking-at-match-p)
+		(not (notmuch-tree-outline--message-open-p))))
+	  (thread
+	   (notmuch-tree-next-thread prev)
+	   (unless (or (not (notmuch-tree-get-message-properties))
+		       (notmuch-tree-outline--looking-at-match-p))
+	     (notmuch-tree-matching-message prev pop)))
+	  (t (notmuch-tree-matching-message prev pop))))
+  (when (notmuch-tree-get-message-id)
+    (notmuch-tree-outline-hide-others t))
+  (when prev (forward-char 2)))
+;;;; 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 thread visible if it's not."
+  (interactive)
+  (outline-hide-body)
+  (outline-show-entry)
+  (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")
+  (if (null notmuch-tree-outline-visibility)
+      (notmuch-tree-matching-message nil pop-at-end)
+    (notmuch-tree-outline--next nil nil pop-at-end)))
+(defun notmuch-tree-outline-previous (&optional pop-at-end)
+  "Previous matching message in forest, taking care of thread visibility.
+A prefix argument reverses the meaning of `notmuch-tree-outline-auto-close'."
+  (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 "P")
+  (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 present.")
+(define-minor-mode notmuch-tree-outline-mode
+  "Minor mode allowing message trees to be folded as outlines.
+When this mode is set, each thread in the results list is treated
+as a foldable section, with its first message as its header.
+The customizable variable `notmuch-tree-outline-visibility'
+controls how navigation in the buffer is affected this mode.  By
+default, it just makes available all the keybindings in
+`outline-minor-mode', and binds \\[outline-cycle] to
+`outline-cycle' and \\[outline-cycle-buffer] to
+`outline-cycle-buffer'.  If, on the other hand,
+`notmuch-tree-outline-visibility' is set to a non-nil value,
+visiting messages via \\[notmuch-tree-outline-next],
+\\[notmuch-tree-outline-next-thread], and
+\\[notmuch-tree-outline-previous-thread] will also take care of
+hiding the outlines of the trees you are not reading.
+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 notmuch-tree--insert-pre-fun
+			 #'notmuch-tree-outline--insert-prefix
+			 outline-regexp "^> \\|^En")
+	     (notmuch-tree-outline--set-visibility))
+    (setq-local notmuch-tree--message-header-prefix nil
+		outline-regexp (default-value 'outline-regexp))))
 ;;; _
 (provide 'notmuch-tree)

notmuch mailing list -- notmuch@notmuchmail.org
To unsubscribe send an email to notmuch-leave@notmuchmail.org