From fbeecd6ca820ce29f60891b472194361f1626e36 Mon Sep 17 00:00:00 2001 From: Austin Clements Date: Tue, 26 Mar 2013 10:22:37 +2000 Subject: [PATCH] Re: [PATCH 2/2] emacs: possibility to customize the rendering of tags --- db/0616f5f11ce82ae576c3dfcb05b2b83603031a | 337 ++++++++++++++++++++++ 1 file changed, 337 insertions(+) create mode 100644 db/0616f5f11ce82ae576c3dfcb05b2b83603031a diff --git a/db/0616f5f11ce82ae576c3dfcb05b2b83603031a b/db/0616f5f11ce82ae576c3dfcb05b2b83603031a new file mode 100644 index 000000000..08ac6b75b --- /dev/null +++ b/db/0616f5f11ce82ae576c3dfcb05b2b83603031a @@ -0,0 +1,337 @@ +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 2D568431FB6 + for ; Mon, 25 Mar 2013 07:22:43 -0700 (PDT) +X-Virus-Scanned: Debian amavisd-new at olra.theworths.org +X-Spam-Flag: NO +X-Spam-Score: -0.7 +X-Spam-Level: +X-Spam-Status: No, score=-0.7 tagged_above=-999 required=5 + tests=[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 C5fm8VpjgJun for ; + Mon, 25 Mar 2013 07:22:42 -0700 (PDT) +Received: from dmz-mailsec-scanner-7.mit.edu (DMZ-MAILSEC-SCANNER-7.MIT.EDU + [18.7.68.36]) + by olra.theworths.org (Postfix) with ESMTP id C2E21431FAF + for ; Mon, 25 Mar 2013 07:22:41 -0700 (PDT) +X-AuditID: 12074424-b7f936d0000008eb-11-51505db11670 +Received: from mailhub-auth-2.mit.edu ( [18.7.62.36]) + by dmz-mailsec-scanner-7.mit.edu (Symantec Messaging Gateway) with SMTP + id 32.13.02283.1BD50515; Mon, 25 Mar 2013 10:22:41 -0400 (EDT) +Received: from outgoing.mit.edu (OUTGOING-AUTH-1.MIT.EDU [18.9.28.11]) + by mailhub-auth-2.mit.edu (8.13.8/8.9.2) with ESMTP id r2PEMd3d002348; + Mon, 25 Mar 2013 10:22:40 -0400 +Received: from awakening.csail.mit.edu (awakening.csail.mit.edu [18.26.4.91]) + (authenticated bits=0) + (User authenticated as amdragon@ATHENA.MIT.EDU) + by outgoing.mit.edu (8.13.8/8.12.4) with ESMTP id r2PEMbLa025826 + (version=TLSv1/SSLv3 cipher=DHE-RSA-AES128-SHA bits=128 verify=NOT); + Mon, 25 Mar 2013 10:22:38 -0400 +Received: from amthrax by awakening.csail.mit.edu with local (Exim 4.80) + (envelope-from ) + id 1UK8IH-0005in-BZ; Mon, 25 Mar 2013 10:22:37 -0400 +Date: Mon, 25 Mar 2013 10:22:37 -0400 +From: Austin Clements +To: Damien Cassou +Subject: Re: [PATCH 2/2] emacs: possibility to customize the rendering of tags +Message-ID: <20130325142237.GB32584@mit.edu> +References: <1364038194-19856-1-git-send-email-damien.cassou@gmail.com> + <1364038194-19856-3-git-send-email-damien.cassou@gmail.com> +MIME-Version: 1.0 +Content-Type: text/plain; charset=iso-8859-1 +Content-Disposition: inline +Content-Transfer-Encoding: 8bit +In-Reply-To: <1364038194-19856-3-git-send-email-damien.cassou@gmail.com> +User-Agent: Mutt/1.5.21 (2010-09-15) +X-Brightmail-Tracker: + H4sIAAAAAAAAA+NgFlrOKsWRmVeSWpSXmKPExsUixG6norsxNiDQ4ON2Lotdd7cyWVy/OZPZ + gclj56y77B7PVt1iDmCK4rJJSc3JLEst0rdL4MrYdKyk4E5IxaPmMywNjG+cuxg5OSQETCTu + XN/OBmGLSVy4tx7I5uIQEtjHKHHzTwMzhLORUeLdrHksEM5pJol58yYzQThLGCUu7V0C1s8i + oCox68UDRhCbTUBDYtv+5WC2iIC2xJulHawgNrOAtMS3381MILawgJ/Ewx8nwWxeAR2J49ef + MoPYQgKtjBI791lBxAUlTs58wgLRqyOxc+sdoF0cYHOW/+OACMtLNG+dDdbKKeAhcefCPbBV + ogIqElNObmObwCg8C8mkWUgmzUKYNAvJpAWMLKsYZVNyq3RzEzNzilOTdYuTE/PyUot0zfVy + M0v0UlNKNzGC48BFZQdj8yGlQ4wCHIxKPLwbggMChVgTy4orcw8xSnIwKYnyloYDhfiS8lMq + MxKLM+KLSnNSiw8xSnAwK4nwagkB5XhTEiurUovyYVLSHCxK4rzXU276CwmkJ5akZqemFqQW + wWRlODiUJHg/xgA1ChalpqdWpGXmlCCkmTg4QYbzAA1/DVLDW1yQmFucmQ6RP8Woy/F13udX + jEIsefl5qVLivOdBigRAijJK8+DmwNLXK0ZxoLeEef+AVPEAUx/cpFdAS5iAlkz96w+ypCQR + ISXVwGiwlkMr6NXa1p/bw2fLlFtGPd17aXKEZ07X9mOmj6K+c/zgttrHsNig4XO8BIPuqfMC + 5myq54MXbYpzPzr1hafZpm7f+AWTtXbMmT0tKc/kvn7wNiaDzQFnyh+vadPQLHrw+kb3eYvp + E1fdemgQEtd/JfXaHyf2Tb/npi0N8+2Q7IwM/lT5fp4SS3FGoqEWc1FxIgAgBc4/OgMAAA== +Cc: notmuch@notmuchmail.org +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, 25 Mar 2013 14:22:43 -0000 + +Series LGTM. I noticed a few things below that would be fine to tweak +in a follow-up trivial patch or two. + +Quoth Damien Cassou on Mar 23 at 12:29 pm: +> 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 + +Missing spaces after the period. + +> +`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 () + +Should these be notmuch-tag-icon-{star,star-empty,tag}? That would +better match standard naming conventions (most general term to least +general term) and would avoid the awkward notmuch-tag-tag-icon. + +> + "Return SVG data representing a star icon. +> +This can be used with `notmuch-tag-format-image-data'." +> +" +> + +> + +> + + d=\"m 290.25762,334.31206 -17.64143,-11.77975 -19.70508,7.85447 5.75171,-20.41814 -13.55925,-16.31348 21.19618,-0.83936 11.325,-17.93675 7.34825,19.89939 20.55849,5.22795 -16.65471,13.13786 z\" +> + transform=\"matrix(0.2484147,-0.02623394,0.02623394,0.2484147,174.63605,255.37691)\" +> + style=\"fill:#ffff00;fill-rule:evenodd;stroke:#000000;stroke-width:1px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1\" /> + +Here's an even simpler equivalent SVG: + + + + + + +I pre-applied the transformations and removed the style attributes +that had default or unimportant values. (The script to do the path +math is attached.) + +> + +> +") +> + +> +(defun notmuch-tag-star-empty-icon () +> + "Return SVG data representing an empty star icon. +> +This can be used with `notmuch-tag-format-image-data'." +> + " +> + +> + +> + + d=\"m 290.25762,334.31206 -17.64143,-11.77975 -19.70508,7.85447 5.75171,-20.41814 -13.55925,-16.31348 21.19618,-0.83936 11.325,-17.93675 7.34825,19.89939 20.55849,5.22795 -16.65471,13.13786 z\" +> + transform=\"matrix(0.2484147,-0.02623394,0.02623394,0.2484147,174.63605,255.37691)\" +> + style=\"fill:#d6d6d1;fill-opacity:1;fill-rule:evenodd;stroke:#000000;stroke-width:1px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1\" /> +> + +> +") + + + + + + +> + +> +(defun notmuch-tag-tag-icon () +> + "Return SVG data representing a tag icon. +> +This can be used with `notmuch-tag-format-image-data'." +> + " +> + +> + +> + + d=\"m 0.44642857,1040.9336 12.50000043,0 2.700893,3.6161 -2.700893,3.616 -12.50000043,0 z\" +> + style=\"fill:#ffff00;fill-opacity:1;fill-rule:evenodd;stroke:#000000;stroke-width:0.25;stroke-linecap:butt;stroke-linejoin:miter;stroke-miterlimit:4;stroke-opacity:1\" /> +> + +> +") + + + + + + +> + +> +(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." -- 2.26.2