notmuch.el: colorize lines in notmuch-search based on thread tags.

Arbitrary font faces can be specified for given thread tags.  By
default, no coloring is applied.  To specify coloring, place something
like this in your .emacs:

(setq notmuch-search-line-faces '(("delete" . '(:foreground "red"))
                                  ("unread" . '(:foreground "green"))))

Order matters: line faces listed first will take precedence (in the
example above, a thread tagged both "delete" and "unread" will be
colored red, since the "delete" face is listed before the "unread").
 notmuch.el |   33 ++++++++++++++++++++++++++++++++-
 1 files changed, 32 insertions(+), 1 deletions(-)

diff --git a/emacs/notmuch.el b/emacs/notmuch.el
index b32230e03672cd5bb6283e0469bf425d40f9861f..4bc429461c599e102111d8bfee8cbae36ea3271a 100644 (file)
--- a/emacs/notmuch.el
+++ b/emacs/notmuch.el
@@ -526,6 +526,35 @@ This function advances the next thread when finished."
                       notmuch-search-target-line)
                  (goto-line notmuch-search-target-line)))))))
 
                       notmuch-search-target-line)
                  (goto-line notmuch-search-target-line)))))))
 

+(defcustom notmuch-search-line-faces nil
+  "Tag/face mapping for line highlighting in notmuch-search.
+
+Here is an example of how to color search results based on tags.
+(the following text would be placed in your ~/.emacs file):
+
+(setq notmuch-search-line-faces '((\"delete\" . '(:foreground \"red\"))
+                                 (\"unread\" . '(:foreground \"green\"))))
+
+Order matters: for lines with multiple tags, the the first
+matching will be applied."
+  :type '(alist :key-type (string) :value-type (list))
+  :group 'notmuch)
+
+(defun notmuch-search-color-line (start end line-tag-list)
+  "Colorize lines in notmuch-show based on tags"
+  (if notmuch-search-line-faces
+      (let ((overlay (make-overlay start end))
+           (tags-faces (copy-alist notmuch-search-line-faces)))
+       (while tags-faces
+         (let* ((tag-face (car tags-faces))
+                (tag (car tag-face))
+                (face (cdr tag-face)))
+           (cond ((member tag line-tag-list)
+                  (overlay-put overlay 'face face)
+                  (setq tags-faces nil))
+                 (t
+                  (setq tags-faces (cdr tags-faces)))))))))
+

 (defun notmuch-search-process-filter (proc string)
   "Process and filter the output of \"notmuch search\""
   (let ((buffer (process-buffer proc))
 (defun notmuch-search-process-filter (proc string)
   "Process and filter the output of \"notmuch search\""
   (let ((buffer (process-buffer proc))


@@ -544,13 +573,15 @@ This function advances the next thread when finished."
                           (authors (match-string 4 string))
                           (authors-length (length authors))
                           (subject (match-string 5 string))
                           (authors (match-string 4 string))
                           (authors-length (length authors))
                           (subject (match-string 5 string))

-                          (tags (match-string 6 string)))
+                          (tags (match-string 6 string))
+                          (tag-list (if tags (save-match-data (split-string tags)))))

                      (if (> authors-length notmuch-search-authors-width)
                          (set 'authors (concat (substring authors 0 (- notmuch-search-authors-width 3)) "...")))
                      (goto-char (point-max))
                      (let ((beg (point-marker))
                            (format-string (format "%%s %%-7s %%-%ds %%s (%%s)\n" notmuch-search-authors-width)))
                        (insert (format format-string date count authors subject tags))
                      (if (> authors-length notmuch-search-authors-width)
                          (set 'authors (concat (substring authors 0 (- notmuch-search-authors-width 3)) "...")))
                      (goto-char (point-max))
                      (let ((beg (point-marker))
                            (format-string (format "%%s %%-7s %%-%ds %%s (%%s)\n" notmuch-search-authors-width)))
                        (insert (format format-string date count authors subject tags))

+                       (notmuch-search-color-line beg (point-marker) tag-list)

                        (put-text-property beg (point-marker) 'notmuch-search-thread-id thread-id)
                        (put-text-property beg (point-marker) 'notmuch-search-authors authors)
                        (put-text-property beg (point-marker) 'notmuch-search-subject subject)
                        (put-text-property beg (point-marker) 'notmuch-search-thread-id thread-id)
                        (put-text-property beg (point-marker) 'notmuch-search-authors authors)
                        (put-text-property beg (point-marker) 'notmuch-search-subject subject)