1b/4443623474b08f30b84a66dd355cfb339b6f2d

   1 Return-Path: <dme@dme.org>\r
   2 X-Original-To: notmuch@notmuchmail.org\r
   3 Delivered-To: notmuch@notmuchmail.org\r
   4 Received: from localhost (localhost [127.0.0.1])\r
   5         by olra.theworths.org (Postfix) with ESMTP id C8802431FD0\r
   6         for <notmuch@notmuchmail.org>; Tue, 27 Dec 2011 09:13:32 -0800 (PST)\r
   7 X-Virus-Scanned: Debian amavisd-new at olra.theworths.org\r
   8 X-Spam-Flag: NO\r
   9 X-Spam-Score: -0.7\r
  10 X-Spam-Level: \r
  11 X-Spam-Status: No, score=-0.7 tagged_above=-999 required=5\r
  12         tests=[RCVD_IN_DNSWL_LOW=-0.7] autolearn=disabled\r
  13 Received: from olra.theworths.org ([127.0.0.1])\r
  14         by localhost (olra.theworths.org [127.0.0.1]) (amavisd-new, port 10024)\r
  15         with ESMTP id 9gUAIMBs-Ow7 for <notmuch@notmuchmail.org>;\r
  16         Tue, 27 Dec 2011 09:13:32 -0800 (PST)\r
  17 Received: from mail-ww0-f45.google.com (mail-ww0-f45.google.com\r
  18  [74.125.82.45])        (using TLSv1 with cipher RC4-SHA (128/128 bits))        (No client\r
  19  certificate requested) by olra.theworths.org (Postfix) with ESMTPS id\r
  20  CD509431FB6    for <notmuch@notmuchmail.org>; Tue, 27 Dec 2011 09:13:31 -0800\r
  21  (PST)\r
  22 Received: by wgbds13 with SMTP id ds13so17492224wgb.2\r
  23         for <notmuch@notmuchmail.org>; Tue, 27 Dec 2011 09:13:30 -0800 (PST)\r
  24 Received: by 10.227.208.134 with SMTP id gc6mr28160473wbb.3.1325006010527;\r
  25         Tue, 27 Dec 2011 09:13:30 -0800 (PST)\r
  26 Received: from hotblack-desiato.hh.sledj.net\r
  27         (host81-149-164-25.in-addr.btopenworld.com. [81.149.164.25])\r
  28         by mx.google.com with ESMTPS id fy5sm67223800wib.7.2011.12.27.09.13.28\r
  29         (version=TLSv1/SSLv3 cipher=OTHER);\r
  30         Tue, 27 Dec 2011 09:13:29 -0800 (PST)\r
  31 Received: by hotblack-desiato.hh.sledj.net (Postfix, from userid 30000)\r
  32         id 8BB6CA07D5; Tue, 27 Dec 2011 17:13:27 +0000 (GMT)\r
  33 From: David Edmondson <dme@dme.org>\r
  34 To: notmuch@notmuchmail.org\r
  35 Subject: [PATCH] emacs: Add `notmuch-show-line-faces' and apply it.\r
  36 Date: Tue, 27 Dec 2011 17:13:23 +0000\r
  37 Message-Id: <1325006003-27152-1-git-send-email-dme@dme.org>\r
  38 X-Mailer: git-send-email 1.7.7.3\r
  39 X-BeenThere: notmuch@notmuchmail.org\r
  40 X-Mailman-Version: 2.1.13\r
  41 Precedence: list\r
  42 List-Id: "Use and development of the notmuch mail system."\r
  43         <notmuch.notmuchmail.org>\r
  44 List-Unsubscribe: <http://notmuchmail.org/mailman/options/notmuch>,\r
  45         <mailto:notmuch-request@notmuchmail.org?subject=unsubscribe>\r
  46 List-Archive: <http://notmuchmail.org/pipermail/notmuch>\r
  47 List-Post: <mailto:notmuch@notmuchmail.org>\r
  48 List-Help: <mailto:notmuch-request@notmuchmail.org?subject=help>\r
  49 List-Subscribe: <http://notmuchmail.org/mailman/listinfo/notmuch>,\r
  50         <mailto:notmuch-request@notmuchmail.org?subject=subscribe>\r
  51 X-List-Received-Date: Tue, 27 Dec 2011 17:13:33 -0000\r
  52 \r
  53 Similar to `notmuch-search-line-faces', `notmuch-show-line-faces'\r
  54 allows the header line in `notmuch-show-mode' buffers to be coloured\r
  55 according to the tags of the message.\r
  56 ---\r
  57  emacs/notmuch-lib.el  |   18 ++++++++++++++++++\r
  58  emacs/notmuch-show.el |   32 ++++++++++++++++++++++++++++----\r
  59  emacs/notmuch.el      |   17 ++---------------\r
  60  3 files changed, 48 insertions(+), 19 deletions(-)\r
  61 \r
  62 diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el\r
  63 index 0f856bf..1f00fe0 100644\r
  64 --- a/emacs/notmuch-lib.el\r
  65 +++ b/emacs/notmuch-lib.el\r
  66 @@ -96,6 +96,24 @@ the user hasn't set this variable with the old or new value."\r
  67    (interactive)\r
  68    (kill-buffer (current-buffer)))\r
  69  \r
  70 +(defun notmuch-color-line (start end line-tag-list spec)\r
  71 +  "Colorize a line based on tags."\r
  72 +  ;; Create the overlay only if the message has tags which match one\r
  73 +  ;; of those specified in `spec'.\r
  74 +  (let (overlay)\r
  75 +    (mapc (lambda (elem)\r
  76 +           (let ((tag (car elem))\r
  77 +                 (attributes (cdr elem)))\r
  78 +             (when (member tag line-tag-list)\r
  79 +               (when (not overlay)\r
  80 +                 (setq overlay (make-overlay start end))\r
  81 +                 (overlay-put overlay 'priority 5))\r
  82 +               ;; Merge the specified properties with any already\r
  83 +               ;; applied from an earlier match.\r
  84 +               (overlay-put overlay 'face\r
  85 +                            (append (overlay-get overlay 'face) attributes)))))\r
  86 +         spec)))\r
  87 +\r
  88  ;;\r
  89  \r
  90  (defun notmuch-common-do-stash (text)\r
  91 diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el\r
  92 index 24f0b40..0885bd5 100644\r
  93 --- a/emacs/notmuch-show.el\r
  94 +++ b/emacs/notmuch-show.el\r
  95 @@ -88,6 +88,23 @@ any given message."\r
  96              notmuch-wash-elide-blank-lines\r
  97              notmuch-wash-excerpt-citations))\r
  98  \r
  99 +(defcustom notmuch-show-line-faces nil\r
 100 +  "Tag to face mapping for header line highlighting in `notmuch-show-mode'.\r
 101 +\r
 102 +Here is an example of how to color search results based on tags.\r
 103 + (the following text would be placed in your ~/.emacs file):\r
 104 +\r
 105 + (setq notmuch-search-line-faces '((\"delete\" . (:foreground \"red\"\r
 106 +                                                 :background \"blue\"))\r
 107 +                                   (\"unread\" . (:foreground \"green\"))))\r
 108 +\r
 109 +The attributes defined for matching tags are merged, with later\r
 110 +attributes overriding earlier. A message having both \"delete\"\r
 111 +and \"unread\" tags with the above settings would have a green\r
 112 +foreground and blue background."\r
 113 +  :type '(alist :key-type (string) :value-type (custom-face-edit))\r
 114 +  :group 'notmuch)\r
 115 +\r
 116  ;; Mostly useful for debugging.\r
 117  (defcustom notmuch-show-all-multipart/alternative-parts t\r
 118    "Should all parts of multipart/alternative parts be shown?"\r
 119 @@ -269,7 +286,8 @@ unchanged ADDRESS if parsing fails."\r
 120  (defun notmuch-show-insert-headerline (headers date tags depth)\r
 121    "Insert a notmuch style headerline based on HEADERS for a\r
 122  message at DEPTH in the current thread."\r
 123 -  (let ((start (point)))\r
 124 +  (let ((start (point))\r
 125 +       overlay)\r
 126      (insert (notmuch-show-spaces-n (* notmuch-indent-messages-width depth))\r
 127             (notmuch-show-clean-address (plist-get headers :From))\r
 128             " ("\r
 129 @@ -277,7 +295,9 @@ message at DEPTH in the current thread."\r
 130             ") ("\r
 131             (mapconcat 'identity tags " ")\r
 132             ")\n")\r
 133 -    (overlay-put (make-overlay start (point)) 'face 'notmuch-message-summary-face)))\r
 134 +    (setq overlay (make-overlay start (point)))\r
 135 +    (overlay-put overlay 'face 'notmuch-message-summary-face)\r
 136 +    (overlay-put overlay 'priority 2)))\r
 137  \r
 138  (defun notmuch-show-insert-header (header header-value)\r
 139    "Insert a single header."\r
 140 @@ -712,7 +732,8 @@ current buffer, if possible."\r
 141          body-start body-end\r
 142          (headers-invis-spec (notmuch-show-make-symbol "header"))\r
 143          (message-invis-spec (notmuch-show-make-symbol "message"))\r
 144 -        (bare-subject (notmuch-show-strip-re (plist-get headers :Subject))))\r
 145 +        (bare-subject (notmuch-show-strip-re (plist-get headers :Subject)))\r
 146 +        (tags (plist-get msg :tags)))\r
 147  \r
 148      ;; Set `buffer-invisibility-spec' to `nil' (a list), otherwise\r
 149      ;; removing items from `buffer-invisibility-spec' (which is what\r
 150 @@ -737,10 +758,13 @@ current buffer, if possible."\r
 151                                             (plist-get msg :date_relative)\r
 152                                           nil)\r
 153                                         (plist-get headers :Date))\r
 154 -                                   (plist-get msg :tags) depth)\r
 155 +                                   tags depth)\r
 156  \r
 157      (setq content-start (point-marker))\r
 158  \r
 159 +    ;; Colour the header line according to the tags of the message.\r
 160 +    (notmuch-color-line message-start content-start tags notmuch-show-line-faces)\r
 161 +\r
 162      (plist-put msg :headers-invis-spec headers-invis-spec)\r
 163      (plist-put msg :message-invis-spec message-invis-spec)\r
 164  \r
 165 diff --git a/emacs/notmuch.el b/emacs/notmuch.el\r
 166 index 4844385..56d35d0 100644\r
 167 --- a/emacs/notmuch.el\r
 168 +++ b/emacs/notmuch.el\r
 169 @@ -641,7 +641,7 @@ This function advances the next thread when finished."\r
 170                   (forward-line (1- notmuch-search-target-line))))))))\r
 171  \r
 172  (defcustom notmuch-search-line-faces nil\r
 173 -  "Tag/face mapping for line highlighting in notmuch-search.\r
 174 +  "Tag to face mapping for line highlighting in `notmuch-search-mode'.\r
 175  \r
 176  Here is an example of how to color search results based on tags.\r
 177   (the following text would be placed in your ~/.emacs file):\r
 178 @@ -659,20 +659,7 @@ foreground and blue background."\r
 179  \r
 180  (defun notmuch-search-color-line (start end line-tag-list)\r
 181    "Colorize lines in `notmuch-show' based on tags."\r
 182 -  ;; Create the overlay only if the message has tags which match one\r
 183 -  ;; of those specified in `notmuch-search-line-faces'.\r
 184 -  (let (overlay)\r
 185 -    (mapc (lambda (elem)\r
 186 -           (let ((tag (car elem))\r
 187 -                 (attributes (cdr elem)))\r
 188 -             (when (member tag line-tag-list)\r
 189 -               (when (not overlay)\r
 190 -                 (setq overlay (make-overlay start end)))\r
 191 -               ;; Merge the specified properties with any already\r
 192 -               ;; applied from an earlier match.\r
 193 -               (overlay-put overlay 'face\r
 194 -                            (append (overlay-get overlay 'face) attributes)))))\r
 195 -         notmuch-search-line-faces)))\r
 196 +  (notmuch-color-line start end line-tag-list notmuch-search-line-faces))\r
 197  \r
 198  (defun notmuch-search-author-propertize (authors)\r
 199    "Split `authors' into matching and non-matching authors and\r
 200 -- \r
 201 1.7.7.3\r
 202 \r