;
; Authors: Carl Worth <cworth@cworth.org>
-(load "cl-seq")
+; This is an emacs-based interface to the notmuch mail system.
+;
+; You will first need to have the notmuch program installed and have a
+; notmuch database built in order to use this. See
+; http://notmuchmail.org for details.
+;
+; To install this software, copy it to a directory that is on the
+; `load-path' variable within emacs (a good candidate is
+; /usr/local/share/emacs/site-lisp). If you are viewing this from the
+; notmuch source distribution then you can simply run:
+;
+; sudo make install-emacs
+;
+; to install it.
+;
+; Then, to actually run it, add:
+;
+; (require 'notmuch)
+;
+; to your ~/.emacs file, and then run "M-x notmuch" from within emacs,
+; or run:
+;
+; emacs -f notmuch
+;
+; Have fun, and let us know if you have any comment, questions, or
+; kudos: Notmuch list <notmuch@notmuchmail.org> (subscription is not
+; required, but is available from http://notmuchmail.org).
+
+(require 'cl)
+(require 'mm-view)
+(require 'message)
(defvar notmuch-show-mode-map
(let ((map (make-sparse-keymap)))
; 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 "s" 'notmuch-show-toggle-signatures-visible)
+ (define-key map "r" 'notmuch-show-reply)
+ (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 (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)
map)
"Keymap for \"notmuch show\" buffers.")
(fset 'notmuch-show-mode-map notmuch-show-mode-map)
-(defvar notmuch-show-signature-lines-max 6
+(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.")
-(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-filename-regexp "filename:\\(.*\\)$")
-(set 'notmuch-show-tags-regexp "(\\([^)]*\\))$")
+(defvar notmuch-command "notmuch"
+ "Command to run the notmuch binary.")
+
+(defvar notmuch-show-message-begin-regexp "\fmessage{")
+(defvar notmuch-show-message-end-regexp "\fmessage}")
+(defvar notmuch-show-header-begin-regexp "\fheader{")
+(defvar notmuch-show-header-end-regexp "\fheader}")
+(defvar notmuch-show-body-begin-regexp "\fbody{")
+(defvar notmuch-show-body-end-regexp "\fbody}")
+(defvar notmuch-show-attachment-begin-regexp "\fattachment{")
+(defvar notmuch-show-attachment-end-regexp "\fattachment}")
+(defvar notmuch-show-part-begin-regexp "\fpart{")
+(defvar notmuch-show-part-end-regexp "\fpart}")
+(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-filename-regexp "filename:\\(.*\\)$")
+(defvar notmuch-show-tags-regexp "(\\([^)]*\\))$")
+
+(defvar notmuch-show-parent-buffer nil)
+(defvar notmuch-show-body-read-visible nil)
+(defvar notmuch-show-citations-visible nil)
+(defvar notmuch-show-signatures-visible nil)
+(defvar notmuch-show-headers-visible nil)
; XXX: This should be a generic function in emacs somewhere, not here
(defun point-invisible-p ()
(or (memq prop buffer-invisibility-spec)
(assq prop buffer-invisibility-spec)))))
+(defun notmuch-select-tag-with-completion (prompt &rest search-terms)
+ (let ((tag-list
+ (with-output-to-string
+ (with-current-buffer standard-output
+ (apply 'call-process notmuch-command nil t nil "search-tags" search-terms)))))
+ (completing-read prompt (split-string tag-list "\n+" t) nil nil nil)))
+
(defun notmuch-show-next-line ()
"Like builtin `next-line' but ensuring we end on a visible character.
(if (not (looking-at notmuch-show-message-begin-regexp))
(re-search-backward notmuch-show-message-begin-regexp))
(re-search-forward notmuch-show-id-regexp)
- (buffer-substring (match-beginning 1) (match-end 1))))
+ (buffer-substring-no-properties (match-beginning 1) (match-end 1))))
(defun notmuch-show-get-filename ()
(save-excursion
(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))))
+ (buffer-substring-no-properties (match-beginning 1) (match-end 1))))
(defun notmuch-show-set-tags (tags)
(save-excursion
(defun notmuch-show-add-tag (&rest toadd)
"Add a tag to the current message."
- (interactive "sTag to add: ")
+ (interactive
+ (list (notmuch-select-tag-with-completion "Tag to add: ")))
(apply 'notmuch-call-notmuch-process
(append (cons "tag"
(mapcar (lambda (s) (concat "+" s)) toadd))
- (cons (concat "id:" (notmuch-show-get-message-id)) nil)))
+ (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: ")
+ (interactive
+ (list (notmuch-select-tag-with-completion "Tag to remove: " (notmuch-show-get-message-id))))
(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)))
+ (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)
(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\"
+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.
(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\"
+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.
(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)
+ (message-insert-signature)
+ (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.
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)))))
+ (apply 'start-process-shell-command "notmuch-pipe-command" "*notmuch-pipe*"
+ (list command " < " (shell-quote-argument (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.
(notmuch-show-next-message)))
(defun notmuch-show-next-open-message ()
- "Advance to the the next message which is not hidden.
+ "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 last
(notmuch-show-archive-thread))))))
-(defun notmuch-show-markup-citations-region (beg end)
+(defun notmuch-show-next-button ()
+ "Advance point to the next button in the buffer."
+ (interactive)
+ (goto-char (button-start (next-button (point)))))
+
+(defun notmuch-show-previous-button ()
+ "Move point back to the previous button in the buffer."
+ (interactive)
+ (goto-char (button-start (previous-button (point)))))
+
+(defun notmuch-toggle-invisible-action (cite-button)
+ (let ((invis-spec (button-get button 'invisibility-spec)))
+ (if (invisible-p invis-spec)
+ (remove-from-invisibility-spec invis-spec)
+ (add-to-invisibility-spec invis-spec)
+ ))
+ (force-window-update)
+ (redisplay t))
+
+(define-button-type 'notmuch-button-invisibility-toggle-type 'action 'notmuch-toggle-invisible-action 'follow-link t)
+(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"
+ :supertype 'notmuch-button-invisibility-toggle-type)
+
+(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 ">")
+ (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)))
- "-line citation. Press 'c' to show.]\n")))))
- (if (looking-at "--[ ]?$")
- (let ((sig-lines (count-lines beg-sub end)))
+ (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
- (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)))))
+ (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-body ()
+(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 btn)
(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)
- (let ((end (match-beginning 0)))
- (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)))))
+ (let ((end (copy-marker (match-beginning 0))))
+ (notmuch-show-markup-parts-region beg end depth)
+ (let ((invis-spec (make-symbol "notmuch-show-body-read")))
+ (overlay-put (make-overlay beg end)
+ 'invisible invis-spec)
+ (button-put btn 'invisibility-spec invis-spec)
+ (if (not (notmuch-show-message-unread-p))
+ (add-to-invisibility-spec invis-spec)))
+ (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)
- (forward-line 1)
- (beginning-of-line)
- (let ((beg (point)))
+ (forward-line)
+ (let ((beg (point-marker))
+ (btn nil))
(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)))
+ (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)
+ (overlay-put (make-overlay (point) (re-search-forward ":"))
+ 'face 'bold)
+ (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))
(defun notmuch-show-markup-message ()
(if (re-search-forward notmuch-show-message-begin-regexp nil t)
(progn
- (notmuch-show-markup-header)
- (notmuch-show-markup-body))
+ (re-search-forward notmuch-show-depth-regexp)
+ (let ((depth (string-to-number (buffer-substring (match-beginning 1) (match-end 1))))
+ (btn nil))
+ (setq btn (notmuch-show-markup-header depth))
+ (notmuch-show-markup-body depth btn)))
(goto-char (point-max))))
(defun notmuch-show-hide-markers ()
(notmuch-show-markup-message)))
(notmuch-show-hide-markers))
-(defun notmuch-show-toggle-citations-visible ()
- "Toggle visibility of citations"
- (interactive)
- (if notmuch-show-citations-visible
- (add-to-invisibility-spec 'notmuch-show-citation)
- (remove-from-invisibility-spec 'notmuch-show-citation))
- (set 'notmuch-show-citations-visible (not notmuch-show-citations-visible))
- ; Need to force the redisplay for some reason
- (force-window-update)
- (redisplay t))
-
-(defun notmuch-show-toggle-signatures-visible ()
- "Toggle visibility of signatures"
- (interactive)
- (if notmuch-show-signatures-visible
- (add-to-invisibility-spec 'notmuch-show-signature)
- (remove-from-invisibility-spec 'notmuch-show-signature))
- (set 'notmuch-show-signatures-visible (not notmuch-show-signatures-visible))
- ; Need to force the redisplay for some reason
- (force-window-update)
- (redisplay t))
-
-(defun notmuch-show-toggle-headers-visible ()
- "Toggle visibility of header fields"
- (interactive)
- (if notmuch-show-headers-visible
- (add-to-invisibility-spec 'notmuch-show-header)
- (remove-from-invisibility-spec 'notmuch-show-header))
- (set 'notmuch-show-headers-visible (not notmuch-show-headers-visible))
- ; Need to force the redisplay for some reason
- (force-window-update)
- (redisplay t))
-
-(defun notmuch-show-toggle-body-read-visible ()
- "Toggle visibility of message bodies of read messages"
- (interactive)
- (if notmuch-show-body-read-visible
- (add-to-invisibility-spec 'notmuch-show-body-read)
- (remove-from-invisibility-spec 'notmuch-show-body-read))
- (set 'notmuch-show-body-read-visible (not notmuch-show-body-read-visible))
- ; Need to force the redisplay for some reason
- (force-window-update)
- (redisplay t))
-
;;;###autoload
(defun notmuch-show-mode ()
"Major mode for viewing a thread with notmuch.
\\{notmuch-show-mode-map}"
(interactive)
(kill-all-local-variables)
- (set (make-local-variable 'notmuch-show-headers-visible) t)
- (notmuch-show-toggle-headers-visible)
- (set (make-local-variable 'notmuch-show-body-read-visible) t)
- (notmuch-show-toggle-body-read-visible)
- (set (make-local-variable 'notmuch-show-citations-visible) t)
- (notmuch-show-toggle-citations-visible)
- (set (make-local-variable 'notmuch-show-signatures-visible) t)
- (notmuch-show-toggle-signatures-visible)
(add-to-invisibility-spec 'notmuch-show-marker)
(use-local-map notmuch-show-mode-map)
(setq major-mode 'notmuch-show-mode
mode-name "notmuch-show")
(setq buffer-read-only t))
+;;;###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.
(let ((proc (get-buffer-process (current-buffer)))
(inhibit-read-only t))
(if proc
- (error "notmuch search process already running for query `%s'" query)
+ (error "notmuch search process already running for query `%s'" thread-id)
)
(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
(if (not (notmuch-show-message-unread-p))
(progn
(goto-char (point-min))
- (notmuch-show-toggle-body-read-visible)))))
+ (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)
+ ))))
)))
+(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 (kbd "RET") 'notmuch-search-show-thread)
+ (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 "<DEL>") 'notmuch-search-scroll-down)
+ (define-key map "?" 'describe-mode)
map)
"Keymap for \"notmuch search\" buffers.")
(fset 'notmuch-search-mode-map notmuch-search-mode-map)
+(defvar notmuch-search-query-string)
+(defvar notmuch-search-oldest-first t
+ "Show the oldest mail first in the search-mode")
+
+
(defun notmuch-search-scroll-up ()
"Scroll up, moving point to last message in thread if at end."
(interactive)
(goto-char (window-start))
(scroll-down nil)))
-(defun notmuch-search-goto-last-thread (&optional arg)
+(defun notmuch-search-goto-last-thread ()
"Move point to the last thread in the buffer."
- (interactive "^P")
- (end-of-buffer arg)
+ (interactive)
+ (goto-char (point-max))
(forward-line -1))
;;;###autoload
(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))
(defun notmuch-search-find-thread-id ()
- (save-excursion
- (beginning-of-line)
- (let ((beg (point)))
- (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)))
- (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
- (goto-char (point-min))
- (while (not (eobp))
- (notmuch-search-markup-this-thread-id)
- (next-line))))
-
-(defun notmuch-search-hide-thread-ids ()
- (interactive)
- (add-to-invisibility-spec 'notmuch-search)
- (force-window-update)
- (redisplay t))
-
-(defun notmuch-search-show-thread-ids ()
- (interactive)
- (remove-from-invisibility-spec 'notmuch-search)
- (force-window-update)
- (redisplay t))
+ "Return the thread for the current thread"
+ (get-text-property (point) 'notmuch-search-thread-id))
(defun notmuch-search-show-thread ()
(interactive)
(let ((thread-id (notmuch-search-find-thread-id)))
- (forward-line)
(if (> (length thread-id) 0)
(notmuch-show thread-id (current-buffer))
(error "End of search results"))))
+(defun notmuch-search-reply-to-thread ()
+ "Begin composing a reply to the entire current thread in a new buffer."
+ (interactive)
+ (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.
(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
(split-string (buffer-substring beg end))))))
(defun notmuch-search-add-tag (tag)
- (interactive "sTag to add: ")
- (notmuch-call-notmuch-process "tag" (concat "+" tag) (concat "thread:" (notmuch-search-find-thread-id)))
+ "Add a tag to messages in the current thread matching the
+active query."
+ (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-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)))
+ "Remove a tag from messages in the current thread matching the
+active query."
+ (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-search-set-tags (delete tag (notmuch-search-get-tags))))
(defun notmuch-search-archive-thread ()
(notmuch-search-remove-tag "inbox")
(forward-line))
-(defun notmuch-search (query)
+(defun notmuch-search-process-sentinel (proc msg)
+ "Add a message to let user know when \"notmuch search\" exits"
+ (let ((buffer (process-buffer proc))
+ (status (process-status proc))
+ (exit-status (process-exit-status proc)))
+ (if (memq status '(exit signal))
+ (if (buffer-live-p buffer)
+ (with-current-buffer buffer
+ (save-excursion
+ (let ((inhibit-read-only t))
+ (goto-char (point-max))
+ (if (eq status 'signal)
+ (insert "Incomplete search results (search process was killed).\n"))
+ (if (eq status 'exit)
+ (progn
+ (insert "End of search results.")
+ (if (not (= exit-status 0))
+ (insert (format " (process returned %d)" exit-status)))
+ (insert "\n"))))))))))
+
+(defun notmuch-search-process-filter (proc string)
+ "Process and filter the output of \"notmuch search\""
+ (let ((buffer (process-buffer proc)))
+ (if (buffer-live-p buffer)
+ (with-current-buffer buffer
+ (save-excursion
+ (let ((line 0)
+ (more t)
+ (inhibit-read-only t))
+ (while more
+ (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))
+ (authors (match-string 4 string))
+ (authors-length (length authors))
+ (subject (match-string 5 string))
+ (tags (match-string 6 string)))
+ (if (> authors-length 40)
+ (set 'authors (concat (substring authors 0 (- 40 3)) "...")))
+ (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))
+ (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
+
+ +tagname Add the tag `tagname'
+ -tagname Remove the tag `tagname'
+
+Each character of the tag name may consist of alphanumeric
+characters as well as `_.+-'.
+"
+ (interactive "sOperation (+add -drop): notmuch tag ")
+ (let ((action-split (split-string action " +")))
+ ;; Perform some validation
+ (let ((words action-split))
+ (when (null words) (error "No operation given"))
+ (while words
+ (unless (string-match-p "^[\+\-][_\+\-\\w]+$" (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))))
+
+(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
(erase-buffer)
(goto-char (point-min))
(save-excursion
- (call-process "notmuch" nil t nil "search" query)
- (notmuch-search-markup-thread-ids)
- ))))
+ (let ((proc (start-process-shell-command
+ "notmuch-search" buffer notmuch-command "search"
+ (if oldest-first "--sort=oldest-first" "--sort=newest-first")
+ (shell-quote-argument query))))
+ (set-process-sentinel proc 'notmuch-search-process-sentinel)
+ (set-process-filter proc 'notmuch-search-process-filter))))
+ (run-hooks 'notmuch-search-hook)))
(defun notmuch-search-refresh-view ()
"Refresh the current view.
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)
"Filter the current search results based on an additional query string.
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)))
+ (interactive
+ (list (notmuch-select-tag-with-completion "Filter 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" notmuch-search-oldest-first))
+
+(setq mail-user-agent 'message-user-agent)
+
+(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 "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 "=" 'notmuch-folder)
+ (define-key map "?" 'describe-mode)
+ (define-key map [mouse-1] 'notmuch-folder-show-search)
+ map)
+ "Keymap for \"notmuch folder\" buffers.")
+
+(fset 'notmuch-folder-mode-map notmuch-folder-mode-map)
+
+(defcustom notmuch-folders (quote (("inbox" . "tag:inbox") ("unread" . "tag:unread")))
+ "List of searches for the notmuch folder view"
+ :type '(alist :key-type (string) :value-type (string))
+ :group 'notmuch)
+
+(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.
+
+Pressing RET on any line opens a search window containing the
+results for the search terms in that line.
+
+\\{notmuch-folder-mode-map}"
+ (interactive)
+ (kill-all-local-variables)
+ (use-local-map 'notmuch-folder-mode-map)
+ (setq truncate-lines t)
+ (hl-line-mode 1)
+ (setq major-mode 'notmuch-folder-mode
+ mode-name "notmuch-folder")
+ (setq buffer-read-only t))
+
+(defun notmuch-folder-add (folders)
+ (if 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)
+ (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)))))
+
+(defun notmuch-folder-show-search (&optional folder)
+ "Show a search window for the search related to the specified folder."
+ (interactive)
+ (if (null folder)
+ (setq folder (notmuch-folder-find-name)))
+ (let ((search (assoc folder notmuch-folders)))
+ (if search
+ (notmuch-search (cdr search) notmuch-search-oldest-first))))
+
+(defun notmuch-folder ()
+ "Show the notmuch folder view and update the displayed counts."
+ (interactive)
+ (let ((buffer (get-buffer-create "*notmuch-folders*")))
+ (switch-to-buffer buffer)
+ (let ((inhibit-read-only t)
+ (n (line-number-at-pos)))
+ (erase-buffer)
+ (notmuch-folder-mode)
+ (notmuch-folder-add notmuch-folders)
+ (goto-char (point-min))
+ (goto-line n))))
(provide 'notmuch)
projects / notmuch / blobdiff