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."