Implement a simpler way to specify faces for tags and todo keywords

This is a patch by Ryan Thompson, extended by Carsten Dominik.

6 files changed, 94 insertions, 29 deletions

diff --git a/doc/ChangeLog b/doc/ChangeLog
index a4938fe..633058c 100644
--- a/doc/ChangeLog
+++ b/doc/ChangeLog
@@ -1,3 +1,8 @@
+2010-02-25  Carsten Dominik  <carsten.dominik@gmail.com>
+
+	* org.texi (Faces for TODO keywords, Faces for TODO keywords)
+	(Priorities): Document the easy colors.
+
 2010-02-19  Carsten Dominik  <carsten.dominik@gmail.com>
 
 	* org.texi (Visibility cycling): Document the new double prefix
diff --git a/doc/org.texi b/doc/org.texi
index 19583d9..3633dc8 100644
--- a/doc/org.texi
+++ b/doc/org.texi
@@ -3454,15 +3454,16 @@ special faces for some of them.  This can be done using the variable
 @lisp
 @group
 (setq org-todo-keyword-faces
-      '(("TODO"      . org-warning)
-        ("DEFERRED"  . shadow)
-        ("CANCELED"  . (:foreground "blue" :weight bold))))
+      '(("TODO" . org-warning) ("STARTED" . "yellow")
+        ("CANCELED" . (:foreground "blue" :weight bold))))
 @end group
 @end lisp
 
-While using a list with face properties as shown for CANCELED
-@emph{should} work, this does not aways seem to be the case.  If
-necessary, define a special face and use that.
+While using a list with face properties as shown for CANCELED @emph{should}
+work, this does not aways seem to be the case.  If necessary, define a
+special face and use that.  A string is interpreted as a color.  The variable
+@code{org-faces-easy-properties} determines if that color is interpreted as a
+foreground or a background color.
 
 @node TODO dependencies,  , Faces for TODO keywords, TODO extensions
 @subsection TODO dependencies
@@ -3767,11 +3768,13 @@ this
 @end example
 
 @noindent
+@vindex org-priority-faces
 By default, Org mode supports three priorities: @samp{A}, @samp{B}, and
-@samp{C}.  @samp{A} is the highest priority.  An entry without a cookie
-is treated as priority @samp{B}.  Priorities make a difference only in
-the agenda (@pxref{Weekly/daily agenda}); outside the agenda, they have
-no inherent meaning to Org mode.
+@samp{C}.  @samp{A} is the highest priority.  An entry without a cookie is
+treated as priority @samp{B}.  Priorities make a difference only in the
+agenda (@pxref{Weekly/daily agenda}); outside the agenda, they have no
+inherent meaning to Org mode.  The cookies can be highlighted with special
+faces by customizing the variable @code{org-priority-faces}.
 
 Priorities can be attached to any outline tree entries; they do not need
 to be TODO items.
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 70605a1..eb9b8fd 100755
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,7 +1,16 @@
 2010-02-25  Carsten Dominik  <carsten.dominik@gmail.com>
 
+	* org.el (org-face-from-face-or-color): New function.
+	(org-get-todo-face, org-font-lock-add-priority-faces)
+	(org-get-tag-face): Use `org-face-from-face-or-color'.
+
+	* org-faces.el (org-todo-keyword-faces, org-priority-faces): Allow
+	simple colors as values.
+	(org-faces-easy-properties): New option.
+
 	* org-agenda.el (org-agenda-set-mode-name): Show if the agenda is
 	restricted, as an agenda mode.
+	(org-agenda-fontify-priorities): Allow simple colors as values.
 
 2010-02-25  Bastien Guerry  <bzg@altern.org>
 
diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el
index d1cebad..514634f 100644
--- a/lisp/org-agenda.el
+++ b/lisp/org-agenda.el
@@ -1349,8 +1349,10 @@ cookies, not the entire task.
 This may also be an association list of priority faces, whose
 keys are the character values of `org-highest-priority',
 `org-default-priority', and `org-lowest-priority' (the default values
-are ?A, ?B, and ?C, respectively).  The face may be a named face,
-or a list like `(:background \"Red\")'."
+are ?A, ?B, and ?C, respectively).  The face may be a named face, a
+color as a string, or a list like `(:background \"Red\")'.
+If it is a color, the variable `org-faces-easy-properties'
+determines if it is a foreground or a background color."
   :group 'org-agenda-line-format
   :type '(choice
 	  (const :tag "Never" nil)
@@ -1358,7 +1360,9 @@ or a list like `(:background \"Red\")'."
 	  (const :tag "Cookies only" cookies)
 	  (repeat :tag "Specify"
 		  (list (character :tag "Priority" :value ?A)
-			(sexp :tag "face")))))
+			(choice    :tag "Face    "
+				   (string :tag "Color")
+				   (sexp :tag "Face"))))))
 
 (defgroup org-agenda-column-view nil
   "Options concerning column view in the agenda."
@@ -2790,9 +2794,13 @@ bind it in the options section.")
 	      ov (org-make-overlay b e))
 	(org-overlay-put
 	 ov 'face
-	 (cond ((cdr (assoc p org-priority-faces)))
+	 (cond ((org-face-from-face-or-color
+		 'priority nil
+		 (cdr (assoc p org-priority-faces))))
 	       ((and (listp org-agenda-fontify-priorities)
-		     (cdr (assoc p org-agenda-fontify-priorities))))
+		     (org-face-from-face-or-color
+		      'priority nil
+		      (cdr (assoc p org-agenda-fontify-priorities)))))
 	       ((equal p l) 'italic)
 	       ((equal p h) 'bold)))
 	(org-overlay-put ov 'org-type 'org-priority)))))
