X-Git-Url: https://git.notmuchmail.org/git?p=notmuch;a=blobdiff_plain;f=notmuch.el;h=c8639be529207fc85420e25be527712b590a1348;hp=5f394cdd39584b34474160fbf1e4e44a2f5ad570;hb=3cdb24d38aaa4cf043526a946e0a4ae290a6881d;hpb=446459a5eab3d5a085950a25476079d5188c7528 diff --git a/notmuch.el b/notmuch.el index 5f394cdd..c8639be5 100644 --- a/notmuch.el +++ b/notmuch.el @@ -19,6 +19,8 @@ ; ; Authors: Carl Worth +(load "cl-seq") + (defvar notmuch-show-mode-map (let ((map (make-sparse-keymap))) ; I don't actually want all of these toggle commands occupying @@ -29,34 +31,84 @@ ; 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 "n" 'notmuch-show-mark-read-then-next-message) + (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 "s" 'notmuch-show-toggle-signatures-visible) + (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) 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-lines-max 6 + "Maximum length of signature that will be hidden by default.") + +(set 'notmuch-show-message-begin-regexp " message{") +(set 'notmuch-show-message-end-regexp " message}") +(set 'notmuch-show-header-begin-regexp " header{") +(set 'notmuch-show-header-end-regexp " header}") +(set 'notmuch-show-body-begin-regexp " body{") +(set 'notmuch-show-body-end-regexp " body}") +(set 'notmuch-show-attachment-begin-regexp " attachment{") +(set 'notmuch-show-attachment-end-regexp " attachment}") +(set 'notmuch-show-part-begin-regexp " part{") +(set 'notmuch-show-part-end-regexp " part}") +(set 'notmuch-show-marker-regexp " \\(message\\|header\\|body\\|attachment\\|part\\)[{}].*$") + +(set 'notmuch-show-id-regexp "id:\\([^ ]*\\)") +(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 @@ -66,6 +118,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) @@ -87,32 +147,88 @@ (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 (concat "id:" (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)))) - -(defun notmuch-show-archive-thread () - "Archive each message currrently shown by removing the \"inbox\" tag from each. + (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 (concat "id:" (notmuch-show-get-message-id)) nil))) + (notmuch-show-set-tags (sort (set-difference tags toremove :test 'string=) 'string<)))))) -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) +(defun notmuch-show-archive-thread-maybe-mark-read (markread) (save-excursion (goto-char (point-min)) (while (not (eobp)) - (notmuch-show-remove-tag "inbox") + (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)))))) + (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 currrently 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-archive-thread () + "Archive each message in thread, and show next thread from search. + +Archive each message currrently 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)) + +(defun notmuch-show-view-raw-message () + "View the raw email of the current message." + (interactive) + (view-file (notmuch-show-get-filename))) + +(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. @@ -133,17 +249,66 @@ by searching backward)." (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 beginning of the current message if already on the -last 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) - (re-search-forward notmuch-show-message-begin-regexp nil t) - (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 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 () "Backup to the beginning of the previous message in the buffer. @@ -161,12 +326,75 @@ simply move to the beginning of the current message." )) (recenter 0))) -(defun notmuch-show-mark-read-then-next-message () - "Remove uread tag from current message, then advance to next message." +(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) - (if (member "unread" (notmuch-show-get-tags)) - (notmuch-show-remove-tag "unread")) - (notmuch-show-next-message)) + (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'. + +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) (goto-char beg) @@ -176,20 +404,24 @@ simply move to the beginning of the current message." (if (looking-at ">") (progn (while (looking-at ">") - (next-line)) + (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.]"))))) + "-line citation. Press 'c' to show.]\n"))))) (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)))) + (let ((sig-lines (count-lines beg-sub end))) + (if (<= sig-lines notmuch-show-signature-lines-max) + (progn + (overlay-put (make-overlay beg-sub (+ beg-sub 1)) + 'before-string + (concat "[" (number-to-string sig-lines) + "-line signature. Press 's' to show.]")) + (overlay-put (make-overlay (+ beg-sub 2) end) + 'invisible 'notmuch-show-signature) + (goto-char end))))) + (forward-line)))) (defun notmuch-show-markup-body () (re-search-forward notmuch-show-body-begin-regexp) @@ -198,16 +430,22 @@ simply move to the beginning of the current message." (let ((beg (point))) (re-search-forward notmuch-show-body-end-regexp) (let ((end (match-beginning 0))) - (if (not (member "unread" (notmuch-show-get-tags))) + (notmuch-show-markup-citations-region beg end) + (if (not (notmuch-show-message-unread-p)) (overlay-put (make-overlay beg end) - 'invisible 'notmuch-show-body-read)) - (notmuch-show-markup-citations-region beg end)))) + 'invisible 'notmuch-show-body-read))))) (defun notmuch-show-markup-header () (re-search-forward notmuch-show-header-begin-regexp) - (next-line 2) + (forward-line 1) (beginning-of-line) (let ((beg (point))) + (end-of-line) + ; Inverse video for subject + (overlay-put (make-overlay beg (point)) 'face '((cons :inverse-video t))) + (beginning-of-line) + (forward-line 2) + (set 'beg (point)) (re-search-forward notmuch-show-header-end-regexp) (overlay-put (make-overlay beg (match-beginning 0)) 'invisible 'notmuch-show-header))) @@ -322,12 +560,17 @@ view, (remove the \"inbox\" tag from each), with 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." +(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 @@ -339,12 +582,23 @@ view, (remove the \"inbox\" tag from each), with (call-process "notmuch" nil t nil "show" thread-id) (notmuch-show-markup-messages) ) + ; 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-mode-map (let ((map (make-sparse-keymap))) (define-key map "a" 'notmuch-search-archive-thread) - (define-key map "b" 'scroll-down) + (define-key map "b" 'notmuch-search-scroll-down) (define-key map "f" 'notmuch-search-filter) (define-key map "n" 'next-line) (define-key map "p" 'previous-line) @@ -352,24 +606,46 @@ view, (remove the \"inbox\" tag from each), with (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 " " 'scroll-up) - (define-key map (kbd "") 'scroll-down) + (define-key map " " 'notmuch-search-scroll-up) + (define-key map (kbd "") 'notmuch-search-scroll-down) 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 () @@ -405,15 +681,16 @@ global search. (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))))) (defun notmuch-search-markup-thread-ids () (save-excursion @@ -436,9 +713,16 @@ global search. (defun notmuch-search-show-thread () (interactive) - (notmuch-show (notmuch-search-find-thread-id))) + (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-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)) @@ -475,12 +759,12 @@ global search. (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 () @@ -489,7 +773,7 @@ global search. This function advances point to the next line when finished." (interactive) (notmuch-search-remove-tag "inbox") - (next-line)) + (forward-line)) (defun notmuch-search (query) "Run \"notmuch search\" with the given query string and display results." @@ -508,12 +792,6 @@ This function advances point to the next line when finished." (save-excursion (call-process "notmuch" nil t nil "search" 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) - ) )))) (defun notmuch-search-refresh-view ()