[PATCH 3/4] emacs: possibility to customize the rendering of tags

[Austin Clements]

On Fri, 18 Jan 2013, Damien Cassou <damien.cassou at gmail.com> wrote:
> This patch extracts the rendering of tags in notmuch-show to a
> dedicated notmuch-tagger file.
>
> This new file introduces a `notmuch-tagger-formats' variable that
> associates each tag to a particular format. For example,
>
> (("unread"
>   (:propertize "unread" face
>                (:foreground "red")))
>  ("flagged"
>   (:propertize "flagged" display
>                (image :type svg :file "~/notmuch/emacs/resources/star.svg" :ascent center :mask heuristic))))
>
> associates a red font to the "unread" tag and a star picture to
> the "flagged" tag.
>
> In the future, I would like to use the Customization interface of
> Emacs to edit this variable and also to provide high-lever

s/lever/level/

> functions to manipulate it such
> that (notmuch-tagger-propertize "unread" :foreground "red")
> and (notmuch-tagger-picture "flagged" "star.svg").
>
> `mode-line-format' templates are used to represent the format for
> each tag. This is a concize format that can also be used in

"concise"?

> `header-line-format' if later desired.
>
> Signed-off-by: Damien Cassou <damien.cassou at gmail.com>
> ---
>  emacs/notmuch-show.el   |    7 ++---
>  emacs/notmuch-tagger.el |   75 +++++++++++++++++++++++++++++++++++++++++++++++
>  emacs/notmuch.el        |    5 ++--
>  3 files changed, 80 insertions(+), 7 deletions(-)
>  create mode 100644 emacs/notmuch-tagger.el
>
> diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el
> index 1864dd1..7bf9f3c 100644
> --- a/emacs/notmuch-show.el
> +++ b/emacs/notmuch-show.el
> @@ -36,6 +36,7 @@
>  (require 'notmuch-mua)
>  (require 'notmuch-crypto)
>  (require 'notmuch-print)
> +(require 'notmuch-tagger)
>  
>  (declare-function notmuch-call-notmuch-process "notmuch" (&rest args))
>  (declare-function notmuch-fontify-headers "notmuch" nil)
> @@ -362,8 +363,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-tagger-present-tags tags)
>  				 ")"))))))
>  
>  (defun notmuch-clean-address (address)
> @@ -441,8 +441,7 @@ message at DEPTH in the current thread."
>  	    " ("
>  	    date
>  	    ") ("
> -	    (propertize (mapconcat 'identity tags " ")
> -			'face 'notmuch-tag-face)
> +	    (notmuch-tagger-present-tags tags)
>  	    ")\n")
>      (overlay-put (make-overlay start (point)) 'face 'notmuch-message-summary-face)))
>  
> diff --git a/emacs/notmuch-tagger.el b/emacs/notmuch-tagger.el
> new file mode 100644
> index 0000000..90730f6
> --- /dev/null
> +++ b/emacs/notmuch-tagger.el
> @@ -0,0 +1,75 @@
> +;; notmuch-tagger.el --- Library to improve the way tags are displayed

The verb-er naming scheme made sense when this wasn't part of notmuch,
but it seems to needlessly (and confusingly) set it apart from standard
notmuch functionality.  Any thoughts on including this straight in
notmuch-tag.el (and adding your author and copyright to that file, of
course)?

> +;;
> +;; Copyright © Damien Cassou
> +;;
> +;; This file is part of Notmuch.
> +;;
> +;; Notmuch is free software: you can redistribute it and/or modify it
> +;; under the terms of the GNU General Public License as published by
> +;; the Free Software Foundation, either version 3 of the License, or
> +;; (at your option) any later version.
> +;;
> +;; Notmuch is distributed in the hope that it will be useful, but
> +;; WITHOUT ANY WARRANTY; without even the implied warranty of
> +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
> +;; General Public License for more details.
> +;;
> +;; You should have received a copy of the GNU General Public License
> +;; along with Notmuch.  If not, see <http://www.gnu.org/licenses/>.
> +;;
> +;; Authors: Damien Cassou <damien.cassou at gmail.com>
> +;;; Commentary:

Since there is no commentary, you should leave out this header section.

> +;;
> +;;; Comments

I'm not sure what this is, but it should probably also be omitted.

> +;;
> +;;; Code:
> +;;
> +
> +(require 'cl)
> +
> +(defvar notmuch-tagger-formats

notmuch-tag-formats?

> +  `(("unread"
> +     (:propertize "unread" face
> +                  (:Foreground "red")))
> +    ("flagged"
> +     (:propertize "flagged" display
> +                  (image :type svg :file
> +                         ,(expand-file-name
> +                           "resources/star.svg"
> +                           (file-name-directory
> +                            (or
> +                             (locate-library "notmuch-tagger")
> +                             (buffer-file-name))))

Interesting.  Is this a standard way to locate resources?  (I've never
had need to.)

Since there are other icons here as well, perhaps the resources
directory should be bound to a global variable so it's easy to construct
other standard notmuch icon names?  You capture this in a function in
patch 4, but that function doesn't obviously accomplish anything a
simple variable wouldn't.

Another possibility is that these icons could be included directly in
the Elisp source, probably as simplified SVGs (your SVGs look like they
could be cut down to 3 or 4 lines of XML easily) or as XPMs.  Besides
skirting issues with resource location, this would make it trivial to
alter their colors based on user preferences.

> +                         :ascent center :mask heuristic))))
> +  "Contains pairs of (KEY FORMAT) to format a tag matching KEY.
> +
> +KEY must be a string with a tag name. In the future, KEY could
> +also be a regexp or list of keys to be matched against tags.

