X-Git-Url: https://git.notmuchmail.org/git?p=notmuch;a=blobdiff_plain;f=emacs%2Fnotmuch-tree.el;h=6e5797e970f6377ba0ba5ca79d7504c07c7dc755;hp=c66dd350a0073f00e3f9438d53415aed7ede2546;hb=7b2d7d65126b11ce08079b7cf235e1073fb1c22b;hpb=31d81f7fddfd262f0fe37ca32cace3827ab03cd7 diff --git a/emacs/notmuch-tree.el b/emacs/notmuch-tree.el index c66dd350..6e5797e9 100644 --- a/emacs/notmuch-tree.el +++ b/emacs/notmuch-tree.el @@ -1,4 +1,4 @@ -;; notmuch-tree.el --- displaying notmuch forests. +;;; notmuch-tree.el --- displaying notmuch forests. ;; ;; Copyright © Carl Worth ;; Copyright © David Edmondson @@ -17,11 +17,13 @@ ;; General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License -;; along with Notmuch. If not, see . +;; along with Notmuch. If not, see . ;; ;; Authors: David Edmondson ;; Mark Walters +;;; Code: + (require 'mail-parse) (require 'notmuch-lib) @@ -70,8 +72,14 @@ Note the author string should not contain :group 'notmuch-tree) ;; Faces for messages that match the query. -(defface notmuch-tree-match-date-face +(defface notmuch-tree-match-face '((t :inherit default)) + "Default face used in tree mode face for matching messages" + :group 'notmuch-tree + :group 'notmuch-faces) + +(defface notmuch-tree-match-date-face + nil "Face used in tree mode for the date in messages matching the query." :group 'notmuch-tree :group 'notmuch-faces) @@ -90,13 +98,13 @@ Note the author string should not contain :group 'notmuch-faces) (defface notmuch-tree-match-subject-face - '((t :inherit default)) + nil "Face used in tree mode for the subject in messages matching the query." :group 'notmuch-tree :group 'notmuch-faces) (defface notmuch-tree-match-tree-face - '((t :inherit default)) + nil "Face used in tree mode for the thread tree block graphics in messages matching the query." :group 'notmuch-tree :group 'notmuch-faces) @@ -115,32 +123,38 @@ Note the author string should not contain :group 'notmuch-faces) ;; Faces for messages that do not match the query. -(defface notmuch-tree-no-match-date-face +(defface notmuch-tree-no-match-face '((t (:foreground "gray"))) + "Default face used in tree mode face for non-matching messages" + :group 'notmuch-tree + :group 'notmuch-faces) + +(defface notmuch-tree-no-match-date-face + nil "Face used in tree mode for non-matching dates." :group 'notmuch-tree :group 'notmuch-faces) (defface notmuch-tree-no-match-subject-face - '((t (:foreground "gray"))) + nil "Face used in tree mode for non-matching subjects." :group 'notmuch-tree :group 'notmuch-faces) (defface notmuch-tree-no-match-tree-face - '((t (:foreground "gray"))) + nil "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-author-face - '((t (:foreground "gray"))) + nil "Face used in tree mode for the date in messages matching the query." :group 'notmuch-tree :group 'notmuch-faces) (defface notmuch-tree-no-match-tag-face - '((t (:foreground "gray"))) + nil "Face used in tree mode face for non-matching tags." :group 'notmuch-tree :group 'notmuch-faces) @@ -220,13 +234,17 @@ FUNC." (set-keymap-parent map notmuch-common-keymap) ;; The following override the global keymap. ;; Override because we want to close message pane first. - (define-key map "?" (notmuch-tree-close-message-pane-and #'notmuch-help)) + (define-key map [remap notmuch-help] (notmuch-tree-close-message-pane-and #'notmuch-help)) ;; Override because we first close message pane and then close tree buffer. - (define-key map "q" 'notmuch-tree-quit) + (define-key map [remap notmuch-bury-or-kill-this-buffer] 'notmuch-tree-quit) ;; Override because we close message pane after the search query is entered. - (define-key map "s" 'notmuch-tree-to-search) + (define-key map [remap notmuch-search] 'notmuch-tree-to-search) ;; Override because we want to close message pane first. - (define-key map "m" (notmuch-tree-close-message-pane-and #'notmuch-mua-new-mail)) + (define-key map [remap notmuch-mua-new-mail] (notmuch-tree-close-message-pane-and #'notmuch-mua-new-mail)) + ;; Override because we want to close message pane first. + (define-key map [remap notmuch-jump-search] (notmuch-tree-close-message-pane-and #'notmuch-jump-search)) + + (define-key map "S" 'notmuch-search-from-tree-current-query) ;; these use notmuch-show functions directly (define-key map "|" 'notmuch-show-pipe-message) @@ -278,22 +296,6 @@ Some useful entries are: (beginning-of-line) (get-text-property (point) :notmuch-message-properties))) -;; XXX This should really be a lib function but we are trying to -;; reduce impact on the code base. -(defun notmuch-show-get-prop (prop &optional props) - "This is a tree view overridden version of notmuch-show-get-prop - -It gets property PROP from PROPS or, if PROPS is nil, the current -message in either tree or show. This means that several functions -in notmuch-show now work unchanged in tree as they just need the -correct message properties." - (let ((props (or props - (cond ((eq major-mode 'notmuch-show-mode) - (notmuch-show-get-message-properties)) - ((eq major-mode 'notmuch-tree-mode) - (notmuch-tree-get-message-properties)))))) - (plist-get props prop))) - (defun notmuch-tree-set-message-properties (props) (save-excursion (beginning-of-line) @@ -319,11 +321,13 @@ correct message properties." "Return the tags of the current message." (notmuch-tree-get-prop :tags)) -(defun notmuch-tree-get-message-id () +(defun notmuch-tree-get-message-id (&optional bare) "Return the message id of the current message." (let ((id (notmuch-tree-get-prop :id))) (if id - (notmuch-id-to-query id) + (if bare + id + (notmuch-id-to-query id)) nil))) (defun notmuch-tree-get-match () @@ -404,14 +408,11 @@ Does NOT change the database." (notmuch-tree-close-message-window) (notmuch-tree query))) -;; This function should be in notmuch-show.el but be we trying to -;; minimise impact on the rest of the codebase. -(defun notmuch-tree-from-show-current-query () - "Call notmuch tree with the current query" +(defun notmuch-search-from-tree-current-query () + "Call notmuch search with the current query" (interactive) - (notmuch-tree notmuch-show-thread-id - notmuch-show-query-context - (notmuch-show-get-message-id))) + (notmuch-tree-close-message-window) + (notmuch-search (notmuch-tree-get-query))) (defun notmuch-tree-message-window-kill-hook () "Close the message pane when exiting the show buffer." @@ -424,6 +425,13 @@ Does NOT change the database." (ignore-errors (delete-window notmuch-tree-message-window))))) +(defun notmuch-tree-command-hook () + (when (eq major-mode 'notmuch-tree-mode) + ;; We just run the notmuch-show-command-hook on the message pane. + (when (buffer-live-p notmuch-tree-message-buffer) + (with-current-buffer notmuch-tree-message-buffer + (notmuch-show-command-hook))))) + (defun notmuch-tree-show-message-in () "Show the current message (in split-pane)." (interactive) @@ -696,20 +704,22 @@ unchanged ADDRESS if parsing fails." ((string-equal field "tags") (let ((tags (plist-get msg :tags)) + (orig-tags (plist-get msg :orig-tags)) (face (if match 'notmuch-tree-match-tag-face 'notmuch-tree-no-match-tag-face))) - (propertize (format format-string - (mapconcat #'identity tags ", ")) - 'face face)))))) - + (format format-string (notmuch-tag-format-tags tags orig-tags face))))))) (defun notmuch-tree-format-field-list (field-list msg) "Format fields of MSG according to FIELD-LIST and return string" - (let (result-string) + (let ((face (if (plist-get msg :match) + 'notmuch-tree-match-face + 'notmuch-tree-no-match-face)) + (result-string)) (dolist (spec field-list result-string) (let ((field-string (notmuch-tree-format-field (car spec) (cdr spec) msg))) - (setq result-string (concat result-string field-string)))))) + (setq result-string (concat result-string field-string)))) + (notmuch-apply-face result-string face t))) (defun notmuch-tree-insert-msg (msg) "Insert the message MSG according to notmuch-tree-result-format" @@ -760,8 +770,10 @@ message together with all its descendents." (push "├" tree-status))) (push (concat (if replies "┬" "─") "►") tree-status) - (plist-put msg :first (and first (eq 0 depth))) - (notmuch-tree-goto-and-insert-msg (plist-put msg :tree-status 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))) + (notmuch-tree-goto-and-insert-msg msg) (pop tree-status) (pop tree-status) @@ -793,7 +805,7 @@ This function inserts a collection of several complete threads as passed to it by notmuch-tree-process-filter." (mapc 'notmuch-tree-insert-forest-thread forest)) -(defun notmuch-tree-mode () +(define-derived-mode notmuch-tree-mode fundamental-mode "notmuch-tree" "Major mode displaying messages (as opposed to threads) of of a notmuch search. This buffer contains the results of a \"notmuch tree\" of your @@ -807,12 +819,7 @@ Complete list of currently available key bindings: \\{notmuch-tree-mode-map}" - (interactive) - (kill-all-local-variables) (setq notmuch-buffer-refresh-function #'notmuch-tree-refresh-view) - (use-local-map notmuch-tree-mode-map) - (setq major-mode 'notmuch-tree-mode - mode-name "notmuch-tree") (hl-line-mode 1) (setq buffer-read-only t truncate-lines t)) @@ -862,10 +869,16 @@ This is is a helper function for notmuch-tree. The arguments are the same as for the function notmuch-tree." (interactive) (notmuch-tree-mode) + (add-hook 'post-command-hook #'notmuch-tree-command-hook t t) (setq notmuch-tree-basic-query basic-query) (setq notmuch-tree-query-context query-context) (setq notmuch-tree-target-msg target) (setq notmuch-tree-open-target open-target) + ;; Set the default value for `notmuch-show-process-crypto' in this + ;; buffer. Although we don't use this some of the functions we call + ;; (such as reply) do. It is a buffer local variable so setting it + ;; will not affect genuine show buffers. + (setq notmuch-show-process-crypto notmuch-crypto-process-mime) (erase-buffer) (goto-char (point-min)) @@ -875,6 +888,7 @@ the same as for the function notmuch-tree." (message-arg "--entire-thread")) (if (equal (car (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" @@ -887,6 +901,15 @@ the same as for the function notmuch-tree." (set-process-filter proc 'notmuch-tree-process-filter) (set-process-query-on-exit-flag proc nil)))) +(defun notmuch-tree-get-query () + "Return the current query in this tree buffer" + (if notmuch-tree-query-context + (concat notmuch-tree-basic-query + " and (" + notmuch-tree-query-context + ")") + notmuch-tree-basic-query)) + (defun notmuch-tree (&optional query query-context target buffer-name open-target) "Display threads matching QUERY in Tree View. @@ -918,7 +941,8 @@ The arguments are: (setq truncate-lines t)) -;; Set up key bindings from the rest of notmuch. -(define-key notmuch-show-mode-map "Z" 'notmuch-tree-from-show-current-query) +;; (provide 'notmuch-tree) + +;;; notmuch-tree.el ends here