(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 "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-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)
(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
(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"))
(let ((message-id (notmuch-show-get-message-id)))
(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.
(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 btn)
(re-search-forward notmuch-show-body-begin-regexp)
(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)
(while (looking-at "[A-Za-z][-A-Za-z0-9]*:")
(beginning-of-line)
- (overlay-put (make-overlay (point) (re-search-forward ":"))
- 'face 'bold)
+ (notmuch-fontify-headers)
(forward-line)
)
(indent-rigidly beg end depth)
(notmuch-show-markup-message)))
(notmuch-show-hide-markers))
+(defun notmuch-documentation-first-line (symbol)
+ "Return the first line of the documentation string for SYMBOL."
+ (let ((doc (documentation symbol)))
+ (if doc
+ (with-temp-buffer
+ (insert (documentation symbol))
+ (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."
+ (concat (format-kbd-macro (vector (car binding)))
+ "\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)
+ (let ((mode major-mode))
+ (with-help-window (help-buffer)
+ (princ (notmuch-substitute-command-keys (documentation mode t))))))
+
;;;###autoload
(defun notmuch-show-mode ()
"Major mode for viewing a thread with notmuch.
mode-name "notmuch-show")
(setq buffer-read-only t))
-;;;###autoload
-
(defgroup notmuch nil
"Notmuch mail reader for Emacs."
:group 'mail)
(setq btn (forward-button 1))
(error (setq btn nil)))
))
- (beginning-of-buffer)
+ (goto-char (point-min))
))))
)))
(defvar notmuch-search-mode-map
(let ((map (make-sparse-keymap)))
- (define-key map "a" 'notmuch-search-archive-thread)
+ (define-key map "?" 'notmuch-help)
+ (define-key map "q" 'kill-this-buffer)
+ (define-key map "x" 'kill-this-buffer)
+ (define-key map (kbd "<DEL>") 'notmuch-search-scroll-down)
(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 " " '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 "q" 'kill-this-buffer)
+ (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 "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 "f" 'notmuch-search-filter)
+ (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 "<" '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)
+ (define-key map "+" 'notmuch-search-add-tag)
+ (define-key map [mouse-1] 'notmuch-search-show-thread)
+ (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)
+(defvar notmuch-search-oldest-first t
+ "Show the oldest mail first in the search-mode")
(defun notmuch-search-scroll-up ()
(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 ()
"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)
(split-string (buffer-substring beg end))))))
(defun notmuch-search-add-tag (tag)
+ "Add a tag to messages in the current thread matching the
+active query."
(interactive
(list (notmuch-select-tag-with-completion "Tag to add: ")))
- (notmuch-call-notmuch-process "tag" (concat "+" tag) (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-dups (sort (cons tag (notmuch-search-get-tags)) 'string<))))
(defun notmuch-search-remove-tag (tag)
+ "Remove a tag from messages in the current thread matching the
+active query."
(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))
+ (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 ()
(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: ")
(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)
(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 "?" 'notmuch-help)
(define-key map [mouse-1] 'notmuch-folder-show-search)
map)
"Keymap for \"notmuch folder\" buffers.")
(setq folder (notmuch-folder-find-name)))
(let ((search (assoc folder notmuch-folders)))
(if search
- (notmuch-search (cdr search) t))))
+ (notmuch-search (cdr search) notmuch-search-oldest-first))))
+;;;###autoload
(defun notmuch-folder ()
"Show the notmuch folder view and update the displayed counts."
(interactive)