(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 "x" 'kill-this-buffer)
(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-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)
(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)
(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 ()
(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 "^[\+\-][_\+\-\\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: ")
(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)
(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))))
(defun notmuch-folder ()
"Show the notmuch folder view and update the displayed counts."
projects / notmuch / blobdiff