From 94effa8f5240de8a6c932647bc83635251fe746a Mon Sep 17 00:00:00 2001 From: Damien Cassou Date: Sat, 23 Mar 2013 12:29:54 +0100 Subject: [PATCH] [PATCH 2/2] emacs: possibility to customize the rendering of tags --- 7e/470a70ca7a313bd5126521bb045b158721c8c5 | 286 ++++++++++++++++++++++ 1 file changed, 286 insertions(+) create mode 100644 7e/470a70ca7a313bd5126521bb045b158721c8c5 diff --git a/7e/470a70ca7a313bd5126521bb045b158721c8c5 b/7e/470a70ca7a313bd5126521bb045b158721c8c5 new file mode 100644 index 000000000..f83044685 --- /dev/null +++ b/7e/470a70ca7a313bd5126521bb045b158721c8c5 @@ -0,0 +1,286 @@ +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 + -- 2.26.2