diff --git a/lisp/org-faces.el b/lisp/org-faces.el
index 4921f6c..e336b3c 100644
--- a/lisp/org-faces.el
+++ b/lisp/org-faces.el
@@ -338,29 +338,53 @@ This face is only used if `org-fontify-done-headline' is set.  If applies
 to the part of the headline after the DONE keyword."
   :group 'org-faces)
 
+(defcustom org-faces-easy-properties
+  '((todo . :foreground) (tag . :foreground) (priority . :foreground))
+  "The property changes by easy faces.
+This is an alist, the keys show the area of application, the values
+can be `:foreground' or `:background'.  A color string for special
+keywords will then be interpreted as either foreground or background
+color."
+  :group 'org-faces
+  :group 'org-todo
+  :type '(repeat
+	  (cons (choice (const todo) (const tag) (const priority))
+		(choice (const :foreground) (const :background)))))
+
 (defcustom org-todo-keyword-faces nil
   "Faces for specific TODO keywords.
 This is a list of cons cells, with TODO keywords 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)."
+and faces in the cdr.  The face can be a symbol, a color
+as a string (in which case the rest is inherited from the `org-todo' face),
+or a property list of attributes, like
+   (:foreground \"blue\" :weight bold :underline t).
+If it is a color string, the variable `org-faces-easy-properties'
+determines if it is a foreground or a background color."
   :group 'org-faces
   :group 'org-todo
   :type '(repeat
 	  (cons
-	   (string :tag "keyword")
-	   (sexp :tag "face"))))
+	   (string :tag "Keyword")
+	   (choice :tag "Face   "
+	    (string :tag "Color")
+	    (sexp :tag "Face")))))
 
 (defcustom org-priority-faces nil
   "Faces for specific Priorities.
 This is a list of cons cells, with priority character 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)."
+and faces in the cdr.  The face can be a symbol, a color as
+as a string, or a property list of attributes, like
+    (:foreground \"blue\" :weight bold :underline t).
+If it is a color string, the variable `org-faces-easy-properties'
+determines if it is a foreground or a background color."
   :group 'org-faces
   :group 'org-todo
   :type '(repeat
 	  (cons
 	   (character :tag "Priority")
-	   (sexp :tag "face"))))
+	   (choice    :tag "Face    "
+	    (string :tag "Color")
+	    (sexp :tag "Face")))))
 
 (defvar org-tags-special-faces-re nil)
 (defun org-set-tag-faces (var value)
@@ -386,7 +410,8 @@ list of attributes, like (:foreground \"blue\" :weight bold :underline t)."
 (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,
+The face can be a symbol, a foreground color (in which case the rest is
+inherited from the `org-tag' face) 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.
@@ -397,8 +422,10 @@ changes."
   :set 'org-set-tag-faces
   :type '(repeat
 	  (cons
-	   (string :tag "Tag")
-	   (sexp :tag "Face"))))
+	   (string :tag "Tag ")
+	   (choice :tag "Face"
+	    (string :tag "Foreground color")
+	    (sexp :tag "Face")))))
 
 (defface org-table ;; originally copied from font-lock-function-name-face
   (org-compatible-face nil
diff --git a/lisp/org.el b/lisp/org.el
index 329655b..1368405 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -5060,10 +5060,20 @@ For plain list items, if they are matched by `outline-regexp', this returns
   "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-todo-keyword-faces))
+  (or (org-face-from-face-or-color
+       'todo 'org-todo (cdr (assoc kwd org-todo-keyword-faces)))
       (and (member kwd org-done-keywords) 'org-done)
       'org-todo))
 
+(defun org-face-from-face-or-color (context inherit face-or-color)
+  "Create a face list that inherits INHERIT, but sets the foreground color.
+When FACE-OR-COLOR is not a string, just return it."
+  (if (stringp face-or-color)
+      (list :inherit inherit
+	    (cdr (assoc context org-faces-easy-properties))
+	    face-or-color)
+    face-or-color))
+
 (defun org-font-lock-add-tag-faces (limit)
   "Add the special tag faces."
   (when (and org-tag-faces org-tags-special-faces-re)
@@ -5078,8 +5088,10 @@ If KWD is a number, get the corresponding match group."
   (while (re-search-forward "\\[#\\([A-Z0-9]\\)\\]" limit t)
     (add-text-properties
      (match-beginning 0) (match-end 0)
-     (list 'face (or (cdr (assoc (char-after (match-beginning 1))
-				 org-priority-faces))
+     (list 'face (or (org-face-from-face-or-color
+		      'priority 'org-special-keyword
+		      (cdr (assoc (char-after (match-beginning 1))
+				  org-priority-faces)))
 		     'org-special-keyword)
 	   'font-lock-fontified t))))
 
@@ -5087,7 +5099,8 @@ If KWD is a number, get the corresponding match group."
   "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))
+  (or (org-face-from-face-or-color
+       'tag 'org-tag (cdr (assoc kwd org-tag-faces)))
       'org-tag))
 
 (defun org-unfontify-region (beg end &optional maybe_loudly)