X-Git-Url: https://git.notmuchmail.org/git?p=notmuch;a=blobdiff_plain;f=notmuch.el;h=da5a98c73219fe25b52992ad5e4a7c7b25ee2dfc;hp=907df2c09c96f1382afa69ccaf429a35ae9cf788;hb=c4463d4cb482abebdffe725a85fff35a0eba31a1;hpb=c1e16435cfe4471c3415d9f625f7230d59c8afb4 diff --git a/notmuch.el b/notmuch.el index 907df2c0..da5a98c7 100644 --- a/notmuch.el +++ b/notmuch.el @@ -49,6 +49,7 @@ (require 'cl) (require 'mm-view) +(require 'message) (defvar notmuch-show-mode-map (let ((map (make-sparse-keymap))) @@ -69,6 +70,7 @@ (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) @@ -137,6 +139,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. @@ -167,7 +176,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 @@ -175,7 +184,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 @@ -200,7 +209,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)) @@ -209,7 +219,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 @@ -272,17 +283,21 @@ 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-reply (query-string) (switch-to-buffer (generate-new-buffer "notmuch-draft")) @@ -554,29 +569,52 @@ which this thread was originally shown." (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) @@ -594,6 +632,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) @@ -614,8 +678,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) @@ -792,6 +855,7 @@ thread from that buffer can be show when done with this one)." (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) @@ -804,7 +868,8 @@ thread from that buffer can be show when done with this one)." (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 () @@ -868,36 +933,8 @@ global search. (setq buffer-read-only 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 () (interactive) @@ -952,13 +989,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 () @@ -969,6 +1012,77 @@ 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 "^[\+\-][_\+\-\\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: ") @@ -985,11 +1099,12 @@ This function advances point to the next line when finished." (erase-buffer) (goto-char (point-min)) (save-excursion - (if oldest-first - (call-process notmuch-command nil t nil "search" "--sort=oldest-first" query) - (call-process notmuch-command 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 () @@ -1043,13 +1158,14 @@ 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)) (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) @@ -1119,7 +1235,7 @@ results for the search terms in that line. (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."