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 88E16431FC0 for ; Sat, 23 Mar 2013 04:30:15 -0700 (PDT) X-Virus-Scanned: Debian amavisd-new at olra.theworths.org X-Spam-Flag: NO X-Spam-Score: -0.799 X-Spam-Level: X-Spam-Status: No, score=-0.799 tagged_above=-999 required=5 tests=[DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, FREEMAIL_FROM=0.001, RCVD_IN_DNSWL_LOW=-0.7] autolearn=disabled 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 Qet35n9r2b0D for ; Sat, 23 Mar 2013 04:30:11 -0700 (PDT) Received: from mail-we0-f176.google.com (mail-we0-f176.google.com [74.125.82.176]) (using TLSv1 with cipher RC4-SHA (128/128 bits)) (No client certificate requested) by olra.theworths.org (Postfix) with ESMTPS id 55E41431FAE for ; Sat, 23 Mar 2013 04:30:11 -0700 (PDT) Received: by mail-we0-f176.google.com with SMTP id s10so773782wey.21 for ; Sat, 23 Mar 2013 04:30:10 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20120113; h=x-received:from:to:cc:subject:date:message-id:x-mailer:in-reply-to :references:mime-version:content-type:content-transfer-encoding; bh=vsgvWLZ1U+7aYqZ2UvKBsbsvAcnC/pWiFLJfkDXfH4U=; b=WcRCr/wcVhDo77BSGi/BU6I4Kk0BNr1S8ihHwIiJdt5tvjSeM3PHbJusqu7DGSyTLg 7HqUpWDOx4BSPIlkQ9PtpgVEbW8ckbpLZRLo4rfOZM61ljzwW9RtJIIFrFxoNzVyPe19 tpDtH/bctEBccXEFQjNAUPEofxuLUi2x47HCSuJd1Y/emobO3YL/Q7ZavU86CRgQzwfI ChwUaAI21Elh/0IWBgbyGF7+YXewehouzdIA70L9/spz4uMwkEurPo82VLwIIcMQvf/E fbAiuam8avCnE/htxL1mIZunhEnjNuEJ255atB8gpGa28zVIxvIDABPRWKfPvxBRyGzk n1QA== X-Received: by 10.194.7.131 with SMTP id j3mr8244125wja.23.1364038210238; Sat, 23 Mar 2013 04:30:10 -0700 (PDT) Received: from localhost.localdomain (110.195.67.86.rev.sfr.net. [86.67.195.110]) by mx.google.com with ESMTPS id dp5sm16185652wib.1.2013.03.23.04.30.08 (version=TLSv1.1 cipher=ECDHE-RSA-RC4-SHA bits=128/128); Sat, 23 Mar 2013 04:30:09 -0700 (PDT) From: Damien Cassou To: notmuch@notmuchmail.org Subject: [PATCH 2/2] emacs: possibility to customize the rendering of tags Date: Sat, 23 Mar 2013 12:29:54 +0100 Message-Id: <1364038194-19856-3-git-send-email-damien.cassou@gmail.com> X-Mailer: git-send-email 1.7.10.4 In-Reply-To: <1364038194-19856-1-git-send-email-damien.cassou@gmail.com> References: <1364038194-19856-1-git-send-email-damien.cassou@gmail.com> MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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: Sat, 23 Mar 2013 11:30:16 -0000 This patch extracts the rendering of tags in notmuch-show to the notmuch-tag file. This file introduces a `notmuch-tag-formats' variable that associates each tag to a particular format. This variable can be customized thanks to the work of Austin Clements. For example, '(("unread" (propertize tag 'face '(:foreground "red"))) ("flagged" (notmuch-tag-format-image tag "star.svg"))) associates a red foreground to the "unread" tag and a star picture to the "flagged" tag. Signed-off-by: Damien Cassou --- emacs/notmuch-show.el | 6 +-- emacs/notmuch-tag.el | 136 ++++++++++++++++++++++++++++++++++++++++++++++++- emacs/notmuch.el | 5 +- 3 files changed, 139 insertions(+), 8 deletions(-) diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el index acaef8e..a4d2c12 100644 --- a/emacs/notmuch-show.el +++ b/emacs/notmuch-show.el @@ -362,8 +362,7 @@ operation on the contents of the current buffer." (if (re-search-forward "(\\([^()]*\\))$" (line-end-position) t) (let ((inhibit-read-only t)) (replace-match (concat "(" - (propertize (mapconcat 'identity tags " ") - 'face 'notmuch-tag-face) + (notmuch-tag-format-tags tags) ")")))))) (defun notmuch-clean-address (address) @@ -441,8 +440,7 @@ message at DEPTH in the current thread." " (" date ") (" - (propertize (mapconcat 'identity tags " ") - 'face 'notmuch-tag-face) + (notmuch-tag-format-tags tags) ")\n") (overlay-put (make-overlay start (point)) 'face 'notmuch-message-summary-face))) diff --git a/emacs/notmuch-tag.el b/emacs/notmuch-tag.el index 4fce3a9..75a438b 100644 --- a/emacs/notmuch-tag.el +++ b/emacs/notmuch-tag.el @@ -1,5 +1,6 @@ ;; notmuch-tag.el --- tag messages within emacs ;; +;; Copyright © Damien Cassou ;; Copyright © Carl Worth ;; ;; This file is part of Notmuch. @@ -18,11 +19,144 @@ ;; along with Notmuch. If not, see . ;; ;; Authors: Carl Worth +;; Damien Cassou +;; +;;; Code: +;; -(eval-when-compile (require 'cl)) +(require 'cl) (require 'crm) (require 'notmuch-lib) +(defcustom notmuch-tag-formats + '(("unread" (propertize tag 'face '(:foreground "red"))) + ("flagged" (notmuch-tag-format-image-data tag (notmuch-tag-star-icon)))) + "Custom formats for individual tags. + +This gives a list that maps from tag names to lists of formatting +expressions. The car of each element gives a tag name and the +cdr gives a list of Elisp expressions that modify the tag. If +the list is empty, the tag will simply be hidden. Otherwise, +each expression will be evaluated in order: for the first +expression, the variable `tag' will be bound to the tag name; for +each later expression, the variable `tag' will be bound to the +result of the previous expression. In this way, each expression +can build on the formatting performed by the previous expression. +The result of the last expression will displayed in place of the +tag. + +For example, to replace a tag with another string, simply use +that string as a formatting expression. To change the foreground +of a tag to red, use the expression + (propertize tag 'face '(:foreground \"red\")) + +See also `notmuch-tag-format-image', which can help replace tags +with images." + + :group 'notmuch-search + :group 'notmuch-show + :type '(alist :key-type (string :tag "Tag") + :extra-offset -3 + :value-type + (radio :format "%v" + (const :tag "Hidden" nil) + (set :tag "Modified" + (string :tag "Display as") + (list :tag "Face" :extra-offset -4 + (const :format "" :inline t + (propertize tag 'face)) + (list :format "%v" + (const :format "" quote) + custom-face-edit)) + (list :format "%v" :extra-offset -4 + (const :format "" :inline t + (notmuch-tag-format-image-data tag)) + (choice :tag "Image" + (const :tag "Star" + (notmuch-tag-star-icon)) + (const :tag "Empty star" + (notmuch-tag-star-empty-icon)) + (const :tag "Tag" + (notmuch-tag-tag-icon)) + (string :tag "Custom"))) + (sexp :tag "Custom"))))) + +(defun notmuch-tag-format-image-data (tag data) + "Replace TAG with image DATA, if available. + +This function returns a propertized string that will display image +DATA in place of TAG.This is designed for use in +`notmuch-tag-formats'. + +DATA is the content of an SVG picture (e.g., as returned by +`notmuch-tag-star-icon')." + (propertize tag 'display + `(image :type svg + :data ,data + :ascent center + :mask heuristic))) + +(defun notmuch-tag-star-icon () + "Return SVG data representing a star icon. +This can be used with `notmuch-tag-format-image-data'." +" + + + + +") + +(defun notmuch-tag-star-empty-icon () + "Return SVG data representing an empty star icon. +This can be used with `notmuch-tag-format-image-data'." + " + + + + +") + +(defun notmuch-tag-tag-icon () + "Return SVG data representing a tag icon. +This can be used with `notmuch-tag-format-image-data'." + " + + + + +") + +(defun notmuch-tag-format-tag (tag) + "Format TAG by looking into `notmuch-tag-formats'." + (let ((formats (assoc tag notmuch-tag-formats))) + (cond + ((null formats) ;; - Tag not in `notmuch-tag-formats', + tag) ;; the format is the tag itself. + ((null (cdr formats)) ;; - Tag was deliberately hidden, + nil) ;; no format must be returned + (t ;; - Tag was found and has formats, + (let ((tag tag)) ;; we must apply all the formats. + (dolist (format (cdr formats) tag) + (setq tag (eval format)))))))) + +(defun notmuch-tag-format-tags (tags) + "Return a string representing formatted TAGS." + (notmuch-combine-face-text-property-string + (mapconcat #'identity + ;; nil indicated that the tag was deliberately hidden + (delq nil (mapcar #'notmuch-tag-format-tag tags)) + " ") + 'notmuch-tag-face + t)) + (defcustom notmuch-before-tag-hook nil "Hooks that are run before tags of a message are modified. diff --git a/emacs/notmuch.el b/emacs/notmuch.el index c98a4fe..e58c51d 100644 --- a/emacs/notmuch.el +++ b/emacs/notmuch.el @@ -797,9 +797,8 @@ non-authors is found, assume that all of the authors match." (notmuch-search-insert-authors format-string (plist-get result :authors))) ((string-equal field "tags") - (let ((tags-str (mapconcat 'identity (plist-get result :tags) " "))) - (insert (propertize (format format-string tags-str) - 'face 'notmuch-tag-face)))))) + (let ((tags (plist-get result :tags))) + (insert (format format-string (notmuch-tag-format-tags tags))))))) (defun notmuch-search-show-result (result &optional pos) "Insert RESULT at POS or the end of the buffer if POS is null." -- 1.7.10.4