Return-Path: X-Original-To: notmuch@notmuchmail.org Delivered-To: notmuch@notmuchmail.org Received: from localhost (localhost [127.0.0.1]) by olra.theworths.org (Postfix) with ESMTP id 0BDA24196F0 for ; Mon, 7 Jun 2010 07:35:24 -0700 (PDT) X-Virus-Scanned: Debian amavisd-new at olra.theworths.org X-Spam-Flag: NO X-Spam-Score: -1.9 X-Spam-Level: X-Spam-Status: No, score=-1.9 tagged_above=-999 required=5 tests=[BAYES_00=-1.9] autolearn=ham Received: from olra.theworths.org ([127.0.0.1]) by localhost (olra.theworths.org [127.0.0.1]) (amavisd-new, port 10024) with ESMTP id HfsdZFNOMXnl for ; Mon, 7 Jun 2010 07:35:13 -0700 (PDT) Received: from mail-wy0-f181.google.com (mail-wy0-f181.google.com [74.125.82.181]) by olra.theworths.org (Postfix) with ESMTP id 9D5E6431FC1 for ; Mon, 7 Jun 2010 07:35:13 -0700 (PDT) Received: by wyb35 with SMTP id 35so2855988wyb.26 for ; Mon, 07 Jun 2010 07:35:12 -0700 (PDT) Received: by 10.227.145.141 with SMTP id d13mr5570334wbv.40.1275921311840; Mon, 07 Jun 2010 07:35:11 -0700 (PDT) Received: from ut.hh.sledj.net (gmp-ea-fw-1b.sun.com [192.18.8.1]) by mx.google.com with ESMTPS id n31sm38249009wba.9.2010.06.07.07.35.09 (version=TLSv1/SSLv3 cipher=RC4-MD5); Mon, 07 Jun 2010 07:35:10 -0700 (PDT) Received: by ut.hh.sledj.net (Postfix, from userid 1000) id F1167594015; Mon, 7 Jun 2010 15:35:12 +0100 (BST) From: David Edmondson To: notmuch@notmuchmail.org Subject: [PATCH] emacs: Re-work the implementation of highlighting in notmuch-search-mode. Date: Mon, 7 Jun 2010 15:35:10 +0100 Message-Id: <1275921310-307-1-git-send-email-dme@dme.org> X-Mailer: git-send-email 1.7.1 X-BeenThere: notmuch@notmuchmail.org X-Mailman-Version: 2.1.13 Precedence: list List-Id: "Use and development of the notmuch mail system." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , X-List-Received-Date: Mon, 07 Jun 2010 14:35:24 -0000 Re-write `notmuch-search-color-line', with the following improvements: - create overlays only if they will be needed, - merge the properties specified for a tag on top of any matching a previous tag. --- emacs/notmuch.el | 37 +++++++++++++++++++++---------------- 1 files changed, 21 insertions(+), 16 deletions(-) diff --git a/emacs/notmuch.el b/emacs/notmuch.el index 10babe4..ac1da34 100644 --- a/emacs/notmuch.el +++ b/emacs/notmuch.el @@ -585,28 +585,33 @@ This function advances the next thread when finished." 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\")) + (setq notmuch-search-line-faces '((\"delete\" . '(:foreground \"red\" + :background \"blue\")) (\"unread\" . '(:foreground \"green\")))) -Order matters: for lines with multiple tags, the the first -matching will be applied." +The attributes defined for matching tags are merged, with later +attributes overriding earlier. A message having both \"delete\" +and \"unread\" tags with the above settings would have a green +foreground and blue background." :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))))))))) + "Colorize lines in `notmuch-show' based on tags." + ;; Create the overlay only if the message has tags which match one + ;; of those specified in `notmuch-search-line-faces'. + (let (overlay) + (mapc '(lambda (elem) + (let ((tag (car elem)) + (attributes (cdr elem))) + (when (member tag line-tag-list) + (when (not overlay) + (setq overlay (make-overlay start end))) + ;; Merge the specified properties with any already + ;; applied from an earlier match. + (overlay-put overlay 'face + (append (overlay-get overlay 'face) attributes))))) + notmuch-search-line-faces))) (defun notmuch-search-isearch-authors-show (overlay) (remove-from-invisibility-spec (cons (overlay-get overlay 'invisible) t))) -- 1.7.1