X-Git-Url: https://git.cworth.org/git?a=blobdiff_plain;f=emacs%2Fnotmuch-tree.el;h=f63ac9a518ea43b6b0b62687f05b1f4a77f8cdf7;hb=9d013801bb6efaded7d35e3ceb9e37331ce353bb;hp=b3f1183da4b50fc531e3813be8e9420c2bbc621f;hpb=17bfc25bb35dc8d1d6686298c6f842a3ce450940;p=notmuch diff --git a/emacs/notmuch-tree.el b/emacs/notmuch-tree.el index b3f1183d..f63ac9a5 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) @@ -74,6 +73,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 +115,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 +127,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 +142,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 +154,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 +191,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 +248,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) @@ -983,20 +1019,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 +1041,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) @@ -1113,7 +1149,7 @@ the same as for the function notmuch-tree." (concat " and (" query-context ")")))) (sort-arg (if oldest-first "--sort=oldest-first" "--sort=newest-first")) (message-arg (if unthreaded "--unthreaded" "--entire-thread"))) - (when (equal (car (process-lines notmuch-command "count" search-args)) "0") + (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 @@ -1167,11 +1203,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 +1218,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))