X-Git-Url: https://git.notmuchmail.org/git?p=notmuch;a=blobdiff_plain;f=notmuch.el;h=9eb84696ff56dcb6134ac2d29e72df0473ec7157;hp=f99feae88641e4f38f3a2866ae9892482939bda4;hb=07a46d10eaf93707f37f3325c8192ef0684ad06d;hpb=ed16edc94d6a50ca86ff1575d9ea6fb9168b2e81 diff --git a/notmuch.el b/notmuch.el index f99feae8..9eb84696 100644 --- a/notmuch.el +++ b/notmuch.el @@ -62,6 +62,7 @@ ; 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) @@ -70,15 +71,17 @@ (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) @@ -282,17 +285,62 @@ buffer." (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")) @@ -311,6 +359,12 @@ buffer." (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. @@ -627,6 +681,32 @@ which this thread was originally shown." (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) @@ -647,8 +727,7 @@ which this thread was originally shown." (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) @@ -696,6 +775,47 @@ which this thread was originally shown." (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. + +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) + (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. @@ -730,8 +850,6 @@ view, (remove the \"inbox\" tag from each), with mode-name "notmuch-show") (setq buffer-read-only t)) -;;;###autoload - (defgroup notmuch nil "Notmuch mail reader for Emacs." :group 'mail) @@ -800,7 +918,7 @@ thread from that buffer can be show when done with this one)." (setq btn (forward-button 1)) (error (setq btn nil))) )) - (beginning-of-buffer) + (goto-char (point-min)) )))) ))) @@ -809,30 +927,29 @@ thread from that buffer can be show when done with this one)." (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 "") '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 "f" 'notmuch-search-filter) (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 "") 'notmuch-search-scroll-down) - (define-key map "?" 'describe-mode) + (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) @@ -860,8 +977,8 @@ thread from that buffer can be show when done with this one)." ; directly to that position. (We have to count lines since the ; window-start position is not the same as point-min due to the ; invisible thread-ID characters on the first line. - (if (equal (count-lines (point-min) (window-start)) 1) - (goto-char (window-start)) + (if (equal (count-lines (point-min) (window-start)) 0) + (goto-char (point-min)) (scroll-down nil))) (defun notmuch-search-goto-last-thread () @@ -870,24 +987,46 @@ thread from that buffer can be show when done with this one)." (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) @@ -900,13 +1039,25 @@ global search. (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) @@ -1047,12 +1198,13 @@ characters as well as `_.+-'. (let ((words action-split)) (when (null words) (error "No operation given")) (while words - (unless (string-match-p "^[\+\-][_\+\-\\w]+$" (car 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: ") @@ -1132,6 +1284,8 @@ current search results AND that are tagged with the given tag." (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) @@ -1149,7 +1303,7 @@ current search results AND that are tagged with the given tag." (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.") @@ -1207,6 +1361,7 @@ results for the search terms in that line. (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)