Browse Source

Fontify priorities, tags and TODO in colview

* lisp/org.el (org-get-priority-face): New function.
(org-font-lock-add-priority-faces): Use new function.

* lisp/org-colview.el (org-columns-new-overlay): Preserve face from
  string to display.
(org-columns-display-here): Apply usual face on TODO keywords, tags and
priorities in the columns overlay.
Nicolas Goaziou 9 years ago
parent
commit
3a632fa201
2 changed files with 48 additions and 34 deletions
  1. 18 5
      lisp/org-colview.el
  2. 30 29
      lisp/org.el

+ 18 - 5
lisp/org-colview.el

@@ -150,7 +150,6 @@ This is the compiled version of the format.")
   "Create a new column overlay and add it to the list."
   (let ((ov (make-overlay beg end)))
     (overlay-put ov 'face (or face 'secondary-selection))
-    (remove-text-properties 0 (length string) '(face nil) string)
     (org-overlay-display ov string face)
     (push ov org-columns-overlays)
     ov))
@@ -206,9 +205,7 @@ This is the compiled version of the format.")
 	       (val (or (cdr ass) ""))
 	       (modval
 		(cond
-		 ((and org-columns-modify-value-for-display-function
-		       (functionp
-			org-columns-modify-value-for-display-function))
+		 ((functionp org-columns-modify-value-for-display-function)
 		  (funcall org-columns-modify-value-for-display-function
 			   title val))
 		 ((equal property "ITEM") (org-columns-compact-links val))
@@ -220,7 +217,23 @@ This is the compiled version of the format.")
 		  (org-columns-number-to-string
 		   (funcall calc (org-columns-string-to-number val fm)) fm))))
 	       (string
-		(format f (org-columns-add-ellipses (or modval val) width)))
+		(format f
+			(let ((v (org-columns-add-ellipses
+				  (or modval val) width)))
+			  (cond
+			   ((equal property "PRIORITY")
+			    (propertize v 'face (org-get-priority-face val)))
+			   ((equal property "TAGS")
+			    (if (not org-tags-special-faces-re)
+				(propertize v 'face 'org-tag)
+			      (replace-regexp-in-string
+			       org-tags-special-faces-re
+			       (lambda (m)
+				 (propertize m 'face (org-get-tag-face m)))
+			       v nil nil 1)))
+			   ((equal property "TODO")
+			    (propertize v 'face (org-get-todo-face val)))
+			   (t v)))))
 	       (ov (org-columns-new-overlay
 		    (point) (1+ (point)) string (if dateline face1 face))))
 	  (overlay-put ov 'keymap org-columns-map)

+ 30 - 29
lisp/org.el

@@ -6500,6 +6500,14 @@ needs to be inserted at a specific position in the font-lock sequence.")
    ((eq n 2) org-f)
    (t (if org-level-color-stars-only nil org-f))))
 
+(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-get-todo-face (kwd)
   "Get the right face for a TODO keyword KWD.
@@ -6510,14 +6518,28 @@ If KWD is a number, get the corresponding match group."
       (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-get-priority-face (priority)
+  "Get the right face for PRIORITY.
+PRIORITY is a character."
+  (or (org-face-from-face-or-color
+       'priority 'org-priority (cdr (assq priority org-priority-faces)))
+      'org-priority))
+
+(defun org-get-tag-face (tag)
+  "Get the right face for TAG.
+If TAG is a number, get the corresponding match group."
+  (let ((tag (if (wholenump tag) (match-string tag) tag)))
+    (or (org-face-from-face-or-color
+	 'tag 'org-tag (cdr (assoc kwd org-tag-faces)))
+	'org-tag)))
+
+(defun org-font-lock-add-priority-faces (limit)
+  "Add the special priority faces."
+  (while (re-search-forward "^\\*+ .*?\\(\\[#\\(.\\)\\]\\)" limit t)
+    (add-text-properties
+     (match-beginning 1) (match-end 1)
+     (list 'face (org-get-priority-face (string-to-char (match-string 2)))
+	   'font-lock-fontified t))))
 
 (defun org-font-lock-add-tag-faces (limit)
   "Add the special tag faces."
@@ -6528,27 +6550,6 @@ When FACE-OR-COLOR is not a string, just return it."
 				 'font-lock-fontified t))
       (backward-char 1))))
 
-(defun org-font-lock-add-priority-faces (limit)
-  "Add the special priority faces."
-  (while (re-search-forward "\\[#\\([A-Z0-9]\\)\\]" limit t)
-    (when (save-match-data (org-at-heading-p))
-      (add-text-properties
-       (match-beginning 0) (match-end 0)
-       (list 'face (or (org-face-from-face-or-color
-			'priority 'org-priority
-			(cdr (assoc (char-after (match-beginning 1))
-				    org-priority-faces)))
-		       'org-priority)
-	     'font-lock-fontified t)))))
-
-(defun org-get-tag-face (tag)
-  "Get the right face for TAG.
-If TAG is a number, get the corresponding match group."
-  (let ((tag (if (wholenump tag) (match-string tag) tag)))
-    (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)
   "Remove fontification and activation overlays from links."
   (font-lock-default-unfontify-region beg end)