X-Git-Url: https://git.cworth.org/git?a=blobdiff_plain;f=emacs%2Fnotmuch-tree.el;h=f63ac9a518ea43b6b0b62687f05b1f4a77f8cdf7;hb=9d013801bb6efaded7d35e3ceb9e37331ce353bb;hp=2f508128cc78f2cbab0f146e4acb6c33fe2336e2;hpb=731697d671749a13634a2a4b843ce62f2927f64f;p=notmuch diff --git a/emacs/notmuch-tree.el b/emacs/notmuch-tree.el index 2f508128..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,24 +73,66 @@ 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") - ((("tree" . "%s")("subject" . "%s")) ." %-54s ") + ((("tree" . "%s") + ("subject" . "%s")) + . " %-54s ") ("tags" . "(%s)")) - "Result formatting for tree view. Supported fields are: date, -authors, subject, tree, tags. Tree means the thread tree -box graphics. The field may also be a list in which case -the formatting rules are applied recursively and then the -output of all the fields in the list is inserted -according to format-string. - -Note 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 (string) :value-type (string)) + "Result formatting for tree view. + +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 +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)." + + :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 @@ -99,19 +140,26 @@ For example: ("authors" . "%-20s") ((("subject" . "%s")) ." %-54s ") ("tags" . "(%s)")) - "Result formatting for unthreaded tree view. Supported fields are: date, -authors, subject, tree, tags. Tree means the thread tree -box graphics. The field may also be a list in which case -the formatting rules are applied recursively and then the -output of all the fields in the list is inserted -according to format-string. - -Note 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 (string) :value-type (string)) + "Result formatting for unthreaded tree view. + +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 +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)." + + :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 () @@ -143,7 +191,7 @@ For example: (: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) @@ -200,7 +248,7 @@ For example: (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) @@ -873,6 +921,9 @@ unchanged ADDRESS if parsing fails." ((listp field) (format format-string (notmuch-tree-format-field-list field msg))) + ((functionp field) + (funcall field format-string msg)) + ((string-equal field "date") (let ((face (if match 'notmuch-tree-match-date-face @@ -968,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))) @@ -990,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) @@ -1098,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 @@ -1152,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 @@ -1167,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))