X-Git-Url: https://git.notmuchmail.org/git?p=notmuch;a=blobdiff_plain;f=notmuch.el;h=ddfcdc2aad2c9cb7c613d9ee0940b6ad77d17c74;hp=1934ddfc4febf36e625dd67fd0486ddcbf2b6910;hb=161b2738e1b99f56d0d44a446045e223deddea22;hpb=adbdafbde289ebb724a31cf5ea82e1986ff88ccd diff --git a/notmuch.el b/notmuch.el index 1934ddfc..ddfcdc2a 100644 --- a/notmuch.el +++ b/notmuch.el @@ -19,8 +19,37 @@ ; ; Authors: Carl Worth +; 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 (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))) @@ -33,9 +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 "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) @@ -44,16 +71,19 @@ (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) @@ -71,22 +101,31 @@ pattern can still test against the entire line).") (defvar notmuch-show-signature-lines-max 12 "Maximum length of signature that will be hidden by default.") -(set 'notmuch-show-message-begin-regexp " message{") -(set 'notmuch-show-message-end-regexp " message}") -(set 'notmuch-show-header-begin-regexp " header{") -(set 'notmuch-show-header-end-regexp " header}") -(set 'notmuch-show-body-begin-regexp " body{") -(set 'notmuch-show-body-end-regexp " body}") -(set 'notmuch-show-attachment-begin-regexp " attachment{") -(set 'notmuch-show-attachment-end-regexp " attachment}") -(set 'notmuch-show-part-begin-regexp " part{") -(set 'notmuch-show-part-end-regexp " part}") -(set 'notmuch-show-marker-regexp " \\(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 () @@ -102,6 +141,13 @@ within the current window." (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. @@ -132,7 +178,7 @@ Unlike builtin `next-line' this version accepts no arguments." (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 @@ -140,7 +186,7 @@ Unlike builtin `next-line' this version accepts no arguments." (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 @@ -165,7 +211,8 @@ Unlike builtin `next-line' this version accepts no arguments." (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)) @@ -174,7 +221,8 @@ Unlike builtin `next-line' this version accepts no arguments." (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 @@ -237,30 +285,85 @@ 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")) + (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. @@ -269,7 +372,8 @@ The given command will be executed with the raw contents of the 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. @@ -437,6 +541,35 @@ which this thread was originally shown." (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) @@ -448,92 +581,181 @@ which this thread was originally shown." (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 () @@ -553,49 +775,41 @@ which this thread was originally shown." (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." + (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) - (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 () @@ -625,22 +839,12 @@ view, (remove the \"inbox\" tag from each), with \\{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) @@ -651,6 +855,12 @@ view, (remove the \"inbox\" tag from each), with :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 () @@ -658,6 +868,9 @@ view, (remove the \"inbox\" tag from each), with (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. @@ -673,12 +886,12 @@ thread from that buffer can be show when done with this one)." (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) @@ -692,7 +905,16 @@ thread from that buffer can be show when done with this one)." (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 @@ -700,31 +922,38 @@ 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 "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 "") '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 "") '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 "*" '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 [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 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) @@ -747,30 +976,52 @@ thread from that buffer can be show when done with this one)." (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) @@ -783,47 +1034,37 @@ 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 () - (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. @@ -832,7 +1073,7 @@ and will also appear in a buffer named \"*Notmuch errors*\"." (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 @@ -864,13 +1105,19 @@ and will also appear in a buffer named \"*Notmuch errors*\"." (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 () @@ -881,6 +1128,78 @@ This function advances point to the next line when finished." (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: ") @@ -897,11 +1216,13 @@ This function advances point to the next line when finished." (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. @@ -954,12 +1275,99 @@ current search results AND the additional query string provided." 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)