;
; Authors: Carl Worth <cworth@cworth.org>
+; 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 "f" 'notmuch-show-forward-current)
(define-key map "m" 'message-mail)
(define-key map "n" 'notmuch-show-next-message)
(define-key map "N" 'notmuch-show-mark-read-then-next-open-message)
(define-key map (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 "s" 'notmuch-search)
(define-key map "v" 'notmuch-show-view-all-mime-parts)
- (define-key map "w" 'notmuch-show-view-raw-message)
+ (define-key map "V" 'notmuch-show-view-raw-message)
+ (define-key map "w" 'notmuch-show-save-attachments)
(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)
+ (define-key map "?" 'notmuch-help)
+ (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 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-depth-regexp " depth:\\([0-9]*\\) ")
-(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))
(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
(interactive)
(view-file (notmuch-show-get-filename)))
+(defmacro with-current-notmuch-show-message (&rest body)
+ "Evaluate body with current buffer set to the text of current message"
+ `(save-excursion
+ (let ((filename (notmuch-show-get-filename)))
+ (let ((buf (generate-new-buffer (concat "*notmuch-msg-" filename "*"))))
+ (with-current-buffer buf
+ (insert-file-contents filename nil nil nil t)
+ ,@body)
+ (kill-buffer buf)))))
+
(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))))
+ (with-current-notmuch-show-message
+ (mm-display-parts (mm-dissect-buffer))))
+
+(defun notmuch-foreach-mime-part (function mm-handle)
+ (cond ((stringp (car mm-handle))
+ (dolist (part (cdr mm-handle))
+ (notmuch-foreach-mime-part function part)))
+ ((bufferp (car mm-handle))
+ (funcall function mm-handle))
+ (t (dolist (part mm-handle)
+ (notmuch-foreach-mime-part function part)))))
+
+(defun notmuch-count-attachments (mm-handle)
+ (let ((count 0))
+ (notmuch-foreach-mime-part
+ (lambda (p)
+ (let ((disposition (mm-handle-disposition p)))
+ (and (listp disposition)
+ (equal (car disposition) "attachment")
+ (incf count))))
+ mm-handle)
+ count))
+
+(defun notmuch-save-attachments (mm-handle &optional queryp)
+ (notmuch-foreach-mime-part
+ (lambda (p)
+ (let ((disposition (mm-handle-disposition p)))
+ (and (listp disposition)
+ (equal (car disposition) "attachment")
+ (or (not queryp)
+ (y-or-n-p
+ (concat "Save '" (cdr (assq 'filename disposition)) "' ")))
+ (mm-save-part p))))
+ mm-handle))
+
+(defun notmuch-show-save-attachments ()
+ "Save the attachments to a message"
+ (interactive)
+ (with-current-notmuch-show-message
+ (let ((mm-handle (mm-dissect-buffer)))
+ (notmuch-save-attachments
+ mm-handle (> (notmuch-count-attachments mm-handle) 1))))
+ (message "Done"))
+
+(defun notmuch-reply (query-string)
+ (switch-to-buffer (generate-new-buffer "notmuch-draft"))
+ (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)))
- (switch-to-buffer (generate-new-buffer "notmuch-draft"))
- (call-process "notmuch" nil t nil "reply" message-id)
- (goto-char (point-min))
- (if (re-search-forward "^$" nil t)
- (progn
- (insert "--text follows this line--")
- (forward-line)))
- (message-mode)))
+ (notmuch-reply message-id)))
+
+(defun notmuch-show-forward-current ()
+ "Forward a the current message."
+ (interactive)
+ (with-current-notmuch-show-message
+ (message-forward)))
(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.
(if last
(notmuch-show-archive-thread))))))
+(defun notmuch-show-next-button ()
+ "Advance point to the next button in the buffer."
+ (interactive)
+ (goto-char (button-start (next-button (point)))))
+
+(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)
(progn
(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 indent
- "[" (number-to-string (count-lines beg-sub (point)))
- "-line citation. Press 'c' to show.]\n")))))
+ (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 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)))))
+ (let ((invis-spec (make-symbol "notmuch-signature-region")))
+ (add-to-invisibility-spec invis-spec)
+ (overlay-put (make-overlay beg-sub end)
+ 'invisible invis-spec)
+
+ (goto-char (- beg-sub 1))
+ (insert (concat "\n" indent))
+ (let ((sig-button-text (concat "[" (number-to-string sig-lines)
+ "-line signature.]")))
+ (insert-button sig-button-text 'invisibility-spec invis-spec
+ :type 'notmuch-button-signature-toggle-type)
+ )
+ (insert "\n")
+ (goto-char end))))))
(forward-line))))
-(defun notmuch-show-markup-part (beg end depth)
+(defun notmuch-show-markup-part (beg end depth mime-message)
(if (re-search-forward notmuch-show-part-begin-regexp nil t)
(progn
+ (if (eq mime-message nil)
+ (let ((filename (notmuch-show-get-filename)))
+ (with-temp-buffer
+ (insert-file-contents filename nil nil nil t)
+ (setq mime-message (mm-dissect-buffer)))))
(forward-line)
- (let ((beg (point-marker)))
+ (let ((part-beg (point-marker)))
(re-search-forward notmuch-show-part-end-regexp)
- (let ((end (copy-marker (match-beginning 0))))
- (goto-char end)
+
+ (let ((part-end (copy-marker (match-beginning 0))))
+ (goto-char part-end)
(if (not (bolp))
(insert "\n"))
- (indent-rigidly beg end depth)
- (notmuch-show-markup-citations-region beg end depth)
+ (indent-rigidly part-beg part-end depth)
+ (save-excursion
+ (goto-char part-beg)
+ (forward-line -1)
+ (beginning-of-line)
+ (let ((handle-type (mm-handle-type mime-message))
+ mime-type)
+ (if (sequencep (car handle-type))
+ (setq mime-type (car handle-type))
+ (setq mime-type (car (car (cdr handle-type))))
+ )
+ (if (equal mime-type "text/html")
+ (mm-display-part mime-message))))
+
+ (notmuch-show-markup-citations-region part-beg part-end depth)
; Advance to the next part (if any) (so the outer loop can
; determine whether we've left the current message.
(if (re-search-forward notmuch-show-part-begin-regexp nil t)
(beginning-of-line)))))
- (goto-char end)))
+ (goto-char end))
+ mime-message)
(defun notmuch-show-markup-parts-region (beg end depth)
(save-excursion
(goto-char beg)
- (while (< (point) end)
- (notmuch-show-markup-part beg end depth))))
+ (let (mime-message)
+ (while (< (point) end)
+ (setq mime-message
+ (notmuch-show-markup-part
+ beg end depth mime-message))))))
-(defun notmuch-show-markup-body (depth)
+(defun notmuch-show-markup-body (depth btn)
(re-search-forward notmuch-show-body-begin-regexp)
(forward-line)
(let ((beg (point-marker)))
(re-search-forward notmuch-show-body-end-regexp)
(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))
+ (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-fontify-headers ()
+ (progn
+ (if (looking-at "[Tt]o:")
+ (progn
+ (overlay-put (make-overlay (point) (re-search-forward ":"))
+ 'face 'message-header-name)
+ (overlay-put (make-overlay (point) (re-search-forward ".*$"))
+ 'face 'message-header-to))
+ (if (looking-at "[B]?[Cc][Cc]:")
+ (progn
+ (overlay-put (make-overlay (point) (re-search-forward ":"))
+ 'face 'message-header-name)
+ (overlay-put (make-overlay (point) (re-search-forward ".*$"))
+ 'face 'message-header-cc))
+ (if (looking-at "[Ss]ubject:")
+ (progn
+ (overlay-put (make-overlay (point) (re-search-forward ":"))
+ 'face 'message-header-name)
+ (overlay-put (make-overlay (point) (re-search-forward ".*$"))
+ 'face 'message-header-subject))
+ (if (looking-at "[Ff]rom:")
+ (progn
+ (overlay-put (make-overlay (point) (re-search-forward ":"))
+ 'face 'message-header-name)
+ (overlay-put (make-overlay (point) (re-search-forward ".*$"))
+ 'face 'message-header-other))))))))
(defun notmuch-show-markup-header (depth)
(re-search-forward notmuch-show-header-begin-regexp)
(forward-line)
- (let ((beg (point-marker)))
+ (let ((beg (point-marker))
+ (btn nil))
(end-of-line)
; Inverse video for subject
- (overlay-put (make-overlay beg (point)) 'face '((cons :inverse-video t)))
- (forward-line 2)
+ (overlay-put (make-overlay beg (point)) 'face '(:inverse-video t))
+ (setq btn (make-button beg (point) :type 'notmuch-button-body-toggle-type))
+ (forward-line 1)
+ (end-of-line)
(let ((beg-hidden (point-marker)))
(re-search-forward notmuch-show-header-end-regexp)
(beginning-of-line)
(let ((end (point-marker)))
+ (goto-char beg)
+ (forward-line)
+ (while (looking-at "[A-Za-z][-A-Za-z0-9]*:")
+ (beginning-of-line)
+ (notmuch-fontify-headers)
+ (forward-line)
+ )
(indent-rigidly beg end depth)
- (overlay-put (make-overlay beg-hidden end)
- 'invisible 'notmuch-show-header)
+ (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
(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)))
+ (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"
+(defun notmuch-documentation-first-line (symbol)
+ "Return the first line of the documentation string for SYMBOL."
+ (let ((doc (documentation symbol)))
+ (if doc
+ (with-temp-buffer
+ (insert (documentation symbol))
+ (goto-char (point-min))
+ (let ((beg (point)))
+ (end-of-line)
+ (buffer-substring beg (point))))
+ "")))
+
+(defun notmuch-substitute-one-command-key (binding)
+ "For a key binding, return a string showing a human-readable representation
+of the key as well as the first line of documentation from the bound function.
+
+For a mouse binding, return nil."
+ (let ((key (car binding)))
+ (if (mouse-event-p key)
+ nil
+ (concat (format-kbd-macro (vector key))
+ "\t"
+ (notmuch-documentation-first-line (cdr binding))))))
+
+(defun notmuch-substitute-command-keys (doc)
+ "Like `substitute-command-keys' but with documentation, not function names."
+ (let ((beg 0))
+ (while (string-match "\\\\{\\([^}[:space:]]*\\)}" doc beg)
+ (let ((map (substring doc (match-beginning 1) (match-end 1))))
+ (setq doc (replace-match (mapconcat 'notmuch-substitute-one-command-key
+ (cdr (symbol-value (intern map))) "\n") 1 1 doc)))
+ (setq beg (match-end 0)))
+ doc))
+
+(defun notmuch-help ()
+ "Display help for the current notmuch mode."
(interactive)
- (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))
+ (let ((mode major-mode))
+ (with-help-window (help-buffer)
+ (princ (notmuch-substitute-command-keys (documentation mode t))))))
;;;###autoload
(defun notmuch-show-mode ()
\\{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)
: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 ()
(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)
(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)))
+ ))
+ (goto-char (point-min))
+ ))))
)))
(defvar notmuch-search-authors-width 40
(defvar notmuch-search-mode-map
(let ((map (make-sparse-keymap)))
- (define-key map "a" 'notmuch-search-archive-thread)
- (define-key map "b" 'notmuch-search-scroll-down)
- (define-key map "f" 'notmuch-search-filter)
- (define-key map "m" 'message-mail)
- (define-key map "n" 'next-line)
- (define-key map "o" 'notmuch-search-toggle-order)
- (define-key map "p" 'previous-line)
+ (define-key map "?" 'notmuch-help)
(define-key map "q" 'kill-this-buffer)
- (define-key map "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 "+" 'notmuch-search-add-tag)
- (define-key map "-" 'notmuch-search-remove-tag)
+ (define-key map (kbd "<DEL>") 'notmuch-search-scroll-down)
+ (define-key map "b" 'notmuch-search-scroll-down)
+ (define-key map " " 'notmuch-search-scroll-up)
(define-key map "<" 'beginning-of-buffer)
(define-key map ">" 'notmuch-search-goto-last-thread)
+ (define-key map "p" 'previous-line)
+ (define-key map "n" 'next-line)
+ (define-key map "r" 'notmuch-search-reply-to-thread)
+ (define-key map "m" 'message-mail)
+ (define-key map "s" 'notmuch-search)
+ (define-key map "o" 'notmuch-search-toggle-order)
(define-key map "=" 'notmuch-search-refresh-view)
- (define-key map "\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)
+ (define-key map "t" 'notmuch-search-filter-by-tag)
+ (define-key map "f" 'notmuch-search-filter)
+ (define-key map [mouse-1] 'notmuch-search-show-thread)
+ (define-key map "*" 'notmuch-search-operate-all)
+ (define-key map "a" 'notmuch-search-archive-thread)
+ (define-key map "-" 'notmuch-search-remove-tag)
+ (define-key map "+" 'notmuch-search-add-tag)
+ (define-key map (kbd "RET") 'notmuch-search-show-thread)
map)
"Keymap for \"notmuch search\" buffers.")
(fset 'notmuch-search-mode-map notmuch-search-mode-map)
+(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))
+(defface notmuch-tag-face
+ '((((class color)
+ (background dark))
+ (:foreground "OliveDrab1"))
+ (((class color)
+ (background light))
+ (:foreground "navy blue" :bold t))
+ (t
+ (:bold t)))
+ "Notmuch search mode face used to highligh tags."
+ :group 'notmuch)
+
+(defvar notmuch-tag-face-alist nil
+ "List containing the tag list that need to be highlighed")
+
+(defvar notmuch-search-font-lock-keywords nil)
+
;;;###autoload
(defun notmuch-search-mode ()
- "Major mode for searching mail with notmuch.
+ "Major mode displaying results of a notmuch search.
This buffer contains the results of a \"notmuch search\" of your
email archives. Each line in the buffer represents a single
-thread giving a relative date for the thread and a subject.
+thread giving a summary of the thread (a relative date, the
+number of matched messages and total messages in the thread,
+participants in the thread, a representative subject line, and
+any tags).
-Pressing RET on any line displays that thread. The '+' and '-'
-keys can be used to add or remove tags from a thread. The 'a' key
-is a convenience key for archiving a thread (removing the
-\"inbox\" tag).
+By default, 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). The '*' key can be used to
+add or remove a tag from all threads in the current buffer.
-Other useful commands are `notmuch-search-filter' for filtering
-the current search based on an additional query string,
-`notmuch-search-filter-by-tag' for filtering to include only
-messages with a given tag, and `notmuch-search' to execute a new,
-global search.
+Other useful commands are 'f' for filtering the current search
+based on an additional query string, 't' for filtering to include
+only messages with a given tag, and 's' to execute a new, global
+search.
+
+Complete list of currently available key bindings:
\\{notmuch-search-mode-map}"
(interactive)
(setq truncate-lines t)
(setq major-mode 'notmuch-search-mode
mode-name "notmuch-search")
- (setq buffer-read-only t))
+ (setq buffer-read-only t)
+ (if (not notmuch-tag-face-alist)
+ (add-to-list 'notmuch-search-font-lock-keywords (list
+ "(\\([^)]*\\))$" '(1 'notmuch-tag-face)))
+ (progn
+ (setq notmuch-search-tags (mapcar 'car notmuch-tag-face-alist))
+ (loop for notmuch-search-tag in notmuch-search-tags
+ do (add-to-list 'notmuch-search-font-lock-keywords (list
+ (concat "([^)]*\\(" notmuch-search-tag "\\)[^)]*)$")
+ `(1 ,(cdr (assoc notmuch-search-tag notmuch-tag-face-alist))))))))
+ (set (make-local-variable 'font-lock-defaults)
+ '(notmuch-search-font-lock-keywords t)))
(defun notmuch-search-find-thread-id ()
- (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)
- (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)
- (forward-line))))
+ "Return the thread for the current thread"
+ (get-text-property (point) 'notmuch-search-thread-id))
(defun notmuch-search-show-thread ()
+ "Display the currently selected thread."
(interactive)
(let ((thread-id (notmuch-search-find-thread-id)))
(if (> (length thread-id) 0)
(notmuch-show thread-id (current-buffer))
(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) (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) (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-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 "^[-+][-+_.[:word:]]+$" (car words))
+ (error "Action must be of the form `+thistag -that_tag'"))
+ (setq words (cdr words))))
+ (apply 'notmuch-call-notmuch-process "tag"
+ (append action-split (list notmuch-search-query-string) nil))))
+
+;;;###autoload
(defun notmuch-search (query &optional oldest-first)
"Run \"notmuch search\" with the given query string and display results."
(interactive "sNotmuch search: ")
(erase-buffer)
(goto-char (point-min))
(save-excursion
- (if oldest-first
- (call-process "notmuch" nil t nil "search" "--sort=oldest-first" query)
- (call-process "notmuch" nil t nil "search" "--sort=newest-first" 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.
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: ")
+ (interactive
+ (list (notmuch-select-tag-with-completion "Filter by tag: ")))
(notmuch-search (concat notmuch-search-query-string " and tag:" tag) notmuch-search-oldest-first))
+
+;;;###autoload
(defun notmuch ()
"Run notmuch to display all mail with tag of 'inbox'"
(interactive)
- (notmuch-search "tag:inbox" t))
+ (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 "?" 'notmuch-help)
+ (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))))
+
+;;;###autoload
+(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