X-Git-Url: https://git.notmuchmail.org/git?p=notmuch;a=blobdiff_plain;f=emacs%2Fnotmuch-tree.el;h=b3c2c992486fd9e5ccd7f7510c138728f72f7c37;hp=1efb95bbb677e7be648863e25b3a214b33d0b585;hb=3db892f43b4ac333a09dd05c8f230bf3f8d2b9e9;hpb=a890241138ea468f8a275941b02da39b4e894c1e diff --git a/emacs/notmuch-tree.el b/emacs/notmuch-tree.el index 1efb95bb..b3c2c992 100644 --- a/emacs/notmuch-tree.el +++ b/emacs/notmuch-tree.el @@ -27,7 +27,6 @@ (require 'mail-parse) (require 'notmuch-lib) -(require 'notmuch-query) (require 'notmuch-show) (require 'notmuch-tag) (require 'notmuch-parser) @@ -46,9 +45,6 @@ (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.") @@ -74,6 +70,39 @@ notmuch-unthreaded-show-out notmuch-tree-show-out)) +(defcustom notmuch-tree-thread-symbols + '((prefix . " ") + (top . "─") + (top-tee . "┬") + (vertical . "│") + (vertical-tee . "├") + (bottom . "╰") + (arrow . "►")) + "Strings used to draw trees in notmuch tree results. +Symbol keys denote where the corresponding string value is used: +`prefix' is used at the top of the tree, followed by `top' if it +has no children or `top-tee' if it does; `vertical' is a bar +connecting with a response down the list skipping the current +one, while `vertical-tee' marks the current message as a reply to +the previous one; `bottom' is used at the bottom of threads. +Finally, the `arrrow' string in the list is used as a pointer to +every message. + +Common customizations include setting `prefix' to \"-\", to see +equal-length prefixes, and `arrow' to an empty string or to a +different kind of arrow point." + :type '(alist :key-type symbol :value-type string) + :group 'notmuch-tree) + +(defconst notmuch-tree--field-names + '(choice :tag "Field" + (const :tag "Date" "date") + (const :tag "Authors" "authors") + (const :tag "Subject" "subject") + (const :tag "Tree" "tree") + (const :tag "Tags" "tags") + (function))) + (defcustom notmuch-tree-result-format `(("date" . "%12s ") ("authors" . "%-20s") @@ -83,7 +112,11 @@ ("tags" . "(%s)")) "Result formatting for tree view. -Supported fields are: date, authors, subject, tree, tags. +List of pairs of (field . format-string). Supported field +strings are: \"date\", \"authors\", \"subject\", \"tree\", +\"tags\". It is also supported to pass a function in place of a +field-name. In this case the function is passed the thread +object (plist) and format string. Tree means the thread tree box graphics. The field may also be a list in which case the formatting rules are @@ -91,14 +124,12 @@ applied recursively and then the output of all the fields in the list is inserted according to format-string. Note that the author string should not contain whitespace -\(put it in the neighbouring fields instead). For example: - (setq notmuch-tree-result-format - '((\"authors\" . \"%-40s\") - (\"subject\" . \"%s\")))" - :type '(alist :key-type (choice string - (alist :key-type string - :value-type string)) - :value-type string) +\(put it in the neighbouring fields instead)." + + :type `(alist :key-type (choice ,notmuch-tree--field-names + (alist :key-type ,notmuch-tree--field-names + :value-type (string :tag "Format"))) + :value-type (string :tag "Format")) :group 'notmuch-tree) (defcustom notmuch-unthreaded-result-format @@ -108,7 +139,11 @@ Note that the author string should not contain whitespace ("tags" . "(%s)")) "Result formatting for unthreaded tree view. -Supported fields are: date, authors, subject, tree, tags. +List of pairs of (field . format-string). Supported field +strings are: \"date\", \"authors\", \"subject\", \"tree\", +\"tags\". It is also supported to pass a function in place of a +field-name. In this case the function is passed the thread +object (plist) and format string. Tree means the thread tree box graphics. The field may also be a list in which case the formatting rules are @@ -116,14 +151,12 @@ applied recursively and then the output of all the fields in the list is inserted according to format-string. Note that the author string should not contain whitespace -\(put it in the neighbouring fields instead). For example: - (setq notmuch-unthreaded-result-format - '((\"authors\" . \"%-40s\") - (\"subject\" . \"%s\")))" - :type '(alist :key-type (choice string - (alist :key-type string - :value-type string)) - :value-type string) +\(put it in the neighbouring fields instead)." + + :type `(alist :key-type (choice ,notmuch-tree--field-names + (alist :key-type ,notmuch-tree--field-names + :value-type (string :tag "Format"))) + :value-type (string :tag "Format")) :group 'notmuch-tree) (defun notmuch-tree-result-format () @@ -155,7 +188,7 @@ Note that the author string should not contain whitespace (:foreground "dark blue")) (t (:bold t))) - "Face used in tree mode for the date in messages matching the query." + "Face used in tree mode for the author in messages matching the query." :group 'notmuch-tree :group 'notmuch-faces) @@ -212,7 +245,7 @@ Note that the author string should not contain whitespace (defface notmuch-tree-no-match-author-face nil - "Face used in tree mode for the date in messages matching the query." + "Face used in tree mode for non-matching authors." :group 'notmuch-tree :group 'notmuch-faces) @@ -363,6 +396,7 @@ then NAME behaves like CMD." (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) @@ -983,20 +1017,20 @@ message together with all its descendents." (replies (cadr tree))) (cond ((and (< 0 depth) (not last)) - (push "├" tree-status)) + (push (alist-get 'vertical-tee notmuch-tree-thread-symbols) tree-status)) ((and (< 0 depth) last) - (push "╰" tree-status)) + (push (alist-get 'bottom notmuch-tree-thread-symbols) tree-status)) ((and (eq 0 depth) first last) - ;; Choice between these two variants is a matter of taste. - ;; (push "─" tree-status)) - (push " " tree-status)) + (push (alist-get 'prefix notmuch-tree-thread-symbols) tree-status)) ((and (eq 0 depth) first (not last)) - (push "┬" tree-status)) + (push (alist-get 'top-tee notmuch-tree-thread-symbols) tree-status)) ((and (eq 0 depth) (not first) last) - (push "╰" tree-status)) + (push (alist-get 'bottom notmuch-tree-thread-symbols) tree-status)) ((and (eq 0 depth) (not first) (not last)) - (push "├" tree-status))) - (push (concat (if replies "┬" "─") "►") tree-status) + (push (alist-get 'vertical-tee notmuch-tree-thread-symbols) tree-status))) + (push (concat (alist-get (if replies 'top-tee 'top) notmuch-tree-thread-symbols) + (alist-get 'arrow 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))) @@ -1005,7 +1039,7 @@ message together with all its descendents." (pop tree-status) (if last (push " " tree-status) - (push "│" tree-status)) + (push (alist-get 'vertical notmuch-tree-thread-symbols) tree-status)) (notmuch-tree-insert-thread replies (1+ depth) tree-status))) (defun notmuch-tree-insert-thread (thread depth tree-status) @@ -1048,6 +1082,12 @@ Complete list of currently available key bindings: (setq buffer-read-only t) (setq truncate-lines t)) +(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." (let ((buffer (process-buffer proc)) @@ -1066,7 +1106,8 @@ Complete list of currently available key bindings: (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." @@ -1167,11 +1208,11 @@ The arguments are: (setq query (notmuch-read-query (concat "Notmuch " (if unthreaded "unthreaded " "tree ") "view search: ")))) - (let ((buffer (get-buffer-create (generate-new-buffer-name - (or buffer-name - (concat "*notmuch-" - (if unthreaded "unthreaded-" "tree-") - query "*"))))) + (let* ((name + (or buffer-name + (notmuch-search-buffer-title query + (if unthreaded "unthreaded" "tree")))) + (buffer (get-buffer-create (generate-new-buffer-name name))) (inhibit-read-only t)) (pop-to-buffer-same-window buffer)) ;; Don't track undo information for this buffer @@ -1182,6 +1223,9 @@ The arguments are: (defun notmuch-unthreaded (&optional query query-context target buffer-name open-target) + "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)) @@ -1219,6 +1263,21 @@ search results and that are also tagged with the given TAG." nil notmuch-search-oldest-first))) +(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-tree-unthreaded + nil + notmuch-search-oldest-first))) + ;;; _ (provide 'notmuch-tree)