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 <damien.cassou@gmail.com>
> ---
> 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 <http://www.gnu.org/licenses/>.
> ;;
> ;; Authors: Carl Worth <cworth@cworth.org>
> +;; Damien Cassou <damien.cassou@gmail.com>
> +;;
> +;;; 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'."
> +"<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"no\"?>
> +<svg version=\"1.1\" width=\"16\" height=\"16\">
> + <g transform=\"translate(-242.81601,-315.59635)\">
> + <path
> + 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:
<?xml version="1.0" encoding="UTF-8" standalone="no"?>
<svg version="1.1" width="16" height="16">
<path
d="M 12.69462,15.21399 8.00320,12.75053 3.31422,15.21864 4.20739,9.99558 0.41110,6.29879 5.65452,5.53422 7.99727,0.78137 10.34472,5.53189 15.58890,6.29126 11.79629,9.99182 z"
style="fill:#ffff00;stroke:#000000;stroke-width:0.25" />
</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.)
> + </g>
> +</svg>")
> +
> +(defun notmuch-tag-star-empty-icon ()
> + "Return SVG data representing an empty star icon.
> +This can be used with `notmuch-tag-format-image-data'."
> + "<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"no\"?>
> +<svg version=\"1.1\" width=\"16\" height=\"16\">
> + <g transform=\"translate(-242.81601,-315.59635)\">
> + <path
> + 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\" />
> + </g>
> +</svg>")
<?xml version="1.0" encoding="UTF-8" standalone="no"?>
<svg version="1.1" width="16" height="16">
<path
d="M 12.69462,15.21399 8.00320,12.75053 3.31422,15.21864 4.20739,9.99558 0.41110,6.29879 5.65452,5.53422 7.99727,0.78137 10.34472,5.53189 15.58890,6.29126 11.79629,9.99182 z"
style="fill:#d6d6d1;stroke:#000000;stroke-width:0.25" />
</svg>
> +
> +(defun notmuch-tag-tag-icon ()
> + "Return SVG data representing a tag icon.
> +This can be used with `notmuch-tag-format-image-data'."
> + "<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"no\"?>
> +<svg version=\"1.1\" width=\"16\" height=\"16\">
> + <g transform=\"translate(0,-1036.3622)\">
> + <path
> + 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\" />
> + </g>
> +</svg>")
<?xml version="1.0" encoding="UTF-8" standalone="no"?>
<svg version="1.1" width="16" height="16">
<path
d="M 0.44643,4.57140 12.94643,4.57140 15.64732,8.18750 12.94643,11.80350 0.44643,11.80350 z"
style="fill:#ffff00;stroke:#000000;stroke-width:0.25" />
</svg>
> +
> +(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."