Customizable faces for individual tags.

Samuel Wales writes:

> It would be really nice if you could set tags to different
> faces the way you can with todo keywords.
>
> For example, you could set :urgent: to a bright color.  Or
> set a face for all contexts.

This patch add a new customization variable `org-tag-faces' that can
be used to specify such faces.  The rest of the patch implements these
new faces in Org-mode buffers as well as in the agenda.

ORGWEBPAGE/Changes.org

@@ -120,6 +120,14 @@
 (setq org-use-property-inheritance '("LOCATION"))
 #+end_src
 
+*** Special faces can be set for individual tags
+
+    You may now use the variable =org-tag-faces= to define the
+    face used for specific tags, much in the same way as you can
+    do for TODO keywords.
+
+    Thanks to Samuel Wales for this proposal.
+
 * Version 6.13
 
 ** Overview

contrib/lisp/org-mtags.el

@@ -115,7 +115,7 @@ This is relevane when expanding the templates defined in the variable
 In addition to this list, the <br> tag is supported as well.")
 
 (defconst org-mtags-fontification-re
-  (concat 
+  (concat
    "^[ \t]*</?\\("
    (mapconcat 'identity org-mtags-supported-tags "\\|")
    "\\)\\>[^>]*>\\|<br>[ \t]*$")

doc/org.texi

@@ -3440,10 +3440,13 @@ information is to assign @i{tags} to headlines.  Org mode has extensive
 support for tags.
 
 Every headline can contain a list of tags; they occur at the end of the
-headline.  Tags are normal words containing letters, numbers, @samp{_},
-and @samp{@@}.  Tags must be preceded and followed by a single colon,
-e.g., @samp{:work:}.  Several tags can be specified, as in
-@samp{:work:urgent:}.
+headline.  Tags are normal words containing letters, numbers, @samp{_}, and
+@samp{@@}.  Tags must be preceded and followed by a single colon, e.g.,
+@samp{:work:}.  Several tags can be specified, as in @samp{:work:urgent:}.
+Tags will by default get a bold face with the same color as the headline.
+You may specify special faces for specific tags using the variable
+@code{org-tag-faces}, much in the same way as you can do for TODO keywords
+(@pxref{Faces for TODO keywords}).
 
 @menu
 * Tag inheritance::             Tags use the tree structure of the outline

lisp/ChangeLog

@@ -1,3 +1,13 @@
+2008-12-04  Carsten Dominik  <carsten.dominik@gmail.com>
+
+	* org-faces.el (org-set-tag-faces): New function.
+	(org-tags-special-faces-re): New variable.
+
+	* org.el (org-font-lock-add-tag-faces, org-get-tag-face): New functions.
+
+	* org-faces.el (org-tag-faces): New option.
+	(org-tag): Mention `org-tag-faces' in the docstring.
+
 2008-12-03  Carsten Dominik  <carsten.dominik@gmail.com>
 
 	* org-exp.el (org-export-html-style-default): Implement new

lisp/org-agenda.el

@@ -5137,7 +5137,9 @@ the new TODO state."
 	(goto-char (match-beginning 1))
 	(insert (org-add-props
 		    (make-string (max 1 (- c (current-column))) ?\ )
-		    (text-properties-at (point))))))))
+		    (text-properties-at (point)))))
+      (goto-char (point-min))
+      (org-font-lock-add-tag-faces (point-max)))))
 
 (defun org-agenda-priority-up ()
   "Increase the priority of line at point, also in Org-mode file."

lisp/org-faces.el

@@ -269,7 +269,9 @@ column view defines special faces for each outline level.  See the file
 
 (defface org-tag
   '((t (:bold t)))
-  "Face for tags."
+  "Default face for tags.
+Note that the variable `org-tag-faces' can be used to overrule this face for
+specific tags."
   :group 'org-faces)
 
 (defface org-todo ; font-lock-warning-face
@@ -313,6 +315,31 @@ list of attributes, like (:foreground \"blue\" :weight bold :underline t)."
 	   (string :tag "keyword")
 	   (sexp :tag "face"))))
 
+(defvar org-tags-special-faces-re nil)
+(defun org-set-tag-faces (var value)
+  (set var value)
+  (if (not value)
+      (setq org-tags-special-faces-re nil)
+    (setq org-tags-special-faces-re
+	  (concat ":\\(" (mapconcat 'car org-tag-faces "\\|") "\\):"))))
+
+(defcustom org-tag-faces nil
+  "Faces for specific tags.
+This is a list of cons cells, with tags in the car and faces in the cdr.
+The face can be a symbol, or a property list of attributes,
+like (:foreground \"blue\" :weight bold :underline t).
+If you set this variable through customize, it will immediately be effective
+in new buffers and in modified lines.
+If you set it with Lisp, a restart of Emacs is required to activate the
+changes."
+  :group 'org-faces
+  :group 'org-tags
+  :set 'org-set-tag-faces
+  :type '(repeat
+	  (cons
+	   (string :tag "Tag")
+	   (sexp :tag "Face"))))
+
 (defface org-table ;; originally copied from font-lock-function-name-face
   (org-compatible-face nil
     '((((class color) (min-colors 88) (background light)) (:foreground "Blue1"))

lisp/org.el

@@ -3943,6 +3943,8 @@ between words."
 	     nil)
 	   ;; Priorities
 	   (list (concat "\\[#[A-Z0-9]\\]") '(0 'org-special-keyword t))
+	   ;; Tags
+	   '(org-font-lock-add-tag-faces)
 	   ;; Special keywords
 	   (list (concat "\\<" org-deadline-string) '(0 'org-special-keyword t))
 	   (list (concat "\\<" org-scheduled-string) '(0 'org-special-keyword t))
@@ -4002,6 +4004,22 @@ If KWD is a number, get the corresponding match group."
       (and (member kwd org-done-keywords) 'org-done)
       'org-todo))
 
+(defun org-font-lock-add-tag-faces (limit)
+  "Add the special tag faces."
+  (when (and org-tag-faces org-tags-special-faces-re)
+    (while (re-search-forward org-tags-special-faces-re limit t)
+      (add-text-properties (match-beginning 1) (match-end 1)
+			   (list 'face (org-get-tag-face 1)
+				 'font-lock-fontified t))
+      (backward-char 1))))
+
+(defun org-get-tag-face (kwd)
+  "Get the right face for a TODO keyword KWD.
+If KWD is a number, get the corresponding match group."
+  (if (numberp kwd) (setq kwd (match-string kwd)))
+  (or (cdr (assoc kwd org-tag-faces))
+      'org-tag))
+
 (defun org-unfontify-region (beg end &optional maybe_loudly)
   "Remove fontification and activation overlays from links."
   (font-lock-default-unfontify-region beg end)