X-Git-Url: https://git.notmuchmail.org/git?p=notmuch;a=blobdiff_plain;f=notmuch.el;h=c611dcc2cc72ebde11568b3e42f2fa6bb0f70f1c;hp=282932ed7fa9ea9655b8b6056927d63d8a060c74;hb=c5085642b8c6495ffea3d5709aa6da14cd1d8688;hpb=07ce64e4352291fb5bd265f20c683c653ab81966 diff --git a/notmuch.el b/notmuch.el index 282932ed..c611dcc2 100644 --- a/notmuch.el +++ b/notmuch.el @@ -51,38 +51,51 @@ (require 'mm-view) (require 'message) +(defvar notmuch-show-stash-map + (let ((map (make-sparse-keymap))) + (define-key map "c" 'notmuch-show-stash-cc) + (define-key map "d" 'notmuch-show-stash-date) + (define-key map "F" 'notmuch-show-stash-filename) + (define-key map "f" 'notmuch-show-stash-from) + (define-key map "i" 'notmuch-show-stash-message-id) + (define-key map "s" 'notmuch-show-stash-subject) + (define-key map "T" 'notmuch-show-stash-tags) + (define-key map "t" 'notmuch-show-stash-to) + map) + "Submap for stash commands" + ) + +(fset 'notmuch-show-stash-map notmuch-show-stash-map) + (defvar notmuch-show-mode-map (let ((map (make-sparse-keymap))) - ; I don't actually want all of these toggle commands occupying - ; keybindings. They steal valuable key-binding space, are hard - ; to remember, and act globally rather than locally. - ; - ; Will be much preferable to switch to direct manipulation for - ; toggling visibility of these components. Probably using - ; overlays-at to query and manipulate the current overlay. - (define-key map "a" 'notmuch-show-archive-thread) - (define-key map "A" 'notmuch-show-mark-read-then-archive-thread) - (define-key map "f" 'notmuch-show-forward-current) - (define-key map "m" 'message-mail) - (define-key map "n" 'notmuch-show-next-message) - (define-key map "N" 'notmuch-show-mark-read-then-next-open-message) - (define-key map "p" 'notmuch-show-previous-message) - (define-key map (kbd "C-n") 'notmuch-show-next-line) - (define-key map (kbd "C-p") 'notmuch-show-previous-line) + (define-key map "?" 'notmuch-help) (define-key map "q" 'kill-this-buffer) - (define-key map "r" 'notmuch-show-reply) + (define-key map (kbd "C-p") 'notmuch-show-previous-line) + (define-key map (kbd "C-n") 'notmuch-show-next-line) + (define-key map (kbd "M-TAB") 'notmuch-show-previous-button) + (define-key map (kbd "TAB") 'notmuch-show-next-button) (define-key map "s" 'notmuch-search) + (define-key map "m" 'message-mail) + (define-key map "f" 'notmuch-show-forward-current) + (define-key map "r" 'notmuch-show-reply) + (define-key map "|" 'notmuch-show-pipe-message) + (define-key map "w" 'notmuch-show-save-attachments) + (define-key map "V" 'notmuch-show-view-raw-message) (define-key map "v" 'notmuch-show-view-all-mime-parts) - (define-key map "w" 'notmuch-show-view-raw-message) - (define-key map "x" 'kill-this-buffer) - (define-key map "+" 'notmuch-show-add-tag) + (define-key map "c" 'notmuch-show-stash-map) + (define-key map "b" 'notmuch-show-toggle-current-body) + (define-key map "h" 'notmuch-show-toggle-current-header) (define-key map "-" 'notmuch-show-remove-tag) + (define-key map "+" 'notmuch-show-add-tag) + (define-key map "x" 'notmuch-show-archive-thread-then-exit) + (define-key map "a" 'notmuch-show-archive-thread) + (define-key map "P" 'notmuch-show-previous-message) + (define-key map "N" 'notmuch-show-next-message) + (define-key map "p" 'notmuch-show-previous-open-message) + (define-key map "n" 'notmuch-show-next-open-message) (define-key map (kbd "DEL") 'notmuch-show-rewind) - (define-key map " " 'notmuch-show-advance-marking-read-and-archiving) - (define-key map "|" 'notmuch-show-pipe-message) - (define-key map "?" 'describe-mode) - (define-key map (kbd "TAB") 'notmuch-show-next-button) - (define-key map (kbd "M-TAB") 'notmuch-show-previous-button) + (define-key map " " 'notmuch-show-advance-and-archive) map) "Keymap for \"notmuch show\" buffers.") (fset 'notmuch-show-mode-map notmuch-show-mode-map) @@ -97,9 +110,27 @@ for indentation at the beginning of the line. But notmuch will move past the indentation when testing this pattern, (so that the pattern can still test against the entire line).") +(defvar notmuch-show-signature-button-format + "[ %d-line signature. Click/Enter to toggle visibility. ]" + "String used to construct button text for hidden signatures + +Can use up to one integer format parameter, i.e. %d") + +(defvar notmuch-show-citation-button-format + "[ %d more citation lines. Click/Enter to toggle visibility. ]" + "String used to construct button text for hidden citations. + +Can use up to one integer format parameter, i.e. %d") + (defvar notmuch-show-signature-lines-max 12 "Maximum length of signature that will be hidden by default.") +(defvar notmuch-show-citation-lines-prefix 4 + "Always show at least this many lines of a citation. + +If there is one more line, show that, otherwise collapse +remaining lines into a button.") + (defvar notmuch-command "notmuch" "Command to run the notmuch binary.") @@ -116,8 +147,10 @@ pattern can still test against the entire line).") (defvar notmuch-show-marker-regexp "\f\\(message\\|header\\|body\\|attachment\\|part\\)[{}].*$") (defvar notmuch-show-id-regexp "\\(id:[^ ]*\\)") -(defvar notmuch-show-depth-regexp " depth:\\([0-9]*\\) ") +(defvar notmuch-show-depth-match-regexp " depth:\\([0-9]*\\).*match:\\([01]\\) ") (defvar notmuch-show-filename-regexp "filename:\\(.*\\)$") +(defvar notmuch-show-contentype-regexp "Content-type: \\(.*\\)") + (defvar notmuch-show-tags-regexp "(\\([^)]*\\))$") (defvar notmuch-show-parent-buffer nil) @@ -164,7 +197,7 @@ Unlike builtin `next-line' this version accepts no arguments." By advancing forward until reaching a visible character. -Unlike builtin `next-line' this version accepts no arguments." +Unlike builtin `previous-line' this version accepts no arguments." (interactive) (set 'this-command 'previous-line) (call-interactively 'previous-line) @@ -208,6 +241,62 @@ Unlike builtin `next-line' this version accepts no arguments." (re-search-forward notmuch-show-tags-regexp) (split-string (buffer-substring (match-beginning 1) (match-end 1))))) +(defun notmuch-show-get-bcc () + "Return BCC address(es) of current message" + (notmuch-show-get-header-field 'bcc)) + +(defun notmuch-show-get-cc () + "Return CC address(es) of current message" + (notmuch-show-get-header-field 'cc)) + +(defun notmuch-show-get-date () + "Return Date of current message" + (notmuch-show-get-header-field 'date)) + +(defun notmuch-show-get-from () + "Return From address of current message" + (notmuch-show-get-header-field 'from)) + +(defun notmuch-show-get-subject () + "Return Subject of current message" + (notmuch-show-get-header-field 'subject)) + +(defun notmuch-show-get-to () + "Return To address(es) of current message" + (notmuch-show-get-header-field 'to)) + +(defun notmuch-show-get-header-field (name) + "Retrieve the header field NAME from the current message. +NAME should be a symbol, in lower case, as returned by +mail-header-extract-no-properties" + (let* ((result (assoc name (notmuch-show-get-header))) + (val (and result (cdr result)))) + val)) + +(defun notmuch-show-get-header () + "Retrieve and parse the header from the current message. Returns an alist with of (header . value) +where header is a symbol and value is a string. The summary from notmuch-show is returned as the +pseudoheader summary" + (require 'mailheader) + (save-excursion + (beginning-of-line) + (if (not (looking-at notmuch-show-message-begin-regexp)) + (re-search-backward notmuch-show-message-begin-regexp)) + (re-search-forward (concat notmuch-show-header-begin-regexp "\n[[:space:]]*\\(.*\\)\n")) + (let* ((summary (buffer-substring-no-properties (match-beginning 1) (match-end 1))) + (beg (point))) + (re-search-forward notmuch-show-header-end-regexp) + (let ((text (buffer-substring beg (match-beginning 0)))) + (with-temp-buffer + (insert text) + (goto-char (point-min)) + (while (looking-at "\\([[:space:]]*\\)[A-Za-z][-A-Za-z0-9]*:") + (delete-region (match-beginning 1) (match-end 1)) + (forward-line) + ) + (goto-char (point-min)) + (cons (cons 'summary summary) (mail-header-extract-no-properties))))))) + (defun notmuch-show-add-tag (&rest toadd) "Add a tag to the current message." (interactive @@ -231,13 +320,22 @@ Unlike builtin `next-line' this version accepts no arguments." (cons (notmuch-show-get-message-id) nil))) (notmuch-show-set-tags (sort (set-difference tags toremove :test 'string=) 'string<)))))) -(defun notmuch-show-archive-thread-maybe-mark-read (markread) +(defun notmuch-show-archive-thread () + "Archive each message in thread, then show next thread from search. + +Archive each message currently shown by removing the \"inbox\" +tag from each. Then kill this buffer and show the next thread +from the search from which this thread was originally shown. + +Note: This command is safe from any race condition of new messages +being delivered to the same thread. It does not archive the +entire thread, but only the messages shown in the current +buffer." + (interactive) (save-excursion (goto-char (point-min)) (while (not (eobp)) - (if markread - (notmuch-show-remove-tag "unread" "inbox") - (notmuch-show-remove-tag "inbox")) + (notmuch-show-remove-tag "inbox") (if (not (eobp)) (forward-char)) (if (not (re-search-forward notmuch-show-message-begin-regexp nil t)) @@ -250,34 +348,11 @@ Unlike builtin `next-line' this version accepts no arguments." (forward-line) (notmuch-search-show-thread))))) -(defun notmuch-show-mark-read-then-archive-thread () - "Remove \"unread\" tag from each message, then archive and show next thread. - -Archive each message currently shown by removing the \"unread\" -and \"inbox\" tag from each. Then kill this buffer and show the -next thread from the search from which this thread was originally -shown. - -Note: This command is safe from any race condition of new messages -being delivered to the same thread. It does not archive the -entire thread, but only the messages shown in the current -buffer." +(defun notmuch-show-archive-thread-then-exit () + "Archive each message in thread, then exit back to search results." (interactive) - (notmuch-show-archive-thread-maybe-mark-read t)) - -(defun notmuch-show-archive-thread () - "Archive each message in thread, and show next thread from search. - -Archive each message currently shown by removing the \"inbox\" -tag from each. Then kill this buffer and show the next thread -from the search from which this thread was originally shown. - -Note: This command is safe from any race condition of new messages -being delivered to the same thread. It does not archive the -entire thread, but only the messages shown in the current -buffer." - (interactive) - (notmuch-show-archive-thread-maybe-mark-read nil)) + (notmuch-show-archive-thread) + (kill-this-buffer)) (defun notmuch-show-view-raw-message () "View the raw email of the current message." @@ -292,13 +367,73 @@ buffer." (with-current-buffer buf (insert-file-contents filename nil nil nil t) ,@body) - (kill-buffer buf))))) + (kill-buffer buf))))) (defun notmuch-show-view-all-mime-parts () - "Use external viewers (according to mailcap) to view all MIME-encoded parts." + "Use external viewers to view all attachments from the current message." + (interactive) + (with-current-notmuch-show-message + ; We ovverride the mm-inline-media-tests to indicate which message + ; parts are already sufficiently handled by the original + ; presentation of the message in notmuch-show mode. These parts + ; will be inserted directly into the temporary buffer of + ; with-current-notmuch-show-message and silently discarded. + ; + ; Any MIME part not explicitly mentioned here will be handled by an + ; external viewer as configured in the various mailcap files. + (let ((mm-inline-media-tests '( + ("text/.*" ignore identity) + ("application/pgp-signature" ignore identity) + ("multipart/alternative" ignore identity) + ("multipart/mixed" ignore identity) + ("multipart/related" ignore identity) + ))) + (mm-display-parts (mm-dissect-buffer))))) + +(defun notmuch-foreach-mime-part (function mm-handle) + (cond ((stringp (car mm-handle)) + (dolist (part (cdr mm-handle)) + (notmuch-foreach-mime-part function part))) + ((bufferp (car mm-handle)) + (funcall function mm-handle)) + (t (dolist (part mm-handle) + (notmuch-foreach-mime-part function part))))) + +(defun notmuch-count-attachments (mm-handle) + (let ((count 0)) + (notmuch-foreach-mime-part + (lambda (p) + (let ((disposition (mm-handle-disposition p))) + (and (listp disposition) + (or (equal (car disposition) "attachment") + (and (equal (car disposition) "inline") + (assq 'filename disposition))) + (incf count)))) + mm-handle) + count)) + +(defun notmuch-save-attachments (mm-handle &optional queryp) + (notmuch-foreach-mime-part + (lambda (p) + (let ((disposition (mm-handle-disposition p))) + (and (listp disposition) + (or (equal (car disposition) "attachment") + (and (equal (car disposition) "inline") + (assq 'filename disposition))) + (or (not queryp) + (y-or-n-p + (concat "Save '" (cdr (assq 'filename disposition)) "' "))) + (mm-save-part p)))) + mm-handle)) + +(defun notmuch-show-save-attachments () + "Save all attachments from the current message." (interactive) (with-current-notmuch-show-message - (mm-display-parts (mm-dissect-buffer)))) + (let ((mm-handle (mm-dissect-buffer))) + (notmuch-save-attachments + mm-handle (> (notmuch-count-attachments mm-handle) 1)))) + (message "Done")) (defun notmuch-reply (query-string) (switch-to-buffer (generate-new-buffer "notmuch-draft")) @@ -318,7 +453,7 @@ buffer." (notmuch-reply message-id))) (defun notmuch-show-forward-current () - "Forward a the current message." + "Forward the current message." (interactive) (with-current-notmuch-show-message (message-forward))) @@ -343,7 +478,7 @@ point either forward or backward to the next visible character when a command ends with point on an invisible character). Emits an error if point is not within a valid message, (that is -not pattern of `notmuch-show-message-begin-regexp' could be found +no pattern of `notmuch-show-message-begin-regexp' could be found by searching backward)." (beginning-of-line) (if (not (looking-at notmuch-show-message-begin-regexp)) @@ -360,22 +495,46 @@ by searching backward)." (not (re-search-forward notmuch-show-message-begin-regexp nil t))))) (defun notmuch-show-message-unread-p () - "Preficate testing whether current message is unread." + "Predicate testing whether current message is unread." (member "unread" (notmuch-show-get-tags))) -(defun notmuch-show-next-message () +(defun notmuch-show-message-open-p () + "Predicate testing whether current message is open (body is visible)." + (let ((btn (previous-button (point) t))) + (while (not (button-has-type-p btn 'notmuch-button-body-toggle-type)) + (setq btn (previous-button (button-start btn)))) + (not (invisible-p (button-get btn 'invisibility-spec))))) + +(defun notmuch-show-next-message-without-marking-read () "Advance to the beginning of the next message in the buffer. Moves to the last visible character of the current message if -already on the last message in the buffer." - (interactive) +already on the last message in the buffer. + +Returns nil if already on the last message in the buffer." (notmuch-show-move-to-current-message-summary-line) (if (re-search-forward notmuch-show-message-begin-regexp nil t) - (notmuch-show-move-to-current-message-summary-line) + (progn + (notmuch-show-move-to-current-message-summary-line) + (recenter 0) + t) (goto-char (- (point-max) 1)) (while (point-invisible-p) - (backward-char))) - (recenter 0)) + (backward-char)) + (recenter 0) + nil)) + +(defun notmuch-show-next-message () + "Advance to the next message (whether open or closed) +and remove the unread tag from that message. + +Moves to the last visible character of the current message if +already on the last message in the buffer. + +Returns nil if already on the last message in the buffer." + (interactive) + (notmuch-show-next-message-without-marking-read) + (notmuch-show-mark-read)) (defun notmuch-show-find-next-message () "Returns the position of the next message in the buffer. @@ -387,37 +546,39 @@ message if already within the last message in the buffer." ; Looks like we have to use both. (save-excursion (save-window-excursion - (notmuch-show-next-message) + (notmuch-show-next-message-without-marking-read) (point)))) (defun notmuch-show-next-unread-message () - "Advance to the beginning of the next unread message in the buffer. + "Advance to the next unread message. Moves to the last visible character of the current message if there are no more unread messages past the current point." - (notmuch-show-next-message) + (notmuch-show-next-message-without-marking-read) (while (and (not (notmuch-show-last-message-p)) (not (notmuch-show-message-unread-p))) - (notmuch-show-next-message)) + (notmuch-show-next-message-without-marking-read)) (if (not (notmuch-show-message-unread-p)) - (notmuch-show-next-message))) + (notmuch-show-next-message-without-marking-read)) + (notmuch-show-mark-read)) (defun notmuch-show-next-open-message () - "Advance to the next message which is not hidden. + "Advance to the next open message (that is, body is visible). -If read messages are currently hidden, advance to the next unread -message. Otherwise, advance to the next message." - (if (or (memq 'notmuch-show-body-read buffer-invisibility-spec) - (assq 'notmuch-show-body-read buffer-invisibility-spec)) - (notmuch-show-next-unread-message) - (notmuch-show-next-message))) +Moves to the last visible character of the final message in the buffer +if there are no more open messages." + (interactive) + (while (and (notmuch-show-next-message-without-marking-read) + (not (notmuch-show-message-open-p)))) + (notmuch-show-mark-read)) -(defun notmuch-show-previous-message () +(defun notmuch-show-previous-message-without-marking-read () "Backup to the beginning of the previous message in the buffer. If within a message rather than at the beginning of it, then -simply move to the beginning of the current message." - (interactive) +simply move to the beginning of the current message. + +Returns nil if already on the first message in the buffer." (let ((start (point))) (notmuch-show-move-to-current-message-summary-line) (if (not (< (point) start)) @@ -426,8 +587,22 @@ simply move to the beginning of the current message." (re-search-backward notmuch-show-message-begin-regexp nil t) (re-search-backward notmuch-show-message-begin-regexp nil t) (notmuch-show-move-to-current-message-summary-line) - )) - (recenter 0))) + (recenter 0) + (if (= (point) start) + nil + t)) + (recenter 0) + nil))) + +(defun notmuch-show-previous-message () + "Backup to the previous message (whether open or closed) +and remove the unread tag from that message. + +If within a message rather than at the beginning of it, then +simply move to the beginning of the current message." + (interactive) + (notmuch-show-previous-message-without-marking-read) + (notmuch-show-mark-read)) (defun notmuch-show-find-previous-message () "Returns the position of the previous message in the buffer. @@ -440,17 +615,21 @@ it." ; Looks like we have to use both. (save-excursion (save-window-excursion - (notmuch-show-previous-message) + (notmuch-show-previous-message-without-marking-read) (point)))) -(defun notmuch-show-mark-read-then-next-open-message () - "Remove unread tag from current message, then advance to next unread message." +(defun notmuch-show-previous-open-message () + "Backup to previous open message (that is, body is visible). + +Moves to the first message in the buffer if there are no previous +open messages." (interactive) - (notmuch-show-remove-tag "unread") - (notmuch-show-next-open-message)) + (while (and (notmuch-show-previous-message-without-marking-read) + (not (notmuch-show-message-open-p)))) + (notmuch-show-mark-read)) (defun notmuch-show-rewind () - "Do reverse scrolling compared to `notmuch-show-advance-marking-read-and-archiving' + "Backup through the thread, (reverse scrolling compared to \\[notmuch-show-advance-and-archive]). Specifically, if the beginning of the previous email is fewer than `window-height' lines from the current point, move to it @@ -460,7 +639,7 @@ Otherwise, just scroll down a screenful of the current message. This command does not modify any message tags, (it does not undo any effects from previous calls to -`notmuch-show-advance-marking-read-and-archiving'." +`notmuch-show-advance-and-archive'." (interactive) (let ((previous (notmuch-show-find-previous-message))) (if (> (count-lines previous (point)) (- (window-height) next-screen-context-lines)) @@ -468,11 +647,17 @@ any effects from previous calls to (condition-case nil (scroll-down nil) ((beginning-of-buffer) nil)) - (goto-char (window-start))) + (goto-char (window-start)) + ; Because count-lines counts invivisible lines, we may have + ; scrolled to far. If so., notice this and fix it up. + (if (< (point) previous) + (progn + (goto-char previous) + (recenter 0)))) (notmuch-show-previous-message)))) -(defun notmuch-show-advance-marking-read-and-archiving () - "Advance through buffer, marking read and archiving. +(defun notmuch-show-advance-and-archive () + "Advance through thread and archive. This command is intended to be one of the simplest ways to process a thread of email. It does the following: @@ -481,8 +666,7 @@ If the current message in the thread is not yet fully visible, scroll by a near screenful to read more of the message. Otherwise, (the end of the current message is already within the -current window), remove the \"unread\" tag (if present) from the -current message and advance to the next open message. +current window), advance to the next open message. Finally, if there is no further message to advance to, and this last message is already read, then archive the entire current @@ -495,22 +679,22 @@ which this thread was originally shown." (if (> next (window-end)) (scroll-up nil) (let ((last (notmuch-show-last-message-p))) - (notmuch-show-mark-read-then-next-open-message) + (notmuch-show-next-open-message) (if last (notmuch-show-archive-thread)))))) (defun notmuch-show-next-button () "Advance point to the next button in the buffer." (interactive) - (goto-char (button-start (next-button (point))))) + (forward-button 1)) (defun notmuch-show-previous-button () "Move point back to the previous button in the buffer." (interactive) - (goto-char (button-start (previous-button (point))))) + (backward-button 1)) (defun notmuch-toggle-invisible-action (cite-button) - (let ((invis-spec (button-get button 'invisibility-spec))) + (let ((invis-spec (button-get cite-button 'invisibility-spec))) (if (invisible-p invis-spec) (remove-from-invisibility-spec invis-spec) (add-to-invisibility-spec invis-spec) @@ -518,112 +702,181 @@ which this thread was originally shown." (force-window-update) (redisplay t)) -(define-button-type 'notmuch-button-invisibility-toggle-type 'action 'notmuch-toggle-invisible-action 'follow-link t) +(defun notmuch-show-toggle-current-body () + "Toggle the display of the current message body." + (interactive) + (save-excursion + (notmuch-show-move-to-current-message-summary-line) + (unless (button-at (point)) + (notmuch-show-next-button)) + (push-button)) + ) + +(defun notmuch-show-toggle-current-header () + "Toggle the display of the current message header." + (interactive) + (save-excursion + (notmuch-show-move-to-current-message-summary-line) + (forward-line) + (unless (button-at (point)) + (notmuch-show-next-button)) + (push-button)) + ) + +(define-button-type 'notmuch-button-invisibility-toggle-type + 'action 'notmuch-toggle-invisible-action + 'follow-link t + 'face 'font-lock-comment-face) (define-button-type 'notmuch-button-citation-toggle-type 'help-echo "mouse-1, RET: Show citation" :supertype 'notmuch-button-invisibility-toggle-type) (define-button-type 'notmuch-button-signature-toggle-type 'help-echo "mouse-1, RET: Show signature" :supertype 'notmuch-button-invisibility-toggle-type) (define-button-type 'notmuch-button-headers-toggle-type 'help-echo "mouse-1, RET: Show headers" :supertype 'notmuch-button-invisibility-toggle-type) -(define-button-type 'notmuch-button-body-toggle-type 'help-echo "mouse-1, RET: Show message" +(define-button-type 'notmuch-button-body-toggle-type + 'help-echo "mouse-1, RET: Show message" + 'face 'notmuch-message-summary-face :supertype 'notmuch-button-invisibility-toggle-type) +(defun notmuch-show-citation-regexp (depth) + "Build a regexp for matching citations at a given DEPTH (indent)" + (let ((line-regexp (format "[[:space:]]\\{%d\\}>.*\n" depth))) + (concat "\\(?:^" line-regexp + "\\(?:[[:space:]]*\n" line-regexp + "\\)?\\)+"))) + +(defun notmuch-show-region-to-button (beg end type prefix button-text) + "Auxilary function to do the actual making of overlays and buttons + +BEG and END are buffer locations. TYPE should a string, either +\"citation\" or \"signature\". PREFIX is some arbitrary text to +insert before the button, probably for indentation. BUTTON-TEXT +is what to put on the button." + +;; This uses some slightly tricky conversions between strings and +;; symbols because of the way the button code works. Note that +;; replacing intern-soft with make-symbol will cause this to fail, +;; since the newly created symbol has no plist. + + (let ((overlay (make-overlay beg end)) + (invis-spec (make-symbol (concat "notmuch-" type "-region"))) + (button-type (intern-soft (concat "notmuch-button-" + type "-toggle-type")))) + (add-to-invisibility-spec invis-spec) + (overlay-put overlay 'invisible invis-spec) + (goto-char (1+ end)) + (save-excursion + (goto-char (1- beg)) + (insert prefix) + (insert-button button-text + 'invisibility-spec invis-spec + :type button-type) + ))) + + (defun notmuch-show-markup-citations-region (beg end depth) - (goto-char beg) - (beginning-of-line) - (while (< (point) end) - (let ((beg-sub (point-marker)) - (indent (make-string depth ? )) - (citation "[[:space:]]*>")) - (if (looking-at citation) - (progn - (while (looking-at citation) - (forward-line)) - (let ((overlay (make-overlay beg-sub (point))) - (invis-spec (make-symbol "notmuch-citation-region"))) - (add-to-invisibility-spec invis-spec) - (overlay-put overlay 'invisible invis-spec) - (let ((p (point)) - (cite-button-text - (concat "[" (number-to-string (count-lines beg-sub (point))) - "-line citation.]"))) - (goto-char (- beg-sub 1)) - (insert (concat "\n" indent)) - (insert-button cite-button-text - 'invisibility-spec invis-spec - :type 'notmuch-button-citation-toggle-type) - (insert "\n") - (goto-char (+ (length cite-button-text) p)) - )))) - (move-to-column depth) - (if (looking-at notmuch-show-signature-regexp) - (let ((sig-lines (- (count-lines beg-sub end) 1))) - (if (<= sig-lines notmuch-show-signature-lines-max) - (progn - (let ((invis-spec (make-symbol "notmuch-signature-region"))) - (add-to-invisibility-spec invis-spec) - (overlay-put (make-overlay beg-sub end) - 'invisible invis-spec) - - (goto-char (- beg-sub 1)) - (insert (concat "\n" indent)) - (let ((sig-button-text (concat "[" (number-to-string sig-lines) - "-line signature.]"))) - (insert-button sig-button-text 'invisibility-spec invis-spec - :type 'notmuch-button-signature-toggle-type) - ) - (insert "\n") - (goto-char end)))))) - (forward-line)))) - -(defun notmuch-show-markup-part (beg end depth mime-message) + "Markup citations, and up to one signature in the given region" + ;; it would be nice if the untabify was not required, but + ;; that would require notmuch to indent with spaces. + (untabify beg end) + (let ((citation-regexp (notmuch-show-citation-regexp depth)) + (signature-regexp (concat (format "^[[:space:]]\\{%d\\}" depth) + notmuch-show-signature-regexp)) + (indent (concat "\n" (make-string depth ? )))) + (goto-char beg) + (beginning-of-line) + (while (and (< (point) end) + (re-search-forward citation-regexp end t)) + (let* ((cite-start (match-beginning 0)) + (cite-end (match-end 0)) + (cite-lines (count-lines cite-start cite-end))) + (when (> cite-lines (1+ notmuch-show-citation-lines-prefix)) + (goto-char cite-start) + (forward-line notmuch-show-citation-lines-prefix) + (notmuch-show-region-to-button + (point) cite-end + "citation" + indent + (format notmuch-show-citation-button-format + (- cite-lines notmuch-show-citation-lines-prefix)) + )))) + (if (and (< (point) end) + (re-search-forward signature-regexp end t)) + (let* ((sig-start (match-beginning 0)) + (sig-end (match-end 0)) + (sig-lines (1- (count-lines sig-start end)))) + (if (<= sig-lines notmuch-show-signature-lines-max) + (notmuch-show-region-to-button + sig-start + end + "signature" + indent + (format notmuch-show-signature-button-format sig-lines) + )))))) + +(defun notmuch-show-markup-part (beg end depth) (if (re-search-forward notmuch-show-part-begin-regexp nil t) (progn - (if (eq mime-message nil) - (let ((filename (notmuch-show-get-filename))) - (with-temp-buffer - (insert-file-contents filename nil nil nil t) - (setq mime-message (mm-dissect-buffer))))) - (forward-line) - (let ((part-beg (point-marker))) - (re-search-forward notmuch-show-part-end-regexp) - - (let ((part-end (copy-marker (match-beginning 0)))) - (goto-char part-end) - (if (not (bolp)) - (insert "\n")) - (indent-rigidly part-beg part-end depth) - (save-excursion - (goto-char part-beg) - (forward-line -1) - (beginning-of-line) - (let ((handle-type (mm-handle-type mime-message)) - mime-type) - (if (sequencep (car handle-type)) - (setq mime-type (car handle-type)) - (setq mime-type (car (car (cdr handle-type)))) - ) - (if (equal mime-type "text/html") - (mm-display-part mime-message)))) - - (notmuch-show-markup-citations-region part-beg part-end depth) - ; Advance to the next part (if any) (so the outer loop can - ; determine whether we've left the current message. - (if (re-search-forward notmuch-show-part-begin-regexp nil t) - (beginning-of-line))))) - (goto-char end)) - mime-message) + (let (mime-message mime-type) + (save-excursion + (re-search-forward notmuch-show-contentype-regexp end t) + (setq mime-type (car (split-string (buffer-substring + (match-beginning 1) (match-end 1)))))) + + (if (equal mime-type "text/html") + (let ((filename (notmuch-show-get-filename))) + (with-temp-buffer + (insert-file-contents filename nil nil nil t) + (setq mime-message (mm-dissect-buffer))))) + (forward-line) + (let ((beg (point-marker))) + (re-search-forward notmuch-show-part-end-regexp) + (let ((end (copy-marker (match-beginning 0)))) + (goto-char end) + (if (not (bolp)) + (insert "\n")) + (indent-rigidly beg end depth) + (if (not (eq mime-message nil)) + (save-excursion + (goto-char beg) + (forward-line -1) + (let ((handle-type (mm-handle-type mime-message)) + mime-type) + (if (sequencep (car handle-type)) + (setq mime-type (car handle-type)) + (setq mime-type (car (car (cdr handle-type)))) + ) + (if (equal mime-type "text/html") + (mm-display-part mime-message)))) + ) + (notmuch-show-markup-citations-region beg end depth) + ; Advance to the next part (if any) (so the outer loop can + ; determine whether we've left the current message. + (if (re-search-forward notmuch-show-part-begin-regexp nil t) + (beginning-of-line))))) + (goto-char end)) + (goto-char end))) (defun notmuch-show-markup-parts-region (beg end depth) (save-excursion (goto-char beg) - (let (mime-message) - (while (< (point) end) - (setq mime-message - (notmuch-show-markup-part - beg end depth mime-message)))))) - -(defun notmuch-show-markup-body (depth btn) + (while (< (point) end) + (notmuch-show-markup-part beg end depth)))) + +(defun notmuch-show-markup-body (depth match btn) + "Markup a message body, (indenting, buttonizing citations, +etc.), and hiding the body itself if the message does not match +the current search. + +DEPTH specifies the depth at which this message appears in the +tree of the current thread, (the top-level messages have depth 0 +and each reply increases depth by 1). MATCH indicates whether +this message is regarded as matching the current search. BTN is +the button which is used to toggle the visibility of this +message. + +When this function is called, point must be within the message, but +before the delimiter marking the beginning of the body." (re-search-forward notmuch-show-body-begin-regexp) (forward-line) (let ((beg (point-marker))) @@ -634,86 +887,95 @@ which this thread was originally shown." (overlay-put (make-overlay beg end) 'invisible invis-spec) (button-put btn 'invisibility-spec invis-spec) - (if (not (notmuch-show-message-unread-p)) + (if (not match) (add-to-invisibility-spec invis-spec))) (set-marker beg nil) (set-marker end nil) ))) + (defun notmuch-fontify-headers () - (progn - (if (looking-at "[Tt]o:") - (progn - (overlay-put (make-overlay (point) (re-search-forward ":")) - 'face 'message-header-name) - (overlay-put (make-overlay (point) (re-search-forward ".*$")) - 'face 'message-header-to)) + (while (looking-at "[[:space:]]") + (forward-char)) + (if (looking-at "[Tt]o:") + (progn + (overlay-put (make-overlay (point) (re-search-forward ":")) + 'face 'message-header-name) + (overlay-put (make-overlay (point) (re-search-forward ".*$")) + 'face 'message-header-to)) (if (looking-at "[B]?[Cc][Cc]:") (progn (overlay-put (make-overlay (point) (re-search-forward ":")) - 'face 'message-header-name) - (overlay-put (make-overlay (point) (re-search-forward ".*$")) - 'face 'message-header-cc)) - (if (looking-at "[Ss]ubject:") - (progn - (overlay-put (make-overlay (point) (re-search-forward ":")) - 'face 'message-header-name) - (overlay-put (make-overlay (point) (re-search-forward ".*$")) - 'face 'message-header-subject)) - (if (looking-at "[Ff]rom:") - (progn - (overlay-put (make-overlay (point) (re-search-forward ":")) - 'face 'message-header-name) - (overlay-put (make-overlay (point) (re-search-forward ".*$")) - 'face 'message-header-other)))))))) - -(defun notmuch-show-markup-header (depth) + 'face 'message-header-name) + (overlay-put (make-overlay (point) (re-search-forward ".*$")) + 'face 'message-header-cc)) + (if (looking-at "[Ss]ubject:") + (progn + (overlay-put (make-overlay (point) (re-search-forward ":")) + 'face 'message-header-name) + (overlay-put (make-overlay (point) (re-search-forward ".*$")) + 'face 'message-header-subject)) + (if (looking-at "[Ff]rom:") + (progn + (overlay-put (make-overlay (point) (re-search-forward ":")) + 'face 'message-header-name) + (overlay-put (make-overlay (point) (re-search-forward ".*$")) + 'face 'message-header-other))))))) + +(defun notmuch-show-markup-header (message-begin depth) + "Buttonize and decorate faces in a message header. + +MESSAGE-BEGIN is the position of the absolute first character in +the message (including all delimiters that will end up being +invisible etc.). This is to allow a button to reliably extend to +the beginning of the message even if point is positioned at an +invisible character (such as the beginning of the buffer). + +DEPTH specifies the depth at which this message appears in the +tree of the current thread, (the top-level messages have depth 0 +and each reply increases depth by 1)." (re-search-forward notmuch-show-header-begin-regexp) (forward-line) (let ((beg (point-marker)) + (summary-end (copy-marker (line-beginning-position 2))) + (subject-end (copy-marker (line-end-position 2))) + (invis-spec (make-symbol "notmuch-show-header")) (btn nil)) - (end-of-line) - ; Inverse video for subject - (overlay-put (make-overlay beg (point)) 'face '(:inverse-video t)) - (setq btn (make-button beg (point) :type 'notmuch-button-body-toggle-type)) - (forward-line 1) - (end-of-line) - (let ((beg-hidden (point-marker))) - (re-search-forward notmuch-show-header-end-regexp) - (beginning-of-line) - (let ((end (point-marker))) - (goto-char beg) - (forward-line) - (while (looking-at "[A-Za-z][-A-Za-z0-9]*:") - (beginning-of-line) - (notmuch-fontify-headers) - (forward-line) - ) - (indent-rigidly beg end depth) - (let ((invis-spec (make-symbol "notmuch-show-header"))) - (add-to-invisibility-spec (cons invis-spec t)) - (overlay-put (make-overlay beg-hidden end) - 'invisible invis-spec) - (goto-char beg) - (forward-line) - (make-button (line-beginning-position) (line-end-position) - 'invisibility-spec (cons invis-spec t) - :type 'notmuch-button-headers-toggle-type)) - (goto-char end) - (insert "\n") - (set-marker beg nil) - (set-marker beg-hidden nil) - (set-marker end nil) - )) - btn)) + (re-search-forward notmuch-show-header-end-regexp) + (beginning-of-line) + (let ((end (point-marker))) + (indent-rigidly beg end depth) + (goto-char beg) + (setq btn (make-button message-begin summary-end :type 'notmuch-button-body-toggle-type)) + (forward-line) + (add-to-invisibility-spec invis-spec) + (overlay-put (make-overlay subject-end end) + 'invisible invis-spec) + (make-button (line-beginning-position) subject-end + 'invisibility-spec invis-spec + :type 'notmuch-button-headers-toggle-type) + (while (looking-at "[[:space:]]*[A-Za-z][-A-Za-z0-9]*:") + (beginning-of-line) + (notmuch-fontify-headers) + (forward-line) + ) + (goto-char end) + (insert "\n") + (set-marker beg nil) + (set-marker summary-end nil) + (set-marker subject-end nil) + (set-marker end nil) + ) + btn)) (defun notmuch-show-markup-message () (if (re-search-forward notmuch-show-message-begin-regexp nil t) - (progn - (re-search-forward notmuch-show-depth-regexp) + (let ((message-begin (match-beginning 0))) + (re-search-forward notmuch-show-depth-match-regexp) (let ((depth (string-to-number (buffer-substring (match-beginning 1) (match-end 1)))) + (match (string= "1" (buffer-substring (match-beginning 2) (match-end 2)))) (btn nil)) - (setq btn (notmuch-show-markup-header depth)) - (notmuch-show-markup-body depth btn))) + (setq btn (notmuch-show-markup-header message-begin depth)) + (notmuch-show-markup-body depth match btn))) (goto-char (point-max)))) (defun notmuch-show-hide-markers () @@ -733,6 +995,76 @@ which this thread was originally shown." (notmuch-show-markup-message))) (notmuch-show-hide-markers)) +(defun notmuch-documentation-first-line (symbol) + "Return the first line of the documentation string for SYMBOL." + (let ((doc (documentation symbol))) + (if doc + (with-temp-buffer + (insert (documentation symbol t)) + (goto-char (point-min)) + (let ((beg (point))) + (end-of-line) + (buffer-substring beg (point)))) + ""))) + +(defun notmuch-prefix-key-description (key) + "Given a prefix key code, return a human-readable string representation. + +This is basically just `format-kbd-macro' but we also convert ESC to M-." + (let ((desc (format-kbd-macro (vector key)))) + (if (string= desc "ESC") + "M-" + (concat desc " ")))) + +; I would think that emacs would have code handy for walking a keymap +; and generating strings for each key, and I would prefer to just call +; that. But I couldn't find any (could be all implemented in C I +; suppose), so I wrote my own here. +(defun notmuch-substitute-one-command-key-with-prefix (prefix binding) + "For a key binding, return a string showing a human-readable +representation of the prefixed key as well as the first line of +documentation from the bound function. + +For a mouse binding, return nil." + (let ((key (car binding)) + (action (cdr binding))) + (if (mouse-event-p key) + nil + (if (keymapp action) + (let ((substitute (apply-partially 'notmuch-substitute-one-command-key-with-prefix (notmuch-prefix-key-description key))) + (as-list)) + (map-keymap (lambda (a b) + (push (cons a b) as-list)) + action) + (mapconcat substitute as-list "\n")) + (concat prefix (format-kbd-macro (vector key)) + "\t" + (notmuch-documentation-first-line action)))))) + +(defalias 'notmuch-substitute-one-command-key + (apply-partially 'notmuch-substitute-one-command-key-with-prefix nil)) + +(defun notmuch-substitute-command-keys (doc) + "Like `substitute-command-keys' but with documentation, not function names." + (let ((beg 0)) + (while (string-match "\\\\{\\([^}[:space:]]*\\)}" doc beg) + (let ((map (substring doc (match-beginning 1) (match-end 1)))) + (setq doc (replace-match (mapconcat 'notmuch-substitute-one-command-key + (cdr (symbol-value (intern map))) "\n") 1 1 doc))) + (setq beg (match-end 0))) + doc)) + +(defun notmuch-help () + "Display help for the current notmuch mode." + (interactive) + (let* ((mode major-mode) + (doc (substitute-command-keys (notmuch-substitute-command-keys (documentation mode t))))) + (with-current-buffer (generate-new-buffer "*notmuch-help*") + (insert doc) + (goto-char (point-min)) + (set-buffer-modified-p nil) + (view-buffer (current-buffer) 'kill-buffer-if-not-modified)))) + ;;;###autoload (defun notmuch-show-mode () "Major mode for viewing a thread with notmuch. @@ -741,22 +1073,26 @@ This buffer contains the results of the \"notmuch show\" command for displaying a single thread of email from your email archives. By default, various components of email messages, (citations, -signatures, already-read messages), are invisible to help you -focus on the most important things, (new text from unread -messages). See the various commands below for toggling the -visibility of hidden components. - -The `notmuch-show-next-message' and -`notmuch-show-previous-message' commands, (bound to 'n' and 'p by -default), allow you to navigate to the next and previous -messages. Each time you navigate away from a message with -`notmuch-show-next-message' the current message will have its -\"unread\" tag removed. - -You can add or remove tags from the current message with '+' and -'-'. You can also archive all messages in the current -view, (remove the \"inbox\" tag from each), with -`notmuch-show-archive-thread' (bound to 'a' by default). +signatures, already-read messages), are hidden. You can make +these parts visible by clicking with the mouse button or by +pressing RET after positioning the cursor on a hidden part, (for +which \\[notmuch-show-next-button] and \\[notmuch-show-previous-button] are helpful). + +Reading the thread sequentially is well-supported by pressing +\\[notmuch-show-advance-and-archive]. This will +scroll the current message (if necessary), advance to the next +message, or advance to the next thread (if already on the last +message of a thread). + +Other commands are available to read or manipulate the thread more +selectively, (such as '\\[notmuch-show-next-message]' and '\\[notmuch-show-previous-message]' to advance to messages without +removing any tags, and '\\[notmuch-show-archive-thread]' to archive an entire thread without +scrolling through with \\[notmuch-show-advance-and-archive]). + +You can add or remove arbitary tags from the current message with +'\\[notmuch-show-add-tag]' or '\\[notmuch-show-remove-tag]'. + +All currently available key bindings: \\{notmuch-show-mode-map}" (interactive) @@ -767,8 +1103,6 @@ view, (remove the \"inbox\" tag from each), with mode-name "notmuch-show") (setq buffer-read-only t)) -;;;###autoload - (defgroup notmuch nil "Notmuch mail reader for Emacs." :group 'mail) @@ -785,23 +1119,74 @@ view, (remove the \"inbox\" tag from each), with :options '(hl-line-mode) :group 'notmuch) +(defun notmuch-show-do-stash (text) + (kill-new text) + (message (concat "Saved: " text))) + +(defun notmuch-show-stash-cc () + "Copy CC field of current message to kill-ring." + (interactive) + (notmuch-show-do-stash (notmuch-show-get-cc))) + +(defun notmuch-show-stash-date () + "Copy date of current message to kill-ring." + (interactive) + (notmuch-show-do-stash (notmuch-show-get-date))) + +(defun notmuch-show-stash-filename () + "Copy filename of current message to kill-ring." + (interactive) + (notmuch-show-do-stash (notmuch-show-get-filename))) + +(defun notmuch-show-stash-from () + "Copy From address of current message to kill-ring." + (interactive) + (notmuch-show-do-stash (notmuch-show-get-from))) + +(defun notmuch-show-stash-message-id () + "Copy message ID of current message to kill-ring." + (interactive) + (notmuch-show-do-stash (notmuch-show-get-message-id))) + +(defun notmuch-show-stash-subject () + "Copy Subject field of current message to kill-ring." + (interactive) + (notmuch-show-do-stash (notmuch-show-get-subject))) + +(defun notmuch-show-stash-tags () + "Copy tags of current message to kill-ring as a comma separated list." + (interactive) + (notmuch-show-do-stash (mapconcat 'identity (notmuch-show-get-tags) ","))) + +(defun notmuch-show-stash-to () + "Copy To address of current message to kill-ring." + (interactive) + (notmuch-show-do-stash (notmuch-show-get-to))) + ; Make show mode a bit prettier, highlighting URLs and using word wrap +(defun notmuch-show-mark-read () + (notmuch-show-remove-tag "unread")) + (defun notmuch-show-pretty-hook () (goto-address-mode 1) (visual-line-mode)) +(add-hook 'notmuch-show-hook 'notmuch-show-mark-read) (add-hook 'notmuch-show-hook 'notmuch-show-pretty-hook) (add-hook 'notmuch-search-hook (lambda() (hl-line-mode 1) )) -(defun notmuch-show (thread-id &optional parent-buffer) +(defun notmuch-show (thread-id &optional parent-buffer query-context) "Run \"notmuch show\" with the given thread ID and display results. The optional PARENT-BUFFER is the notmuch-search buffer from which this notmuch-show command was executed, (so that the next -thread from that buffer can be show when done with this one)." +thread from that buffer can be show when done with this one). + +The optional QUERY-CONTEXT is a notmuch search term. Only messages from the thread +matching this search term are shown if non-nil. " (interactive "sNotmuch show: ") (let ((buffer (get-buffer-create (concat "*notmuch-show-" thread-id "*")))) (switch-to-buffer buffer) @@ -815,30 +1200,17 @@ thread from that buffer can be show when done with this one)." (erase-buffer) (goto-char (point-min)) (save-excursion - (call-process notmuch-command nil t nil "show" thread-id) + (let* ((basic-args (list notmuch-command nil t nil "show" "--entire-thread" thread-id)) + (args (if query-context (append basic-args (list "and (" query-context ")")) basic-args))) + (apply 'call-process args) + (when (and (eq (buffer-size) 0) query-context) + (apply 'call-process basic-args))) (notmuch-show-markup-messages) ) (run-hooks 'notmuch-show-hook) - ; Move straight to the first unread message - (if (not (notmuch-show-message-unread-p)) - (progn - (notmuch-show-next-unread-message) - ; But if there are no unread messages, go back to the - ; beginning of the buffer, and open up the bodies of all - ; read message. - (if (not (notmuch-show-message-unread-p)) - (progn - (goto-char (point-min)) - (let ((btn (forward-button 1))) - (while btn - (if (button-has-type-p btn 'notmuch-button-body-toggle-type) - (push-button)) - (condition-case err - (setq btn (forward-button 1)) - (error (setq btn nil))) - )) - (beginning-of-buffer) - )))) + ; Move straight to the first open message + (if (not (notmuch-show-message-open-p)) + (notmuch-show-next-open-message)) ))) (defvar notmuch-search-authors-width 40 @@ -846,30 +1218,29 @@ thread from that buffer can be show when done with this one)." (defvar notmuch-search-mode-map (let ((map (make-sparse-keymap))) - (define-key map "a" 'notmuch-search-archive-thread) - (define-key map "b" 'notmuch-search-scroll-down) - (define-key map "f" 'notmuch-search-filter) - (define-key map "m" 'message-mail) - (define-key map "n" 'next-line) - (define-key map "o" 'notmuch-search-toggle-order) - (define-key map "p" 'previous-line) + (define-key map "?" 'notmuch-help) (define-key map "q" 'kill-this-buffer) + (define-key map "x" 'kill-this-buffer) + (define-key map (kbd "") 'notmuch-search-scroll-down) + (define-key map "b" 'notmuch-search-scroll-down) + (define-key map " " 'notmuch-search-scroll-up) + (define-key map "<" 'notmuch-search-first-thread) + (define-key map ">" 'notmuch-search-last-thread) + (define-key map "p" 'notmuch-search-previous-thread) + (define-key map "n" 'notmuch-search-next-thread) (define-key map "r" 'notmuch-search-reply-to-thread) + (define-key map "m" 'message-mail) (define-key map "s" 'notmuch-search) + (define-key map "o" 'notmuch-search-toggle-order) + (define-key map "=" 'notmuch-search-refresh-view) (define-key map "t" 'notmuch-search-filter-by-tag) - (define-key map "x" 'kill-this-buffer) - (define-key map (kbd "RET") 'notmuch-search-show-thread) + (define-key map "f" 'notmuch-search-filter) (define-key map [mouse-1] 'notmuch-search-show-thread) - (define-key map "+" 'notmuch-search-add-tag) - (define-key map "-" 'notmuch-search-remove-tag) (define-key map "*" 'notmuch-search-operate-all) - (define-key map "<" 'beginning-of-buffer) - (define-key map ">" 'notmuch-search-goto-last-thread) - (define-key map "=" 'notmuch-search-refresh-view) - (define-key map "\M->" 'notmuch-search-goto-last-thread) - (define-key map " " 'notmuch-search-scroll-up) - (define-key map (kbd "") 'notmuch-search-scroll-down) - (define-key map "?" 'describe-mode) + (define-key map "a" 'notmuch-search-archive-thread) + (define-key map "-" 'notmuch-search-remove-tag) + (define-key map "+" 'notmuch-search-add-tag) + (define-key map (kbd "RET") 'notmuch-search-show-thread) map) "Keymap for \"notmuch search\" buffers.") (fset 'notmuch-search-mode-map notmuch-search-mode-map) @@ -878,16 +1249,17 @@ thread from that buffer can be show when done with this one)." (defvar notmuch-search-oldest-first t "Show the oldest mail first in the search-mode") +(defvar notmuch-search-disjunctive-regexp "\\<[oO][rR]\\>") (defun notmuch-search-scroll-up () - "Scroll up, moving point to last message in thread if at end." + "Move forward through search results by one window's worth." (interactive) (condition-case nil (scroll-up nil) - ((end-of-buffer) (notmuch-search-goto-last-thread)))) + ((end-of-buffer) (notmuch-search-last-thread)))) (defun notmuch-search-scroll-down () - "Scroll down, moving point to first message in thread if at beginning." + "Move backward through the search results by one window's worth." (interactive) ; I don't know why scroll-down doesn't signal beginning-of-buffer ; the way that scroll-up signals end-of-buffer, but c'est la vie. @@ -897,34 +1269,77 @@ thread from that buffer can be show when done with this one)." ; directly to that position. (We have to count lines since the ; window-start position is not the same as point-min due to the ; invisible thread-ID characters on the first line. - (if (equal (count-lines (point-min) (window-start)) 1) - (goto-char (window-start)) + (if (equal (count-lines (point-min) (window-start)) 0) + (goto-char (point-min)) (scroll-down nil))) -(defun notmuch-search-goto-last-thread () - "Move point to the last thread in the buffer." +(defun notmuch-search-next-thread () + "Select the next thread in the search results." + (interactive) + (forward-line 1)) + +(defun notmuch-search-previous-thread () + "Select the previous thread in the search results." (interactive) - (goto-char (point-max)) (forward-line -1)) +(defun notmuch-search-last-thread () + "Select the last thread in the search results." + (interactive) + (goto-char (point-max)) + (forward-line -2)) + +(defun notmuch-search-first-thread () + "Select the first thread in the search results." + (interactive) + (goto-char (point-min))) + +(defface notmuch-message-summary-face + '((((class color) (background light)) (:background "#f0f0f0")) + (((class color) (background dark)) (:background "#303030"))) + "Face for the single-line message summary in notmuch-show-mode." + :group 'notmuch) + +(defface notmuch-tag-face + '((((class color) + (background dark)) + (:foreground "OliveDrab1")) + (((class color) + (background light)) + (:foreground "navy blue" :bold t)) + (t + (:bold t))) + "Notmuch search mode face used to highligh tags." + :group 'notmuch) + +(defvar notmuch-tag-face-alist nil + "List containing the tag list that need to be highlighed") + +(defvar notmuch-search-font-lock-keywords nil) + ;;;###autoload (defun notmuch-search-mode () - "Major mode for searching mail with notmuch. + "Major mode displaying results of a notmuch search. This buffer contains the results of a \"notmuch search\" of your email archives. Each line in the buffer represents a single -thread giving a relative date for the thread and a subject. +thread giving a summary of the thread (a relative date, the +number of matched messages and total messages in the thread, +participants in the thread, a representative subject line, and +any tags). -Pressing RET on any line displays that thread. The '+' and '-' -keys can be used to add or remove tags from a thread. The 'a' key -is a convenience key for archiving a thread (removing the -\"inbox\" tag). +Pressing \\[notmuch-search-show-thread] on any line displays that thread. The '\\[notmuch-search-add-tag]' and '\\[notmuch-search-remove-tag]' +keys can be used to add or remove tags from a thread. The '\\[notmuch-search-archive-thread]' key +is a convenience for archiving a thread (removing the \"inbox\" +tag). The '\\[notmuch-search-operate-all]' key can be used to add or remove a tag from all +threads in the current buffer. -Other useful commands are `notmuch-search-filter' for filtering -the current search based on an additional query string, -`notmuch-search-filter-by-tag' for filtering to include only -messages with a given tag, and `notmuch-search' to execute a new, -global search. +Other useful commands are '\\[notmuch-search-filter]' for filtering the current search +based on an additional query string, '\\[notmuch-search-filter-by-tag]' for filtering to include +only messages with a given tag, and '\\[notmuch-search]' to execute a new, global +search. + +Complete list of currently available key bindings: \\{notmuch-search-mode-map}" (interactive) @@ -937,17 +1352,36 @@ global search. (setq truncate-lines t) (setq major-mode 'notmuch-search-mode mode-name "notmuch-search") - (setq buffer-read-only t)) + (setq buffer-read-only t) + (if (not notmuch-tag-face-alist) + (add-to-list 'notmuch-search-font-lock-keywords (list + "(\\([^)]*\\))$" '(1 'notmuch-tag-face))) + (let ((notmuch-search-tags (mapcar 'car notmuch-tag-face-alist))) + (loop for notmuch-search-tag in notmuch-search-tags + do (add-to-list 'notmuch-search-font-lock-keywords (list + (concat "([^)]*\\(" notmuch-search-tag "\\)[^)]*)$") + `(1 ,(cdr (assoc notmuch-search-tag notmuch-tag-face-alist)))))))) + (set (make-local-variable 'font-lock-defaults) + '(notmuch-search-font-lock-keywords t))) (defun notmuch-search-find-thread-id () "Return the thread for the current thread" (get-text-property (point) 'notmuch-search-thread-id)) +(defun notmuch-search-find-authors () + "Return the authors for the current thread" + (get-text-property (point) 'notmuch-search-authors)) + +(defun notmuch-search-find-subject () + "Return the subject for the current thread" + (get-text-property (point) 'notmuch-search-subject)) + (defun notmuch-search-show-thread () + "Display the currently selected thread." (interactive) (let ((thread-id (notmuch-search-find-thread-id))) (if (> (length thread-id) 0) - (notmuch-show thread-id (current-buffer)) + (notmuch-show thread-id (current-buffer) notmuch-search-query-string) (error "End of search results")))) (defun notmuch-search-reply-to-thread () @@ -996,25 +1430,29 @@ and will also appear in a buffer named \"*Notmuch errors*\"." (split-string (buffer-substring beg end)))))) (defun notmuch-search-add-tag (tag) - "Add a tag to messages in the current thread matching the -active query." + "Add a tag to the currently selected thread. + +The tag is added to messages in the currently selected thread +which match the current search terms." (interactive (list (notmuch-select-tag-with-completion "Tag to add: "))) - (notmuch-call-notmuch-process "tag" (concat "+" tag) (notmuch-search-find-thread-id) " and " notmuch-search-query-string) + (notmuch-call-notmuch-process "tag" (concat "+" tag) (notmuch-search-find-thread-id)) (notmuch-search-set-tags (delete-dups (sort (cons tag (notmuch-search-get-tags)) 'string<)))) (defun notmuch-search-remove-tag (tag) - "Remove a tag from messages in the current thread matching the -active query." + "Remove a tag from the currently selected thread. + +The tag is removed from messages in the currently selected thread +which match the current search terms." (interactive (list (notmuch-select-tag-with-completion "Tag to remove: " (notmuch-search-find-thread-id)))) - (notmuch-call-notmuch-process "tag" (concat "-" tag) (notmuch-search-find-thread-id) " and " notmuch-search-query-string) + (notmuch-call-notmuch-process "tag" (concat "-" tag) (notmuch-search-find-thread-id)) (notmuch-search-set-tags (delete tag (notmuch-search-get-tags)))) (defun notmuch-search-archive-thread () - "Archive the current thread (remove its \"inbox\" tag). + "Archive the currently selected thread (remove its \"inbox\" tag). -This function advances point to the next line when finished." +This function advances the next thread when finished." (interactive) (notmuch-search-remove-tag "inbox") (forward-line)) @@ -1049,7 +1487,7 @@ This function advances point to the next line when finished." (more t) (inhibit-read-only t)) (while more - (if (string-match "^\\(thread:[0-9A-Fa-f]*\\) \\(.*\\) \\(\\[[0-9/]*\\]\\) \\([^:]*\\); \\(.*\\) (\\([^()]*\\))$" string line) + (if (string-match "^\\(thread:[0-9A-Fa-f]*\\) \\(.*\\) \\(\\[[0-9/]*\\]\\) \\([^;]*\\); \\(.*\\) (\\([^()]*\\))$" string line) (let* ((thread-id (match-string 1 string)) (date (match-string 2 string)) (count (match-string 3 string)) @@ -1062,18 +1500,20 @@ This function advances point to the next line when finished." (goto-char (point-max)) (let ((beg (point-marker))) (insert (format "%s %-7s %-40s %s (%s)\n" date count authors subject tags)) - (put-text-property beg (point-marker) 'notmuch-search-thread-id thread-id)) + (put-text-property beg (point-marker) 'notmuch-search-thread-id thread-id) + (put-text-property beg (point-marker) 'notmuch-search-authors authors) + (put-text-property beg (point-marker) 'notmuch-search-subject subject)) (set 'line (match-end 0))) (set 'more nil)))))) (delete-process proc)))) (defun notmuch-search-operate-all (action) - "Operate on all messages matching the current query. Any -number of whitespace separated actions can be given. Each action -must have one of the two forms + "Add/remove tags from all matching messages. - +tagname Add the tag `tagname' - -tagname Remove the tag `tagname' +Tis command adds or removes tags from all messages matching the +current search terms. When called interactively, this command +will prompt for tags to be added or removed. Tags prefixed with +'+' will be added and tags prefixed with '-' will be removed. Each character of the tag name may consist of alphanumeric characters as well as `_.+-'. @@ -1084,12 +1524,13 @@ characters as well as `_.+-'. (let ((words action-split)) (when (null words) (error "No operation given")) (while words - (unless (string-match-p "^[\+\-][_\+\-\\w]+$" (car words)) + (unless (string-match-p "^[-+][-+_.[:word:]]+$" (car words)) (error "Action must be of the form `+thistag -that_tag'")) (setq words (cdr words)))) (apply 'notmuch-call-notmuch-process "tag" (append action-split (list notmuch-search-query-string) nil)))) +;;;###autoload (defun notmuch-search (query &optional oldest-first) "Run \"notmuch search\" with the given query string and display results." (interactive "sNotmuch search: ") @@ -1158,7 +1599,8 @@ search." Runs a new search matching only messages that match both the current search results AND the additional query string provided." (interactive "sFilter search: ") - (notmuch-search (concat notmuch-search-query-string " and " query) notmuch-search-oldest-first)) + (let ((grouped-query (if (string-match-p notmuch-search-disjunctive-regexp query) (concat "( " query " )") query))) + (notmuch-search (concat notmuch-search-query-string " and " grouped-query) notmuch-search-oldest-first))) (defun notmuch-search-filter-by-tag (tag) "Filter the current search results based on a single tag. @@ -1169,6 +1611,8 @@ current search results AND that are tagged with the given tag." (list (notmuch-select-tag-with-completion "Filter by tag: "))) (notmuch-search (concat notmuch-search-query-string " and tag:" tag) notmuch-search-oldest-first)) + +;;;###autoload (defun notmuch () "Run notmuch to display all mail with tag of 'inbox'" (interactive) @@ -1178,16 +1622,20 @@ current search results AND that are tagged with the given tag." (defvar notmuch-folder-mode-map (let ((map (make-sparse-keymap))) - (define-key map "n" 'next-line) - (define-key map "p" 'previous-line) + (define-key map "?" 'notmuch-help) (define-key map "x" 'kill-this-buffer) (define-key map "q" 'kill-this-buffer) - (define-key map "s" 'notmuch-search) - (define-key map (kbd "RET") 'notmuch-folder-show-search) - (define-key map "<" 'beginning-of-buffer) + (define-key map "m" 'message-mail) + (define-key map "e" 'notmuch-folder-show-empty-toggle) + (define-key map ">" 'notmuch-folder-last) + (define-key map "<" 'notmuch-folder-first) (define-key map "=" 'notmuch-folder) - (define-key map "?" 'describe-mode) + (define-key map "s" 'notmuch-search) (define-key map [mouse-1] 'notmuch-folder-show-search) + (define-key map (kbd "RET") 'notmuch-folder-show-search) + (define-key map " " 'notmuch-folder-show-search) + (define-key map "p" 'notmuch-folder-previous) + (define-key map "n" 'notmuch-folder-next) map) "Keymap for \"notmuch folder\" buffers.") @@ -1201,12 +1649,26 @@ current search results AND that are tagged with the given tag." (defun notmuch-folder-mode () "Major mode for showing notmuch 'folders'. -This buffer contains a list of messages counts returned by a -customizable set of searches of your email archives. Each line -in the buffer shows the search terms and the resulting message count. +This buffer contains a list of message counts returned by a +customizable set of searches of your email archives. Each line in +the buffer shows the name of a saved search and the resulting +message count. Pressing RET on any line opens a search window containing the -results for the search terms in that line. +results for the saved search on that line. + +Here is an example of how the search list could be +customized, (the following text would be placed in your ~/.emacs +file): + +(setq notmuch-folders '((\"inbox\" . \"tag:inbox\") + (\"unread\" . \"tag:inbox AND tag:unread\") + (\"notmuch\" . \"tag:inbox AND to:notmuchmail.org\"))) + +Of course, you can have any number of folders, each configured +with any supported search terms (see \"notmuch help search-terms\"). + +Currently available key bindings: \\{notmuch-folder-mode-map}" (interactive) @@ -1218,22 +1680,63 @@ results for the search terms in that line. mode-name "notmuch-folder") (setq buffer-read-only t)) +(defun notmuch-folder-next () + "Select the next folder in the list." + (interactive) + (forward-line 1) + (if (eobp) + (forward-line -1))) + +(defun notmuch-folder-previous () + "Select the previous folder in the list." + (interactive) + (forward-line -1)) + +(defun notmuch-folder-first () + "Select the first folder in the list." + (interactive) + (goto-char (point-min))) + +(defun notmuch-folder-last () + "Select the last folder in the list." + (interactive) + (goto-char (point-max)) + (forward-line -1)) + +(defun notmuch-folder-count (search) + (car (process-lines notmuch-command "count" search))) + +(setq notmuch-folder-show-empty t) + +(defun notmuch-folder-show-empty-toggle () + "Toggle the listing of empty folders" + (interactive) + (setq notmuch-folder-show-empty (not notmuch-folder-show-empty)) + (notmuch-folder)) + (defun notmuch-folder-add (folders) (if folders - (let ((name (car (car folders))) + (let* ((name (car (car folders))) (inhibit-read-only t) - (search (cdr (car folders)))) - (insert name) - (indent-to 16 1) - (call-process notmuch-command nil t nil "count" search) + (search (cdr (car folders))) + (count (notmuch-folder-count search))) + (if (or notmuch-folder-show-empty + (not (equal count "0"))) + (progn + (insert name) + (indent-to 16 1) + (insert count) + (insert "\n") + ) + ) (notmuch-folder-add (cdr folders))))) (defun notmuch-folder-find-name () (save-excursion (beginning-of-line) (let ((beg (point))) - (forward-word) - (filter-buffer-substring beg (point))))) + (re-search-forward "\\([ \t]*[^ \t]+\\)") + (filter-buffer-substring (match-beginning 1) (match-end 1))))) (defun notmuch-folder-show-search (&optional folder) "Show a search window for the search related to the specified folder." @@ -1244,6 +1747,7 @@ results for the search terms in that line. (if search (notmuch-search (cdr search) notmuch-search-oldest-first)))) +;;;###autoload (defun notmuch-folder () "Show the notmuch folder view and update the displayed counts." (interactive)