X-Git-Url: https://git.notmuchmail.org/git?p=notmuch;a=blobdiff_plain;f=notmuch.el;h=4b2936a9645b980b8654ec71788e010c17ab3c0b;hp=0863c6b7af7a2f7a9d53495a3b0efc619c5fa43a;hb=5d0a01dceb67e9bdcb95bcb2328baef5e7ea7d52;hpb=0ceef70efdfaa082506e5298c0a031e626d83ea9 diff --git a/notmuch.el b/notmuch.el index 0863c6b7..4b2936a9 100644 --- a/notmuch.el +++ b/notmuch.el @@ -18,18 +18,9 @@ ; along with Notmuch. If not, see . ; ; Authors: Carl Worth -; -; Much of notmuch.el was written by looking at the implementation of -; compile.el from the emacs distribution source which has the -; following copyright and authorsip (and the identical license as -; above): -; -; Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1996, 1997, 1998, 1999, -; 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 -; Free Software Foundation, Inc. -; Authors: Roland McGrath , -; Daniel Pfeiffer +(require 'cl) +(require 'mm-view) (defvar notmuch-show-mode-map (let ((map (make-sparse-keymap))) @@ -40,34 +31,103 @@ ; 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 "b" 'notmuch-show-toggle-body-read-visible) (define-key map "c" 'notmuch-show-toggle-citations-visible) (define-key map "h" 'notmuch-show-toggle-headers-visible) + (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 "q" 'kill-this-buffer) + (define-key map "r" 'notmuch-show-reply) (define-key map "s" 'notmuch-show-toggle-signatures-visible) + (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 "-" 'notmuch-show-remove-tag) + (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) map) "Keymap for \"notmuch show\" buffers.") (fset 'notmuch-show-mode-map notmuch-show-mode-map) -(defvar notmuch-show-message-begin-regexp " message{") -(defvar notmuch-show-message-end-regexp " message}") -(defvar notmuch-show-header-begin-regexp " header{") -(defvar notmuch-show-header-end-regexp " header}") -(defvar notmuch-show-body-begin-regexp " body{") -(defvar notmuch-show-body-end-regexp " body}") -(defvar notmuch-show-attachment-begin-regexp " attachment{") -(defvar notmuch-show-attachment-end-regexp " attachment}") -(defvar notmuch-show-part-begin-regexp " part{") -(defvar notmuch-show-part-end-regexp " part}") -(defvar notmuch-show-marker-regexp " \\(message\\|header\\|body\\|attachment\\|part\\)[{}].*$") - -(defvar notmuch-show-id-regexp "ID: \\([^ ]*\\)") -(defvar notmuch-show-tags-regexp "(\\([^)]*\\))$") +(defvar notmuch-show-signature-regexp "\\(-- ?\\|_+\\)$" + "Pattern to match a line that separates content from signature. + +The regexp can (and should) include $ to match the end of the +line, but should not include ^ to match the beginning of the +line. This is because notmuch may have inserted additional space +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-lines-max 12 + "Maximum length of signature that will be hidden by default.") + +(defvar notmuch-command "notmuch" + "Command to run the notmuch binary.") + +(set 'notmuch-show-message-begin-regexp "\fmessage{") +(set 'notmuch-show-message-end-regexp "\fmessage}") +(set 'notmuch-show-header-begin-regexp "\fheader{") +(set 'notmuch-show-header-end-regexp "\fheader}") +(set 'notmuch-show-body-begin-regexp "\fbody{") +(set 'notmuch-show-body-end-regexp "\fbody}") +(set 'notmuch-show-attachment-begin-regexp "\fattachment{") +(set 'notmuch-show-attachment-end-regexp "\fattachment}") +(set 'notmuch-show-part-begin-regexp "\fpart{") +(set 'notmuch-show-part-end-regexp "\fpart}") +(set 'notmuch-show-marker-regexp "\f\\(message\\|header\\|body\\|attachment\\|part\\)[{}].*$") + +(set 'notmuch-show-id-regexp "\\(id:[^ ]*\\)") +(set 'notmuch-show-depth-regexp " depth:\\([0-9]*\\) ") +(set 'notmuch-show-filename-regexp "filename:\\(.*\\)$") +(set 'notmuch-show-tags-regexp "(\\([^)]*\\))$") + +; XXX: This should be a generic function in emacs somewhere, not here +(defun point-invisible-p () + "Return whether the character at point is invisible. + +Here visibility is determined by `buffer-invisibility-spec' and +the invisible property of any overlays for point. It doesn't have +anything to do with whether point is currently being displayed +within the current window." + (let ((prop (get-char-property (point) 'invisible))) + (if (eq buffer-invisibility-spec t) + prop + (or (memq prop buffer-invisibility-spec) + (assq prop buffer-invisibility-spec))))) + +(defun notmuch-show-next-line () + "Like builtin `next-line' but ensuring we end on a visible character. + +By advancing forward until reaching a visible character. + +Unlike builtin `next-line' this version accepts no arguments." + (interactive) + (set 'this-command 'next-line) + (call-interactively 'next-line) + (while (point-invisible-p) + (forward-char))) + +(defun notmuch-show-previous-line () + "Like builtin `previous-line' but ensuring we end on a visible character. + +By advancing forward until reaching a visible character. + +Unlike builtin `next-line' this version accepts no arguments." + (interactive) + (set 'this-command 'previous-line) + (call-interactively 'previous-line) + (while (point-invisible-p) + (forward-char))) (defun notmuch-show-get-message-id () (save-excursion @@ -77,6 +137,14 @@ (re-search-forward notmuch-show-id-regexp) (buffer-substring (match-beginning 1) (match-end 1)))) +(defun notmuch-show-get-filename () + (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 notmuch-show-filename-regexp) + (buffer-substring (match-beginning 1) (match-end 1)))) + (defun notmuch-show-set-tags (tags) (save-excursion (beginning-of-line) @@ -98,113 +166,380 @@ (re-search-forward notmuch-show-tags-regexp) (split-string (buffer-substring (match-beginning 1) (match-end 1))))) -(defun notmuch-show-add-tag (tag) +(defun notmuch-show-add-tag (&rest toadd) + "Add a tag to the current message." (interactive "sTag to add: ") - (notmuch-call-notmuch-process "tag" (concat "+" tag) (concat "id:" (notmuch-show-get-message-id))) - (notmuch-show-set-tags (delete-dups (sort (cons tag (notmuch-show-get-tags)) 'string<)))) - -(defun notmuch-show-remove-tag (tag) + (apply 'notmuch-call-notmuch-process + (append (cons "tag" + (mapcar (lambda (s) (concat "+" s)) toadd)) + (cons (notmuch-show-get-message-id) nil))) + (notmuch-show-set-tags (sort (union toadd (notmuch-show-get-tags) :test 'string=) 'string<))) + +(defun notmuch-show-remove-tag (&rest toremove) + "Remove a tag from the current message." (interactive "sTag to remove: ") - (notmuch-call-notmuch-process "tag" (concat "-" tag) (concat "id:" (notmuch-show-get-message-id))) - (notmuch-show-set-tags (delete tag (notmuch-show-get-tags)))) + (let ((tags (notmuch-show-get-tags))) + (if (intersection tags toremove :test 'string=) + (progn + (apply 'notmuch-call-notmuch-process + (append (cons "tag" + (mapcar (lambda (s) (concat "-" s)) toremove)) + (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) + (save-excursion + (goto-char (point-min)) + (while (not (eobp)) + (if markread + (notmuch-show-remove-tag "unread" "inbox") + (notmuch-show-remove-tag "inbox")) + (if (not (eobp)) + (forward-char)) + (if (not (re-search-forward notmuch-show-message-begin-regexp nil t)) + (goto-char (point-max))))) + (let ((parent-buffer notmuch-show-parent-buffer)) + (kill-this-buffer) + (if parent-buffer + (progn + (switch-to-buffer parent-buffer) + (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." + (interactive) + (notmuch-show-archive-thread-maybe-mark-read t)) -(defun notmuch-show-next-message () - "Advance point to the beginning of the next message in the buffer. +(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. -Before moving, also remove the \"unread\" tag from the current message." +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-remove-tag "unread") - ; First, ensure we get off the current message marker - (if (not (eobp)) - (forward-char)) - (re-search-forward notmuch-show-message-begin-regexp nil t) - ; This dance might look pointless, but it's important. I originally - ; just had (beginning-of-line) here which looked right on the - ; display but actually put point all the way back to the first - ; character of the first invisible line. That is, it put point into - ; the closing markers of the previous message rather than at the - ; beginning of the current message. And that in turn meant that - ; looking up the current message-ID would actually return the - ; previous message ID. - ; - ; So this dance ensures that we're actually on the current message - ; when it looks like we are. - (end-of-visible-line) + (notmuch-show-archive-thread-maybe-mark-read nil)) + +(defun notmuch-show-view-raw-message () + "View the raw email of the current message." + (interactive) + (view-file (notmuch-show-get-filename))) + +(defun notmuch-show-view-all-mime-parts () + "Use external viewers (according to mailcap) to view all MIME-encoded parts." + (interactive) + (save-excursion + (let ((filename (notmuch-show-get-filename))) + (switch-to-buffer (generate-new-buffer (concat "*notmuch-mime-" + filename + "*"))) + (insert-file-contents filename nil nil nil t) + (mm-display-parts (mm-dissect-buffer)) + (kill-this-buffer)))) + +(defun notmuch-reply (query-string) + (switch-to-buffer (generate-new-buffer "notmuch-draft")) + (call-process notmuch-command nil t nil "reply" query-string) + (goto-char (point-min)) + (if (re-search-forward "^$" nil t) + (progn + (insert "--text follows this line--") + (forward-line))) + (message-mode)) + +(defun notmuch-show-reply () + "Begin composing a reply to the current message in a new buffer." + (interactive) + (let ((message-id (notmuch-show-get-message-id))) + (notmuch-reply message-id))) + +(defun notmuch-show-pipe-message (command) + "Pipe the contents of the current message to the given command. + +The given command will be executed with the raw contents of the +current email message as stdin. Anything printed by the command +to stdout or stderr will appear in the *Messages* buffer." + (interactive "sPipe message to command: ") + (apply 'start-process-shell-command "notmuch-pipe-command" "*notmuch-pipe*" (split-string (concat command " < " (notmuch-show-get-filename))))) + +(defun notmuch-show-move-to-current-message-summary-line () + "Move to the beginning of the one-line summary of the current message. + +This gives us a stable place to move to and work from since the +summary line is always visible. This is important since moving to +an invisible location is unreliable, (the main command loop moves +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 +by searching backward)." (beginning-of-line) + (if (not (looking-at notmuch-show-message-begin-regexp)) + (if (re-search-backward notmuch-show-message-begin-regexp nil t) + (forward-line 2) + (error "Not within a valid message.")) + (forward-line 2))) + +(defun notmuch-show-last-message-p () + "Predicate testing whether point is within the last message." + (save-window-excursion + (save-excursion + (notmuch-show-move-to-current-message-summary-line) + (not (re-search-forward notmuch-show-message-begin-regexp nil t))))) + +(defun notmuch-show-message-unread-p () + "Preficate testing whether current message is unread." + (member "unread" (notmuch-show-get-tags))) + +(defun notmuch-show-next-message () + "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) + (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) + (goto-char (- (point-max) 1)) + (while (point-invisible-p) + (backward-char))) (recenter 0)) +(defun notmuch-show-find-next-message () + "Returns the position of the next message in the buffer. + +Or the position of the last visible character of the current +message if already within the last message in the buffer." + ; save-excursion doesn't save our window position + ; save-window-excursion doesn't save point + ; Looks like we have to use both. + (save-excursion + (save-window-excursion + (notmuch-show-next-message) + (point)))) + +(defun notmuch-show-next-unread-message () + "Advance to the beginning of the next unread message in the buffer. + +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) + (while (and (not (notmuch-show-last-message-p)) + (not (notmuch-show-message-unread-p))) + (notmuch-show-next-message)) + (if (not (notmuch-show-message-unread-p)) + (notmuch-show-next-message))) + +(defun notmuch-show-next-open-message () + "Advance to the next message which is not hidden. + +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))) + (defun notmuch-show-previous-message () - "Advance point to the beginning of the previous message in the buffer." + "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) - ; First, ensure we get off the current message marker - (if (not (bobp)) - (previous-line)) - (re-search-backward notmuch-show-message-begin-regexp nil t) - ; This dance might look pointless, but it's important. I originally - ; just had (beginning-of-line) here which looked right on the - ; display but actually put point all the way back to the first - ; character of the first invisible line. That is, it put point into - ; the closing markers of the previous message rather than at the - ; beginning of the current message. And that in turn meant that - ; looking up the current message-ID would actually return the - ; previous message ID. - ; - ; So this dance ensures that we're actually on the current message - ; when it looks like we are. - (end-of-visible-line) - (beginning-of-line) - (recenter 0)) + (let ((start (point))) + (notmuch-show-move-to-current-message-summary-line) + (if (not (< (point) start)) + ; Go backward twice to skip the current message's marker + (progn + (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))) + +(defun notmuch-show-find-previous-message () + "Returns the position of the previous message in the buffer. + +Or the position of the beginning of the current message if point +is originally within the message rather than at the beginning of +it." + ; save-excursion doesn't save our window position + ; save-window-excursion doesn't save point + ; Looks like we have to use both. + (save-excursion + (save-window-excursion + (notmuch-show-previous-message) + (point)))) + +(defun notmuch-show-mark-read-then-next-open-message () + "Remove unread tag from current message, then advance to next unread message." + (interactive) + (notmuch-show-remove-tag "unread") + (notmuch-show-next-open-message)) + +(defun notmuch-show-rewind () + "Do reverse scrolling compared to `notmuch-show-advance-marking-read-and-archiving' + +Specifically, if the beginning of the previous email is fewer +than `window-height' lines from the current point, move to it +just like `notmuch-show-previous-message'. -(defun notmuch-show-markup-citations-region (beg end) +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'." + (interactive) + (let ((previous (notmuch-show-find-previous-message))) + (if (> (count-lines previous (point)) (- (window-height) next-screen-context-lines)) + (progn + (condition-case nil + (scroll-down nil) + ((beginning-of-buffer) nil)) + (goto-char (window-start))) + (notmuch-show-previous-message)))) + +(defun notmuch-show-advance-marking-read-and-archiving () + "Advance through buffer, marking read and archiving. + +This command is intended to be one of the simplest ways to +process a thread of email. It does the following: + +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. + +Finally, if there is no further message to advance to, and this +last message is already read, then archive the entire current +thread, (remove the \"inbox\" tag from each message). Also kill +this buffer, and display the next thread from the search from +which this thread was originally shown." + (interactive) + (let ((next (notmuch-show-find-next-message)) + (unread (notmuch-show-message-unread-p))) + (if (> next (window-end)) + (scroll-up nil) + (let ((last (notmuch-show-last-message-p))) + (notmuch-show-mark-read-then-next-open-message) + (if last + (notmuch-show-archive-thread)))))) + +(defun notmuch-show-markup-citations-region (beg end depth) (goto-char beg) (beginning-of-line) (while (< (point) end) - (let ((beg-sub (point))) - (if (looking-at ">") + (let ((beg-sub (point-marker)) + (indent (make-string depth ? )) + (citation "[[:space:]]*>")) + (if (looking-at citation) (progn - (while (looking-at ">") - (next-line)) + (while (looking-at citation) + (forward-line)) (let ((overlay (make-overlay beg-sub (point)))) (overlay-put overlay 'invisible 'notmuch-show-citation) (overlay-put overlay 'before-string - (concat "[" (number-to-string (count-lines beg-sub (point))) - " quoted lines.]"))))) - (if (looking-at "--[ ]?$") - (let ((overlay (make-overlay beg-sub end))) - (overlay-put overlay 'invisible 'notmuch-show-signature) - (overlay-put overlay 'before-string - (concat "[" (number-to-string (count-lines beg-sub (point))) - "-line signature.]")) - (goto-char end))) - (next-line)))) - -(defun notmuch-show-markup-body (unread) + (concat indent + "[" (number-to-string (count-lines beg-sub (point))) + "-line citation. Press 'c' to show.]\n"))))) + (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 + (overlay-put (make-overlay beg-sub end) + 'invisible 'notmuch-show-signature) + (overlay-put (make-overlay beg (- beg-sub 1)) + 'after-string + (concat "\n" indent + "[" (number-to-string sig-lines) + "-line signature. Press 's' to show.]")) + (goto-char end))))) + (forward-line)))) + +(defun notmuch-show-markup-part (beg end depth) + (if (re-search-forward notmuch-show-part-begin-regexp nil t) + (progn + (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) + (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))) + +(defun notmuch-show-markup-parts-region (beg end depth) + (save-excursion + (goto-char beg) + (while (< (point) end) + (notmuch-show-markup-part beg end depth)))) + +(defun notmuch-show-markup-body (depth) (re-search-forward notmuch-show-body-begin-regexp) - (next-line 1) - (beginning-of-line) - (let ((beg (point))) + (forward-line) + (let ((beg (point-marker))) (re-search-forward notmuch-show-body-end-regexp) - (if (not unread) - (overlay-put (make-overlay beg (match-beginning 0)) - 'invisible 'notmuch-show-body-read)) - (notmuch-show-markup-citations-region beg (point)) - )) + (let ((end (copy-marker (match-beginning 0)))) + (notmuch-show-markup-parts-region beg end depth) + (if (not (notmuch-show-message-unread-p)) + (overlay-put (make-overlay beg end) + 'invisible 'notmuch-show-body-read)) + (set-marker beg nil) + (set-marker end nil) + ))) -(defun notmuch-show-markup-header () +(defun notmuch-show-markup-header (depth) (re-search-forward notmuch-show-header-begin-regexp) - (next-line 2) - (beginning-of-line) - (let ((beg (point))) - (re-search-forward notmuch-show-header-end-regexp) - (overlay-put (make-overlay beg (match-beginning 0)) - 'invisible 'notmuch-show-header))) + (forward-line) + (let ((beg (point-marker))) + (end-of-line) + ; Inverse video for subject + (overlay-put (make-overlay beg (point)) 'face '((cons :inverse-video t))) + (forward-line 2) + (let ((beg-hidden (point-marker))) + (re-search-forward notmuch-show-header-end-regexp) + (beginning-of-line) + (let ((end (point-marker))) + (indent-rigidly beg end depth) + (overlay-put (make-overlay beg-hidden end) + 'invisible 'notmuch-show-header) + (set-marker beg nil) + (set-marker beg-hidden nil) + (set-marker end nil) + )))) (defun notmuch-show-markup-message () (if (re-search-forward notmuch-show-message-begin-regexp nil t) (progn - (let ((unread (looking-at ".*unread$"))) - (notmuch-show-markup-header) - (notmuch-show-markup-body unread))) + (re-search-forward notmuch-show-depth-regexp) + (let ((depth (string-to-number (buffer-substring (match-beginning 1) (match-end 1))))) + (notmuch-show-markup-header depth) + (notmuch-show-markup-body depth))) (goto-char (point-max)))) (defun notmuch-show-hide-markers () @@ -270,7 +605,30 @@ Before moving, also remove the \"unread\" tag from the current message." ;;;###autoload (defun notmuch-show-mode () - "Major mode for handling the output of \"notmuch show\"" + "Major mode for viewing a thread with notmuch. + +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). + +\\{notmuch-show-mode-map}" (interactive) (kill-all-local-variables) (set (make-local-variable 'notmuch-show-headers-visible) t) @@ -287,12 +645,46 @@ Before moving, also remove the \"unread\" tag from the current message." mode-name "notmuch-show") (setq buffer-read-only t)) -(defun notmuch-show (thread-id) - "Run \"notmuch show\" with the given thread ID and display results." +;;;###autoload + +(defgroup notmuch nil + "Notmuch mail reader for Emacs." + :group 'mail) + +(defcustom notmuch-show-hook nil + "List of functions to call when notmuch displays a message." + :type 'hook + :options '(goto-address) + :group 'notmuch) + +(defcustom notmuch-search-hook nil + "List of functions to call when notmuch displays the search results." + :type 'hook + :options '(hl-line-mode) + :group 'notmuch) + +; Make show mode a bit prettier, highlighting URLs and using word wrap + +(defun notmuch-show-pretty-hook () + (goto-address-mode 1) + (visual-line-mode)) + +(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) + "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)." (interactive "sNotmuch show: ") (let ((buffer (get-buffer-create (concat "*notmuch-show-" thread-id "*")))) (switch-to-buffer buffer) (notmuch-show-mode) + (set (make-local-variable 'notmuch-show-parent-buffer) parent-buffer) (let ((proc (get-buffer-process (current-buffer))) (inhibit-read-only t)) (if proc @@ -301,44 +693,110 @@ Before moving, also remove the \"unread\" tag from the current message." (erase-buffer) (goto-char (point-min)) (save-excursion - (call-process "notmuch" nil t nil "show" thread-id) + (call-process notmuch-command nil t nil "show" thread-id) (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)) + (notmuch-show-toggle-body-read-visible))))) ))) +(defvar notmuch-search-authors-width 40 + "Number of columns to use to display authors in a notmuch-search buffer.") + (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 "q" 'kill-this-buffer) + (define-key map "r" 'notmuch-search-reply-to-thread) (define-key map "s" 'notmuch-search) + (define-key map "t" 'notmuch-search-filter-by-tag) (define-key map "x" 'kill-this-buffer) - (define-key map "\r" 'notmuch-search-show-thread) + (define-key map (kbd "RET") 'notmuch-search-show-thread) (define-key map "+" 'notmuch-search-add-tag) (define-key map "-" 'notmuch-search-remove-tag) (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) map) "Keymap for \"notmuch search\" buffers.") (fset 'notmuch-search-mode-map notmuch-search-mode-map) +(defun notmuch-search-scroll-up () + "Scroll up, moving point to last message in thread if at end." + (interactive) + (condition-case nil + (scroll-up nil) + ((end-of-buffer) (notmuch-search-goto-last-thread)))) + +(defun notmuch-search-scroll-down () + "Scroll down, moving point to first message in thread if at beginning." + (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. + ; + ; So instead of trapping a signal we instead check whether the + ; window begins on the first line of the buffer and if so, move + ; 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)) + (scroll-down nil))) + (defun notmuch-search-goto-last-thread (&optional arg) "Move point to the last thread in the buffer." (interactive "^P") (end-of-buffer arg) - (beginning-of-line)) + (forward-line -1)) ;;;###autoload (defun notmuch-search-mode () - "Major mode for handling the output of \"notmuch search\"" + "Major mode for searching mail with notmuch. + +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. + +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). + +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. + +\\{notmuch-search-mode-map}" (interactive) (kill-all-local-variables) (make-local-variable 'notmuch-search-query-string) + (make-local-variable 'notmuch-search-oldest-first) + (set (make-local-variable 'scroll-preserve-screen-position) t) + (add-to-invisibility-spec 'notmuch-search) (use-local-map notmuch-search-mode-map) + (setq truncate-lines t) (setq major-mode 'notmuch-search-mode mode-name "notmuch-search") (setq buffer-read-only t)) @@ -347,40 +805,56 @@ Before moving, also remove the \"unread\" tag from the current message." (save-excursion (beginning-of-line) (let ((beg (point))) - (re-search-forward "[a-fA-F0-9]*") + (re-search-forward "thread:[a-fA-F0-9]*" nil t) (filter-buffer-substring beg (point))))) (defun notmuch-search-markup-this-thread-id () (beginning-of-line) (let ((beg (point))) - (re-search-forward "[a-fA-F0-9]*") - (forward-char) - (overlay-put (make-overlay beg (point)) 'invisible 'notmuch-search))) + (if (re-search-forward "thread:[a-fA-F0-9]*" nil t) + (progn + (forward-char) + (overlay-put (make-overlay beg (point)) 'invisible 'notmuch-search) + (re-search-forward ".*\\[[0-9]*/[0-9]*\\] \\([^;]*\\)\\(;\\)") + (let* ((authors (buffer-substring (match-beginning 1) (match-end 1))) + (authors-length (length authors))) + ;; Drop the semi-colon + (replace-match "" t nil nil 2) + (if (<= authors-length notmuch-search-authors-width) + (replace-match (concat authors (make-string + (- notmuch-search-authors-width + authors-length) ? )) t t nil 1) + (replace-match (concat (substring authors 0 (- notmuch-search-authors-width 3)) "...") t t nil 1))))))) (defun notmuch-search-markup-thread-ids () (save-excursion (goto-char (point-min)) (while (not (eobp)) (notmuch-search-markup-this-thread-id) - (next-line)))) + (forward-line)))) -(defun notmuch-search-hide-thread-ids () - (interactive) - (add-to-invisibility-spec 'notmuch-search)) - -(defun notmuch-search-show-thread-ids () +(defun notmuch-search-show-thread () (interactive) - (remove-from-invisibility-spec 'notmuch-search)) + (let ((thread-id (notmuch-search-find-thread-id))) + (if (> (length thread-id) 0) + (notmuch-show thread-id (current-buffer)) + (error "End of search results")))) -(defun notmuch-search-show-thread () +(defun notmuch-search-reply-to-thread () + "Begin composing a reply to the entire current thread in a new buffer." (interactive) - (notmuch-show (notmuch-search-find-thread-id))) + (let ((message-id (notmuch-search-find-thread-id))) + (notmuch-reply message-id))) (defun notmuch-call-notmuch-process (&rest args) + "Synchronously invoke \"notmuch\" with the given list of arguments. + +Output from the process will be presented to the user as an error +and will also appear in a buffer named \"*Notmuch errors*\"." (let ((error-buffer (get-buffer-create "*Notmuch errors*"))) (with-current-buffer error-buffer (erase-buffer)) - (if (eq (apply 'call-process "notmuch" nil error-buffer nil args) 0) + (if (eq (apply 'call-process notmuch-command nil error-buffer nil args) 0) (point) (progn (with-current-buffer error-buffer @@ -413,25 +887,30 @@ Before moving, also remove the \"unread\" tag from the current message." (defun notmuch-search-add-tag (tag) (interactive "sTag to add: ") - (notmuch-call-notmuch-process "tag" (concat "+" tag) (concat "thread:" (notmuch-search-find-thread-id))) + (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) (interactive "sTag to remove: ") - (notmuch-call-notmuch-process "tag" (concat "-" tag) (concat "thread:" (notmuch-search-find-thread-id))) + (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). + +This function advances point to the next line when finished." (interactive) - (notmuch-search-remove-tag "inbox")) + (notmuch-search-remove-tag "inbox") + (forward-line)) -(defun notmuch-search (query) +(defun notmuch-search (query &optional oldest-first) "Run \"notmuch search\" with the given query string and display results." (interactive "sNotmuch search: ") (let ((buffer (get-buffer-create (concat "*notmuch-search-" query "*")))) (switch-to-buffer buffer) (notmuch-search-mode) (set 'notmuch-search-query-string query) + (set 'notmuch-search-oldest-first oldest-first) (let ((proc (get-buffer-process (current-buffer))) (inhibit-read-only t)) (if proc @@ -440,15 +919,12 @@ Before moving, also remove the \"unread\" tag from the current message." (erase-buffer) (goto-char (point-min)) (save-excursion - (call-process "notmuch" nil t nil "search" query) + (if oldest-first + (call-process notmuch-command nil t nil "search" "--sort=oldest-first" query) + (call-process notmuch-command nil t nil "search" "--sort=newest-first" query)) (notmuch-search-markup-thread-ids) - ; A well-behaved program ends its output with a newline, but we - ; don't actually want the blank line at the end of the file. - (goto-char (point-max)) - (if (looking-at "^$") - (delete-backward-char 1) - ) - )))) + )) + (run-hooks 'notmuch-search-hook))) (defun notmuch-search-refresh-view () "Refresh the current view. @@ -460,27 +936,55 @@ thread. Otherwise, point will be moved to attempt to be in the same relative position within the new buffer." (interactive) (let ((here (point)) + (oldest-first notmuch-search-oldest-first) (thread (notmuch-search-find-thread-id)) (query notmuch-search-query-string)) (kill-this-buffer) - (notmuch-search query) + (notmuch-search query oldest-first) (goto-char (point-min)) (if (re-search-forward (concat "^" thread) nil t) (beginning-of-line) (goto-char here)))) +(defun notmuch-search-toggle-order () + "Toggle the current search order. + +By default, the \"inbox\" view created by `notmuch' is displayed +in chronological order (oldest thread at the beginning of the +buffer), while any global searches created by `notmuch-search' +are displayed in reverse-chronological order (newest thread at +the beginning of the buffer). + +This command toggles the sort order for the current search. + +Note that any filtered searches created by +`notmuch-search-filter' retain the search order of the parent +search." + (interactive) + (set 'notmuch-search-oldest-first (not notmuch-search-oldest-first)) + (notmuch-search-refresh-view)) + (defun notmuch-search-filter (query) - "Run \"notmuch search\" to refine the current search results. + "Filter the current search results based on an additional query string. -A search string will be constructed by appending QUERY to the -current search string, and the results of \"notmuch search\" for -the combined query will be displayed." +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 (concat notmuch-search-query-string " and " query) notmuch-search-oldest-first)) + +(defun notmuch-search-filter-by-tag (tag) + "Filter the current search results based on a single tag. + +Runs a new search matching only messages that match both the +current search results AND that are tagged with the given tag." + (interactive "sFilter by tag: ") + (notmuch-search (concat notmuch-search-query-string " and tag:" tag) notmuch-search-oldest-first)) (defun notmuch () "Run notmuch to display all mail with tag of 'inbox'" (interactive) - (notmuch-search "tag:inbox")) + (notmuch-search "tag:inbox" t)) + +(setq mail-user-agent 'message-user-agent) (provide 'notmuch)