X-Git-Url: https://git.cworth.org/git?a=blobdiff_plain;f=emacs%2Fnotmuch-tree.el;h=9a83292c27bb20225da295e815401a6032dcf0fb;hb=c578c32e3be76fe19c3e7355a88fcb799b68b17e;hp=78b4a57ee3432743098c231c88e041c6a958252f;hpb=00b3ee4f82ed94125f6789ba7bdd88b98ed248ef;p=notmuch
diff --git a/emacs/notmuch-tree.el b/emacs/notmuch-tree.el
index 78b4a57e..9a83292c 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)
@@ -40,6 +42,11 @@
;; 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 notmuch-tree-unthreaded nil
+ "A buffer local copy of argument unthreaded to the function notmuch-tree")
+(make-variable-buffer-local 'notmuch-tree-unthreaded)
+
(defgroup notmuch-tree nil
"Showing message and thread structure."
:group 'notmuch)
@@ -49,6 +56,16 @@
:type 'boolean
:group 'notmuch-tree)
+(defcustom notmuch-unthreaded-show-out t
+ "View selected messages in new window rather than split-pane."
+ :type 'boolean
+ :group 'notmuch-tree)
+
+(defun notmuch-tree-show-out ()
+ (if notmuch-tree-unthreaded
+ notmuch-unthreaded-show-out
+ notmuch-tree-show-out))
+
(defcustom notmuch-tree-result-format
`(("date" . "%12s ")
("authors" . "%-20s")
@@ -69,9 +86,40 @@ Note the author string should not contain
:type '(alist :key-type (string) :value-type (string))
:group 'notmuch-tree)
+(defcustom notmuch-unthreaded-result-format
+ `(("date" . "%12s ")
+ ("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))
+ :group 'notmuch-tree)
+
+(defun notmuch-tree-result-format ()
+ (if notmuch-tree-unthreaded
+ notmuch-unthreaded-result-format
+ notmuch-tree-result-format))
+
;; 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 +138,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 +163,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)
@@ -195,6 +249,13 @@ open (if the message pane is closed it does nothing)."
(with-selected-window notmuch-tree-message-window
(call-interactively #',func)))))
+(defun notmuch-tree-inherit-from-message-pane (sym)
+ "Return value of SYM in message-pane if open, or tree-pane if not"
+ (if (window-live-p notmuch-tree-message-window)
+ (with-selected-window notmuch-tree-message-window
+ (symbol-value sym))
+ (symbol-value sym)))
+
(defun notmuch-tree-button-activate (&optional button)
"Activate BUTTON or button at point
@@ -212,33 +273,42 @@ FUNC."
`(lambda ()
,(concat "(Close message pane and) " (documentation func t))
(interactive)
- (notmuch-tree-close-message-window)
- (call-interactively #',func)))
+ (let ((notmuch-show-process-crypto
+ (notmuch-tree-inherit-from-message-pane 'notmuch-show-process-crypto)))
+ (notmuch-tree-close-message-window)
+ (call-interactively #',func))))
(defvar notmuch-tree-mode-map
(let ((map (make-sparse-keymap)))
(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 [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 "m" (notmuch-tree-close-message-pane-and #'notmuch-mua-new-mail))
+ (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)
+ (define-key map "U" 'notmuch-unthreaded-from-tree-current-query)
+ (define-key map "Z" 'notmuch-tree-from-unthreaded-current-query)
;; these use notmuch-show functions directly
(define-key map "|" 'notmuch-show-pipe-message)
(define-key map "w" 'notmuch-show-save-attachments)
(define-key map "v" 'notmuch-show-view-all-mime-parts)
(define-key map "c" 'notmuch-show-stash-map)
+ (define-key map "b" 'notmuch-show-resend-message)
;; these apply to the message pane
(define-key map (kbd "M-TAB") (notmuch-tree-to-message-pane #'notmuch-show-previous-button))
(define-key map (kbd "") (notmuch-tree-to-message-pane #'notmuch-show-previous-button))
(define-key map (kbd "TAB") (notmuch-tree-to-message-pane #'notmuch-show-next-button))
- (define-key map "e" (notmuch-tree-to-message-pane #'notmuch-tree-button-activate))
+ (define-key map "$" (notmuch-tree-to-message-pane #'notmuch-show-toggle-process-crypto))
;; bindings from show (or elsewhere) but we close the message pane first.
(define-key map "f" (notmuch-tree-close-message-pane-and #'notmuch-show-forward-message))
@@ -252,7 +322,6 @@ FUNC."
(define-key map "x" 'notmuch-tree-quit)
(define-key map "A" 'notmuch-tree-archive-thread)
(define-key map "a" 'notmuch-tree-archive-message-then-next)
- (define-key map "=" 'notmuch-tree-refresh-view)
(define-key map "z" 'notmuch-tree-to-tree)
(define-key map "n" 'notmuch-tree-next-matching-message)
(define-key map "p" 'notmuch-tree-prev-matching-message)
@@ -260,11 +329,13 @@ FUNC."
(define-key map "P" 'notmuch-tree-prev-message)
(define-key map (kbd "M-p") 'notmuch-tree-prev-thread)
(define-key map (kbd "M-n") 'notmuch-tree-next-thread)
+ (define-key map "k" 'notmuch-tag-jump)
(define-key map "-" 'notmuch-tree-remove-tag)
(define-key map "+" 'notmuch-tree-add-tag)
(define-key map "*" 'notmuch-tree-tag-thread)
(define-key map " " 'notmuch-tree-scroll-or-next)
- (define-key map "b" 'notmuch-tree-scroll-message-window-back)
+ (define-key map (kbd "DEL") 'notmuch-tree-scroll-message-window-back)
+ (define-key map "e" 'notmuch-tree-resume-message)
map))
(fset 'notmuch-tree-mode-map notmuch-tree-mode-map)
@@ -278,22 +349,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 +374,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 ()
@@ -359,12 +416,18 @@ updated."
(defun notmuch-tree-tag-update-display (&optional tag-changes)
"Update display for TAG-CHANGES to current message.
-Does NOT change the database."
+Updates the message in the message pane if appropriate, but does
+NOT change the database."
(let* ((current-tags (notmuch-tree-get-tags))
- (new-tags (notmuch-update-tags current-tags tag-changes)))
+ (new-tags (notmuch-update-tags current-tags tag-changes))
+ (tree-msg-id (notmuch-tree-get-message-id)))
(unless (equal current-tags new-tags)
(notmuch-tree-set-tags new-tags)
- (notmuch-tree-refresh-result))))
+ (notmuch-tree-refresh-result)
+ (when (window-live-p notmuch-tree-message-window)
+ (with-selected-window notmuch-tree-message-window
+ (when (string= tree-msg-id (notmuch-show-get-message-id))
+ (notmuch-show-update-tags new-tags)))))))
(defun notmuch-tree-tag (tag-changes)
"Change tags for the current message"
@@ -385,6 +448,15 @@ Does NOT change the database."
(list (notmuch-read-tag-changes (notmuch-tree-get-tags) "Tag message" "-")))
(notmuch-tree-tag tag-changes))
+(defun notmuch-tree-resume-message ()
+ "Resume EDITING the current draft message."
+ (interactive)
+ (notmuch-tree-close-message-window)
+ (let ((id (notmuch-tree-get-message-id)))
+ (if id
+ (notmuch-draft-resume id)
+ (message "No message to resume!"))))
+
;; The next two functions close the message window before calling
;; notmuch-search or notmuch-tree but they do so after the user has
;; entered the query (in case the user was basing the query on
@@ -404,14 +476,23 @@ 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-unthreaded-from-tree-current-query ()
+ "Switch from tree view to unthreaded view"
+ (interactive)
+ (unless notmuch-tree-unthreaded
+ (notmuch-tree-refresh-view 'unthreaded)))
+
+(defun notmuch-tree-from-unthreaded-current-query ()
+ "Switch from unthreaded view to tree view"
+ (interactive)
+ (when notmuch-tree-unthreaded
+ (notmuch-tree-refresh-view 'tree)))
+
+(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 +505,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)
@@ -467,8 +555,8 @@ Does NOT change the database."
Shows in split pane or whole window according to value of
`notmuch-tree-show-out'. A prefix argument reverses the choice."
(interactive "P")
- (if (or (and notmuch-tree-show-out (not arg))
- (and (not notmuch-tree-show-out) arg))
+ (if (or (and (notmuch-tree-show-out) (not arg))
+ (and (not (notmuch-tree-show-out)) arg))
(notmuch-tree-show-message-out)
(notmuch-tree-show-message-in)))
@@ -561,17 +649,24 @@ message will be \"unarchived\", i.e. the tag changes in
(when (window-live-p notmuch-tree-message-window)
(notmuch-tree-show-message-in)))
-(defun notmuch-tree-refresh-view ()
+(defun notmuch-tree-refresh-view (&optional view)
"Refresh view."
(interactive)
+ (when (get-buffer-process (current-buffer))
+ (error "notmuch tree process already running for current buffer"))
(let ((inhibit-read-only t)
(basic-query notmuch-tree-basic-query)
+ (unthreaded (cond ((eq view 'unthreaded) t)
+ ((eq view 'tree) nil)
+ (t notmuch-tree-unthreaded)))
(query-context notmuch-tree-query-context)
(target (notmuch-tree-get-message-id)))
(erase-buffer)
(notmuch-tree-worker basic-query
query-context
- target)))
+ target
+ nil
+ unthreaded)))
(defun notmuch-tree-thread-top ()
(when (notmuch-tree-get-message-properties)
@@ -696,27 +791,29 @@ 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"
;; We need to save the previous subject as it will get overwritten
;; by the insert-field calls.
(let ((previous-subject notmuch-tree-previous-subject))
- (insert (notmuch-tree-format-field-list notmuch-tree-result-format msg))
+ (insert (notmuch-tree-format-field-list (notmuch-tree-result-format) msg))
(notmuch-tree-set-message-properties msg)
(notmuch-tree-set-prop :previous-subject previous-subject)
(insert "\n")))
@@ -760,8 +857,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,8 +892,8 @@ 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 ()
- "Major mode displaying messages (as opposed to threads) of of a notmuch search.
+(define-derived-mode notmuch-tree-mode fundamental-mode "notmuch-tree"
+ "Major mode displaying messages (as opposed to threads) of a notmuch search.
This buffer contains the results of a \"notmuch tree\" of your
email archives. Each line in the buffer represents a single
@@ -807,12 +906,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))
@@ -855,29 +949,39 @@ Complete list of currently available key bindings:
(notmuch-sexp-parse-partial-list 'notmuch-tree-insert-forest-thread
results-buf)))))
-(defun notmuch-tree-worker (basic-query &optional query-context target open-target)
+(defun notmuch-tree-worker (basic-query &optional query-context target open-target unthreaded)
"Insert the tree view of the search in the current buffer.
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-unthreaded unthreaded)
(setq notmuch-tree-basic-query basic-query)
- (setq notmuch-tree-query-context query-context)
+ (setq notmuch-tree-query-context (if (or (string= query-context "")
+ (string= query-context "*"))
+ nil 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))
(let* ((search-args (concat basic-query
(if query-context (concat " and (" query-context ")"))
))
- (message-arg "--entire-thread"))
+ (message-arg (if unthreaded "--unthreaded" "--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"
+ "show" "--body=false" "--format=sexp" "--format-version=4"
message-arg search-args))
;; Use a scratch buffer to accumulate partial output.
;; This buffer will be killed by the sentinel, which
@@ -887,7 +991,16 @@ 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 (&optional query query-context target buffer-name open-target)
+(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 unthreaded)
"Display threads matching QUERY in Tree View.
The arguments are:
@@ -900,26 +1013,34 @@ The arguments are:
current if it appears in the tree view results.
BUFFER-NAME: the name of the buffer to display the tree view. If
it is nil \"*notmuch-tree\" followed by QUERY is used.
- OPEN-TARGET: If TRUE open the target message in the message pane."
+ OPEN-TARGET: If TRUE open the target message in the message pane.
+ UNTHREADED: If TRUE only show matching messages in an unthreaded view."
(interactive)
(if (null query)
- (setq query (notmuch-read-query "Notmuch tree view search: ")))
+ (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-tree-" query "*")))))
+ (concat "*notmuch-"
+ (if unthreaded "unthreaded-" "tree-")
+ query "*")))))
(inhibit-read-only t))
(switch-to-buffer buffer))
;; Don't track undo information for this buffer
(set 'buffer-undo-list t)
- (notmuch-tree-worker query query-context target open-target)
+ (notmuch-tree-worker query query-context target open-target unthreaded)
(setq truncate-lines t))
+(defun notmuch-unthreaded (&optional query query-context target buffer-name open-target)
+ (interactive)
+ (notmuch-tree query query-context target buffer-name open-target t))
-;; Set up key bindings from the rest of notmuch.
-(define-key notmuch-common-keymap "z" 'notmuch-tree)
-(define-key notmuch-show-mode-map "Z" 'notmuch-tree-from-show-current-query)
+;;
(provide 'notmuch-tree)
+
+;;; notmuch-tree.el ends here