emacs: notmuch-tree-outline-mode

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.

Amended by db: Copy docstring to manual and edit for presentation. Add
two tests. Fix typo "wether".

doc/notmuch-emacs.rst

@@ -606,6 +606,45 @@ 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`.
 
+.. _notmuch-tree-outline:
+
+notmuch-tree-outline
+--------------------
+
+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 info:emacs#Outline_Mode, and binds the following
+additional keys:
+
+.. el:define-key:: <tab>
+
+   Cycle visibility state of the current message's tree.
+
+.. el:define-key:: <M-tab>
+
+   Cycle visibility state of all trees in the buffer.
+
+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:
 

emacs/notmuch-tree.el

@@ -1014,7 +1014,10 @@ unchanged ADDRESS if parsing fails."
 A message tree is another name for a single sub-thread: i.e., a
 message together with all its descendents."
   (let ((msg (car tree))
-	(replies (cadr tree)))
+	(replies (cadr tree))
+	;; outline level, computed from the message's depth and
+	;; whether or not it's the first message in the tree.
+	(level (1+ (if (and (eq 0 depth) (not first)) 1 depth))))
     (cond
      ((and (< 0 depth) (not last))
       (push (alist-get 'vertical-tee  notmuch-tree-thread-symbols) tree-status))
@@ -1034,6 +1037,7 @@ 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 level))
     (notmuch-tree-goto-and-insert-msg msg)
     (pop tree-status)
     (pop tree-status)
@@ -1080,7 +1084,8 @@ Complete list of currently available key bindings:
   (setq notmuch-buffer-refresh-function #'notmuch-tree-refresh-view)
   (hl-line-mode 1)
   (setq buffer-read-only t)
-  (setq truncate-lines t))
+  (setq truncate-lines t)
+  (when notmuch-tree-outline-enabled (notmuch-tree-outline-mode 1)))
 
 (defvar notmuch-tree-process-exit-functions nil
   "Functions called when the process inserting a tree of results finishes.
@@ -1278,6 +1283,180 @@ 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--set-visibility ()
+  (when (and notmuch-tree-outline-mode (> (point-max) (point-min)))
+    (cl-case notmuch-tree-outline-visibility
+      (hide-others (notmuch-tree-outline-hide-others))
+      (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)
+       (let ((id (notmuch-tree-get-message-id)))
+	 (and id
+	      (with-current-buffer notmuch-tree-message-buffer
+		(string= (notmuch-show-get-message-id) id))))))
+
+(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))))
+
 ;;; _
 
 (provide 'notmuch-tree)

test/T460-emacs-tree.sh

@@ -200,6 +200,30 @@ test_emacs '(test-log-error
 	        (notmuch-tree "*")))'
 test_expect_equal "$(cat MESSAGES)" "COMPLETE"
 
+# reinitialize database for outline tests
+add_email_corpus
+
+test_begin_subtest "start in outline mode"
+test_emacs '(let ((notmuch-tree-outline-enabled t))
+	(notmuch-tree "tag:inbox")
+	(notmuch-test-wait)
+	(test-visible-output))'
+# folding all messages by height or depth should look the same
+test_expect_equal_file $EXPECTED/inbox-outline OUTPUT
+
+test_begin_subtest "outline-cycle-buffer"
+test_emacs '(let ((notmuch-tree-outline-enabled t))
+	(notmuch-tree "tag:inbox")
+	(notmuch-test-wait)
+	(outline-cycle-buffer)
+	(outline-cycle-buffer)
+	(notmuch-test-wait)
+	(test-visible-output))'
+# folding all messages by height or depth should look the same
+test_expect_equal_file $EXPECTED/notmuch-tree-tag-inbox OUTPUT
+
+test_done
+
 add_email_corpus duplicate
 
 ID3=87r2ecrr6x.fsf@zephyr.silentflame.com

test/emacs-tree.expected-output/inbox-outline

@@ -0,0 +1,25 @@
+  2010-12-29  François Boulogne     ─►[aur-general] Guidelines: cp, mkdir vs install      (inbox unread)
+  2010-12-16  Olivier Berger        ─►Essai accentué                                      (inbox unread)
+  2009-11-18  Chris Wilson          ─►[notmuch] [PATCH 1/2] Makefile: evaluate pkg-config once (inbox unread)
+  2009-11-18  Alex Botero-Lowry     ┬►[notmuch] [PATCH] Error out if no query is supplied to search	instead of going into an infinite loop (attachment inbox unread)
+  2009-11-17  Ingmar Vanhassel      ┬►[notmuch] [PATCH] Typsos                            (inbox unread)
+  2009-11-17  Adrian Perez de Cast  ┬►[notmuch] Introducing myself                        (inbox signed unread)
+  2009-11-17  Israel Herraiz        ┬►[notmuch] New to the list                           (inbox unread)
+  2009-11-17  Jan Janak             ┬►[notmuch] What a great idea!                        (inbox unread)
+  2009-11-17  Jan Janak             ┬►[notmuch] [PATCH] Older versions of install do not support -C. (inbox unread)
+  2009-11-17  Aron Griffis          ┬►[notmuch] archive                                   (inbox unread)
+  2009-11-17  Keith Packard         ┬►[notmuch] [PATCH] Make notmuch-show 'X' (and 'x') commands remove	inbox (and unread) tags (inbox unread)
+  2009-11-17  Lars Kellogg-Stedman  ┬►[notmuch] Working with Maildir storage?             (inbox signed unread)
+  2009-11-17  Mikhail Gusarov       ┬►[notmuch] [PATCH 1/2] Close message file after parsing message	headers (inbox unread)
+  2009-11-18  Keith Packard         ┬►[notmuch] [PATCH] Create a default notmuch-show-hook that	highlights URLs and uses word-wrap (inbox unread)
+  2009-11-18  Alexander Botero-Low  ─►[notmuch] request for pull                          (inbox unread)
+  2009-11-18  Jjgod Jiang           ┬►[notmuch] Mac OS X/Darwin compatibility issues      (inbox unread)
+  2009-11-18  Rolland Santimano     ─►[notmuch] Link to mailing list archives ?           (inbox unread)
+  2009-11-18  Jan Janak             ─►[notmuch] [PATCH] notmuch new: Support for conversion of spool	subdirectories into tags (inbox unread)
+  2009-11-18  Stewart Smith         ─►[notmuch] [PATCH] count_files: sort directory in inode order before	statting (inbox unread)
+  2009-11-18  Stewart Smith         ─►[notmuch] [PATCH 2/2] Read mail directory in inode number order (inbox unread)
+  2009-11-18  Stewart Smith         ─►[notmuch] [PATCH] Fix linking with gcc to use g++ to link in C++	libs. (inbox unread)
+  2009-11-18  Lars Kellogg-Stedman  ┬►[notmuch] "notmuch help" outputs to stderr?         (attachment inbox signed unread)
+  2009-11-17  Mikhail Gusarov       ─►[notmuch] [PATCH] Handle rename of message file     (inbox unread)
+  2009-11-17  Alex Botero-Lowry     ┬►[notmuch] preliminary FreeBSD support               (attachment inbox unread)
+End of search results.