(declare-function notmuch-search-previous-thread "notmuch" ())
(declare-function notmuch-tree-from-search-thread "notmuch" ())
-;; the following variable is defined in notmuch.el
-(defvar notmuch-search-query-string)
-
;; this variable distinguishes the unthreaded display from the normal tree display
(defvar-local notmuch-tree-unthreaded nil
"A buffer local copy of argument unthreaded to the function notmuch-tree.")
(defface notmuch-tree-match-tree-face
nil
- "Face used in tree mode for the thread tree block graphics in messages matching the query."
+ "Face used in tree mode for the thread tree block graphics in
+messages matching the query."
:group 'notmuch-tree
:group 'notmuch-faces)
(defface notmuch-tree-no-match-tree-face
nil
- "Face used in tree mode for the thread tree block graphics in messages matching the query."
+ "Face used in tree mode for the thread tree block graphics in
+messages matching the query."
:group 'notmuch-tree
:group 'notmuch-faces)
(define-key map [remap notmuch-jump-search] 'notmuch-tree-jump-search)
(define-key map "o" 'notmuch-tree-toggle-order)
+ (define-key map "i" 'notmuch-tree-toggle-hide-excluded)
(define-key map "S" 'notmuch-search-from-tree-current-query)
(define-key map "U" 'notmuch-unthreaded-from-tree-current-query)
(define-key map "Z" 'notmuch-tree-from-unthreaded-current-query)
(define-key map "V" 'notmuch-tree-view-raw-message)
(define-key map "l" 'notmuch-tree-filter)
(define-key map "t" 'notmuch-tree-filter-by-tag)
+ (define-key map "E" 'notmuch-tree-edit-search)
;; The main tree view bindings
(define-key map (kbd "RET") 'notmuch-tree-show-message)
"Call notmuch search with the current query."
(interactive)
(notmuch-tree-close-message-window)
- (notmuch-search (notmuch-tree-get-query)))
+ (notmuch-search (notmuch-tree-get-query)
+ notmuch-search-oldest-first
+ notmuch-search-hide-excluded))
(defun notmuch-tree-message-window-kill-hook ()
"Close the message pane when exiting the show buffer."
target
nil
unthreaded
- notmuch-search-oldest-first)))
+ notmuch-search-oldest-first
+ notmuch-search-hide-excluded)))
(defun notmuch-tree-thread-top ()
(when (notmuch-tree-get-message-properties)
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))
(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)
(notmuch-tree-insert-thread replies (1+ depth) tree-status)))
(defun notmuch-tree-insert-thread (thread depth tree-status)
- "Insert the collection of sibling sub-threads THREAD at depth DEPTH in the current forest."
+ "Insert the collection of sibling sub-threads THREAD at depth
+DEPTH in the current forest."
(let ((n (length thread)))
(cl-loop for tree in thread
for count from 1 to n
(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.
+
+Functions in this list are called with one argument, the process
+object, and with the tree results buffer as the current buffer.")
(defun notmuch-tree-process-sentinel (proc _msg)
"Add a message to let user know when \"notmuch tree\" exits."
(insert "End of search results.")
(unless (= exit-status 0)
(insert (format " (process returned %d)" exit-status)))
- (insert "\n")))))))))
+ (insert "\n"))))
+ (run-hook-with-args 'notmuch-tree-process-exit-functions proc))))))
(defun notmuch-tree-process-filter (proc string)
"Process and filter the output of \"notmuch show\" for tree view."
results-buf)))))
(defun notmuch-tree-worker (basic-query &optional query-context target
- open-target unthreaded oldest-first)
+ open-target unthreaded oldest-first
+ exclude)
"Insert the tree view of the search in the current buffer.
This is is a helper function for notmuch-tree. The arguments are
(notmuch-tree-mode)
(add-hook 'post-command-hook #'notmuch-tree-command-hook t t)
(setq notmuch-search-oldest-first oldest-first)
+ (setq notmuch-search-hide-excluded exclude)
(setq notmuch-tree-unthreaded unthreaded)
(setq notmuch-tree-basic-query basic-query)
(setq notmuch-tree-query-context (if (or (string= query-context "")
(and query-context
(concat " and (" query-context ")"))))
(sort-arg (if oldest-first "--sort=oldest-first" "--sort=newest-first"))
- (message-arg (if unthreaded "--unthreaded" "--entire-thread")))
+ (message-arg (if unthreaded "--unthreaded" "--entire-thread"))
+ (exclude-arg (if exclude "--exclude=true" "--exclude=false")))
(when (equal (car (notmuch--process-lines notmuch-command "count" search-args)) "0")
(setq search-args basic-query))
(notmuch-tag-clear-cache)
(let ((proc (notmuch-start-notmuch
"notmuch-tree" (current-buffer) #'notmuch-tree-process-sentinel
"show" "--body=false" "--format=sexp" "--format-version=5"
- sort-arg message-arg search-args))
+ sort-arg message-arg exclude-arg search-args))
;; Use a scratch buffer to accumulate partial output.
;; This buffer will be killed by the sentinel, which
;; should be called no matter how the process dies.
(setq notmuch-search-oldest-first (not notmuch-search-oldest-first))
(notmuch-tree-refresh-view))
+(defun notmuch-tree-toggle-hide-excluded ()
+ "Toggle whether to hide excluded messages.
+
+This command toggles whether to hide excluded messages for the current
+search. The default value for this is defined by `notmuch-search-hide-excluded'."
+ (interactive)
+ (setq notmuch-search-hide-excluded (not notmuch-search-hide-excluded))
+ (notmuch-tree-refresh-view))
+
+;;;###autoload
(defun notmuch-tree (&optional query query-context target buffer-name
- open-target unthreaded parent-buffer oldest-first)
+ open-target unthreaded parent-buffer
+ oldest-first hide-excluded)
"Display threads matching QUERY in tree view.
The arguments are:
it is nil \"*notmuch-tree\" followed by QUERY is used.
OPEN-TARGET: If TRUE open the target message in the message pane.
UNTHREADED: If TRUE only show matching messages in an unthreaded view."
- (interactive)
+ (interactive
+ (list
+ ;; Prompt for a query
+ nil
+ ;; Fill other args with nil.
+ nil nil nil nil nil nil
+ ;; Populate these from the default value of these options.
+ (default-value 'notmuch-search-oldest-first)
+ (default-value 'notmuch-search-hide-excluded)))
(unless query
(setq query (notmuch-read-query (concat "Notmuch "
(if unthreaded "unthreaded " "tree ")
(pop-to-buffer-same-window buffer))
;; Don't track undo information for this buffer
(setq buffer-undo-list t)
- (notmuch-tree-worker query query-context target open-target unthreaded oldest-first)
+ (notmuch-tree-worker query query-context target open-target
+ unthreaded oldest-first hide-excluded)
(setq notmuch-tree-parent-buffer parent-buffer)
(setq truncate-lines t))
(defun notmuch-unthreaded (&optional query query-context target buffer-name
- open-target)
+ open-target oldest-first hide-excluded)
"Display threads matching QUERY in unthreaded view.
See function NOTMUCH-TREE for documentation of the arguments"
- (interactive)
- (notmuch-tree query query-context target buffer-name open-target t))
+ (interactive
+ (list
+ ;; Prompt for a query
+ nil
+ ;; Fill other args with nil.
+ nil nil nil nil
+ ;; Populate these from the default value of these options.
+ (default-value 'notmuch-search-oldest-first)
+ (default-value 'notmuch-search-hide-excluded)))
+ (notmuch-tree query query-context target buffer-name open-target
+ t nil oldest-first hide-excluded))
(defun notmuch-tree-filter (query)
"Filter or LIMIT the current search results based on an additional query string.
(let ((notmuch-show-process-crypto (notmuch-tree--message-process-crypto)))
(notmuch-tree-close-message-window)
(notmuch-tree (concat notmuch-tree-basic-query " and tag:" tag)
+ notmuch-tree-query-context
+ nil
+ nil
+ nil
+ notmuch-tree-unthreaded
+ nil
+ notmuch-search-oldest-first
+ notmuch-search-hide-excluded)))
+
+(defun notmuch-tree-edit-search (query)
+ "Edit the current search"
+ (interactive (list (read-from-minibuffer "Edit search: "
+ notmuch-tree-basic-query)))
+ (let ((notmuch-show-process-crypto (notmuch-tree--message-process-crypto)))
+ (notmuch-tree-close-message-window)
+ (notmuch-tree query
notmuch-tree-query-context
nil
nil
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]+")
+ (setq-local outline-level #'notmuch-tree-outline--level)
+ (notmuch-tree-outline--set-visibility))
+ (setq-local outline-regexp (default-value 'outline-regexp))
+ (setq-local outline-level (default-value 'outline-level))))
+
;;; _
(provide 'notmuch-tree)
projects / notmuch / blobdiff