(require 'mm-view)
(require 'message)
+(defvar notmuch-show-stash-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "c" 'notmuch-show-stash-cc)
+ (define-key map "d" 'notmuch-show-stash-date)
+ (define-key map "F" 'notmuch-show-stash-filename)
+ (define-key map "f" 'notmuch-show-stash-from)
+ (define-key map "i" 'notmuch-show-stash-message-id)
+ (define-key map "s" 'notmuch-show-stash-subject)
+ (define-key map "T" 'notmuch-show-stash-tags)
+ (define-key map "t" 'notmuch-show-stash-to)
+ map)
+ "Submap for stash commands"
+ )
+
+(fset 'notmuch-show-stash-map notmuch-show-stash-map)
+
(defvar notmuch-show-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "?" 'notmuch-help)
(define-key map "w" 'notmuch-show-save-attachments)
(define-key map "V" 'notmuch-show-view-raw-message)
(define-key map "v" 'notmuch-show-view-all-mime-parts)
+ (define-key map "c" 'notmuch-show-stash-map)
(define-key map "b" 'notmuch-show-toggle-current-body)
(define-key map "h" 'notmuch-show-toggle-current-header)
(define-key map "-" 'notmuch-show-remove-tag)
(defvar notmuch-show-id-regexp "\\(id:[^ ]*\\)")
(defvar notmuch-show-depth-match-regexp " depth:\\([0-9]*\\).*match:\\([01]\\) ")
(defvar notmuch-show-filename-regexp "filename:\\(.*\\)$")
+(defvar notmuch-show-contentype-regexp "Content-type: \\(.*\\)")
+
(defvar notmuch-show-tags-regexp "(\\([^)]*\\))$")
(defvar notmuch-show-parent-buffer nil)
(re-search-forward notmuch-show-tags-regexp)
(split-string (buffer-substring (match-beginning 1) (match-end 1)))))
+(defun notmuch-show-get-bcc ()
+ "Return BCC address(es) of current message"
+ (notmuch-show-get-header-field 'bcc))
+
+(defun notmuch-show-get-cc ()
+ "Return CC address(es) of current message"
+ (notmuch-show-get-header-field 'cc))
+
+(defun notmuch-show-get-date ()
+ "Return Date of current message"
+ (notmuch-show-get-header-field 'date))
+
+(defun notmuch-show-get-from ()
+ "Return From address of current message"
+ (notmuch-show-get-header-field 'from))
+
+(defun notmuch-show-get-subject ()
+ "Return Subject of current message"
+ (notmuch-show-get-header-field 'subject))
+
+(defun notmuch-show-get-to ()
+ "Return To address(es) of current message"
+ (notmuch-show-get-header-field 'to))
+
+(defun notmuch-show-get-header-field (name)
+ "Retrieve the header field NAME from the current message.
+NAME should be a symbol, in lower case, as returned by
+mail-header-extract-no-properties"
+ (let* ((result (assoc name (notmuch-show-get-header)))
+ (val (and result (cdr result))))
+ val))
+
+(defun notmuch-show-get-header ()
+ "Retrieve and parse the header from the current message. Returns an alist with of (header . value)
+where header is a symbol and value is a string. The summary from notmuch-show is returned as the
+pseudoheader summary"
+ (require 'mailheader)
+ (save-excursion
+ (beginning-of-line)
+ (if (not (looking-at notmuch-show-message-begin-regexp))
+ (re-search-backward notmuch-show-message-begin-regexp))
+ (re-search-forward (concat notmuch-show-header-begin-regexp "\n[[:space:]]*\\(.*\\)\n"))
+ (let* ((summary (buffer-substring-no-properties (match-beginning 1) (match-end 1)))
+ (beg (point)))
+ (re-search-forward notmuch-show-header-end-regexp)
+ (let ((text (buffer-substring beg (match-beginning 0))))
+ (with-temp-buffer
+ (insert text)
+ (goto-char (point-min))
+ (while (looking-at "\\([[:space:]]*\\)[A-Za-z][-A-Za-z0-9]*:")
+ (delete-region (match-beginning 1) (match-end 1))
+ (forward-line)
+ )
+ (goto-char (point-min))
+ (cons (cons 'summary summary) (mail-header-extract-no-properties)))))))
+
(defun notmuch-show-add-tag (&rest toadd)
"Add a tag to the current message."
(interactive
(with-current-buffer buf
(insert-file-contents filename nil nil nil t)
,@body)
- (kill-buffer buf)))))
+ (kill-buffer buf)))))
(defun notmuch-show-view-all-mime-parts ()
"Use external viewers to view all attachments from the current message."
(interactive)
(with-current-notmuch-show-message
- (mm-display-parts (mm-dissect-buffer))))
+ ; We ovverride the mm-inline-media-tests to indicate which message
+ ; parts are already sufficiently handled by the original
+ ; presentation of the message in notmuch-show mode. These parts
+ ; will be inserted directly into the temporary buffer of
+ ; with-current-notmuch-show-message and silently discarded.
+ ;
+ ; Any MIME part not explicitly mentioned here will be handled by an
+ ; external viewer as configured in the various mailcap files.
+ (let ((mm-inline-media-tests '(
+ ("text/.*" ignore identity)
+ ("application/pgp-signature" ignore identity)
+ ("multipart/alternative" ignore identity)
+ ("multipart/mixed" ignore identity)
+ ("multipart/related" ignore identity)
+ )))
+ (mm-display-parts (mm-dissect-buffer)))))
(defun notmuch-foreach-mime-part (function mm-handle)
(cond ((stringp (car mm-handle))
(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)))))
+ (let (mime-message mime-type)
+ (save-excursion
+ (re-search-forward notmuch-show-contentype-regexp end t)
+ (setq mime-type (car (split-string (buffer-substring
+ (match-beginning 1) (match-end 1))))))
+
+ (if (equal mime-type "text/html")
+ (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)))
+ (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)
+ (if (not (eq mime-message nil))
+ (save-excursion
+ (goto-char beg)
+ (forward-line -1)
+ (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 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))
(goto-char end)))
(defun notmuch-show-markup-parts-region (beg end depth)
(if (mouse-event-p key)
nil
(if (keymapp action)
- (let ((substitute (apply-partially 'notmuch-substitute-one-command-key-with-prefix (notmuch-prefix-key-description key))))
- (mapconcat substitute (cdr action) "\n"))
+ (let ((substitute (apply-partially 'notmuch-substitute-one-command-key-with-prefix (notmuch-prefix-key-description key)))
+ (as-list))
+ (map-keymap (lambda (a b)
+ (push (cons a b) as-list))
+ action)
+ (mapconcat substitute as-list "\n"))
(concat prefix (format-kbd-macro (vector key))
"\t"
(notmuch-documentation-first-line action))))))
:options '(hl-line-mode)
:group 'notmuch)
+(defun notmuch-show-do-stash (text)
+ (kill-new text)
+ (message (concat "Saved: " text)))
+
+(defun notmuch-show-stash-cc ()
+ "Copy CC field of current message to kill-ring."
+ (interactive)
+ (notmuch-show-do-stash (notmuch-show-get-cc)))
+
+(defun notmuch-show-stash-date ()
+ "Copy date of current message to kill-ring."
+ (interactive)
+ (notmuch-show-do-stash (notmuch-show-get-date)))
+
+(defun notmuch-show-stash-filename ()
+ "Copy filename of current message to kill-ring."
+ (interactive)
+ (notmuch-show-do-stash (notmuch-show-get-filename)))
+
+(defun notmuch-show-stash-from ()
+ "Copy From address of current message to kill-ring."
+ (interactive)
+ (notmuch-show-do-stash (notmuch-show-get-from)))
+
+(defun notmuch-show-stash-message-id ()
+ "Copy message ID of current message to kill-ring."
+ (interactive)
+ (notmuch-show-do-stash (notmuch-show-get-message-id)))
+
+(defun notmuch-show-stash-subject ()
+ "Copy Subject field of current message to kill-ring."
+ (interactive)
+ (notmuch-show-do-stash (notmuch-show-get-subject)))
+
+(defun notmuch-show-stash-tags ()
+ "Copy tags of current message to kill-ring as a comma separated list."
+ (interactive)
+ (notmuch-show-do-stash (mapconcat 'identity (notmuch-show-get-tags) ",")))
+
+(defun notmuch-show-stash-to ()
+ "Copy To address of current message to kill-ring."
+ (interactive)
+ (notmuch-show-do-stash (notmuch-show-get-to)))
+
; Make show mode a bit prettier, highlighting URLs and using word wrap
(defun notmuch-show-pretty-hook ()
(more t)
(inhibit-read-only t))
(while more
- (if (string-match "^\\(thread:[0-9A-Fa-f]*\\) \\(.*\\) \\(\\[[0-9/]*\\]\\) \\([^:]*\\); \\(.*\\) (\\([^()]*\\))$" string line)
+ (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))
(define-key map "x" 'kill-this-buffer)
(define-key map "q" 'kill-this-buffer)
(define-key map "m" 'message-mail)
+ (define-key map "e" 'notmuch-folder-show-empty-toggle)
(define-key map ">" 'notmuch-folder-last)
(define-key map "<" 'notmuch-folder-first)
(define-key map "=" 'notmuch-folder)
(goto-char (point-max))
(forward-line -1))
+(defun notmuch-folder-count (search)
+ (car (process-lines notmuch-command "count" search)))
+
+(setq notmuch-folder-show-empty t)
+
+(defun notmuch-folder-show-empty-toggle ()
+ "Toggle the listing of empty folders"
+ (interactive)
+ (setq notmuch-folder-show-empty (not notmuch-folder-show-empty))
+ (notmuch-folder))
+
(defun notmuch-folder-add (folders)
(if folders
- (let ((name (car (car 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)
+ (search (cdr (car folders)))
+ (count (notmuch-folder-count search)))
+ (if (or notmuch-folder-show-empty
+ (not (equal count "0")))
+ (progn
+ (insert name)
+ (indent-to 16 1)
+ (insert count)
+ (insert "\n")
+ )
+ )
(notmuch-folder-add (cdr folders)))))
(defun notmuch-folder-find-name ()