From 3a632fa201b782faa61b994572bbe2bdc2b85110 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Thu, 6 Aug 2015 15:35:44 +0200 Subject: [PATCH] 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. --- lisp/org-colview.el | 23 ++++++++++++++---- lisp/org.el | 59 +++++++++++++++++++++++---------------------- 2 files changed, 48 insertions(+), 34 deletions(-) diff --git a/lisp/org-colview.el b/lisp/org-colview.el index 251f42520..b43c2040e 100644 --- a/lisp/org-colview.el +++ b/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) diff --git a/lisp/org.el b/lisp/org.el index 9dde1a1c8..32d7b6a43 100755 --- a/lisp/org.el +++ b/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)