This "in the future" comment doesn't really belong in a doc string,
though it would make sense as a source comment in
`notmuch-tagger-tag-format'.

> +
> +The default value set the unread tag to be red and the flagged
> +tag to have a star picture attached. Those are just examples so
> +you get an idea of what you can do.")
> +
> +(defun notmuch-tagger-tag-format (tag)
> +  "Format TAG as a `mode-line-format' template.

This makes it sounds like this function actually formats the template,
which it doesn't.  Perhaps

  Return a `mode-line-format' template for tag TAG.

and call it notmuch-tag-get-format?

> +
> +The format to apply to TAG is searched in
> +`notmuch-tagger-formats'. If not found, the default
> +`notmuch-tag-face' is used."
> +  (let ((match (assoc tag notmuch-tagger-formats)))
> +    (if match
> +        (cadr match)
> +      `(:propertize ,tag face notmuch-tag-face))))

This changes how we use notmuch-tag-face.  For example, currently, if
notmuch-tag-face has a background color, it will apply to the whole tag
list, including the spaces between tags.  With this, it will only apply
to the individual tags.  Also, if a tag does have a format, it will
completely override notmuch-tag-face, rather than combining with it,
which I think is undesirable.  Fixing this is a little tricky because
Emacs makes it a pain to combine faces, but
notmuch-combine-face-text-property already mostly implements this.  I'd
suggest simply returning tag in the alternate case above (in which case
you can simplify the above function down to just
 (assoc-default tag notmuch-tag-formats nil tag)
) and replacing the propertize calls that used to apply notmuch-tag-face
with calls to this updated notmuch-combine-face-text-property:

(defun notmuch-combine-face-text-property (start end face &optional below object)
  "Combine FACE into the 'face text property between START and END.

This function combines FACE with any existing faces between START
and END in OBJECT (which defaults to the current buffer).
Attributes specified by FACE take precedence over existing
attributes unless BELOW is non-nil.  FACE must be a face name (a
symbol or string), a property list of face attributes, or a list
of these.  For convenience when applied to strings, this returns
OBJECT."

  (let ((pos start))
    (while (< pos end)
      (let* ((cur (get-text-property pos 'face object))
	     (next (next-single-property-change pos 'face object end))
	     (new (if below
		      (append cur (list face))
		    (cons face cur))))
	(put-text-property pos next 'face new object)
	(setq pos next))))
  object)

The new BELOW argument will let faces applied by tag formats override
notmuch-tag-face even though notmuch-tag-face is applied afterward, and
the new OBJECT argument will let this operate on strings.

> +
> +(defun notmuch-tagger-tags-format (tags)
> +  "Format TAGS as a `mode-line-format' template."

Same comment here.  Perhaps notmuch-tag-list-get-format and

  Return a `mode-line-format' template for tag list TAGS.

> +  (notmuch-intersperse
> +   (remove nil (mapcar #'notmuch-tagger-tag-format tags))

The remove nil would be worth a comment.  It took me a long time to
figure out that this was because tags can be hidden by formatting them
as nil (which makes sense in retrospect).

> +   " "))
> +
> +(defun notmuch-tagger-present-tags (tags)

This doesn't actually present the tags.  If you like the renaming I
suggested above, it would make sense to call this
notmuch-tag-format-tag-list, since it actually does the formatting.

> +  "Return a string that represent TAGS with their format."
> +  (format-mode-line (notmuch-tagger-tags-format tags)))
> +
> +(provide 'notmuch-tagger)
> +;;; notmuch-tagger.el ends here
> diff --git a/emacs/notmuch.el b/emacs/notmuch.el
> index c98a4fe..c607905 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-tagger-present-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
>
> _______________________________________________
> notmuch mailing list
> notmuch at notmuchmail.org
> http://notmuchmail.org/mailman/listinfo/notmuch