branch: externals/org
commit 4b7d80cb60ebf18a87864f5da9d931efa7a8c949
Author: Protesilaos Stavrou <i...@protesilaos.com>
Commit: Bastien <b...@gnu.org>
Add faces to improve contextuality of agenda views
* lisp/org-agenda.el (org-search-view)
(org-agenda-propertize-selected-todo-keywords, org-todo-list)
(org-tags-view): Implement new org-agenda-structure-filter and
org-agenda-structure-secondary faces.
(org-agenda-get-day-face): Add condition for rendering the current
date heading in org-agenda-date-weekend-today.
* lisp/org-faces.el (org-agenda-structure-secondary)
(org-agenda-date-weekend-today, org-agenda-structure-filter)
(org-imminent-deadline): Add new faces.
(org-agenda-deadline-faces): Use the 'org-imminent-deadline' for
current deadlines instead of the generic 'org-warning'.
---
lisp/org-agenda.el | 17 ++++++++++-------
lisp/org-faces.el | 21 ++++++++++++++++++++-
2 files changed, 30 insertions(+), 8 deletions(-)
diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el
index 02c13ff..88e0287 100644
--- a/lisp/org-agenda.el
+++ b/lisp/org-agenda.el
@@ -4266,6 +4266,9 @@ This check for agenda markers in all agenda buffers
currently active."
"Return the face DATE should be displayed with."
(cond ((and (functionp org-agenda-day-face-function)
(funcall org-agenda-day-face-function date)))
+ ((and (org-agenda-today-p date)
+ (memq (calendar-day-of-week date) org-agenda-weekend-days))
+ 'org-agenda-date-weekend-today)
((org-agenda-today-p date) 'org-agenda-date-today)
((memq (calendar-day-of-week date) org-agenda-weekend-days)
'org-agenda-date-weekend)
@@ -4804,7 +4807,7 @@ is active."
(list 'face 'org-agenda-structure))
(setq pos (point))
(insert string "\n")
- (add-text-properties pos (1- (point)) (list 'face 'org-warning))
+ (add-text-properties pos (1- (point)) (list 'face
'org-agenda-structure-filter))
(setq pos (point))
(unless org-agenda-multi
(insert (substitute-command-keys "\\<org-agenda-mode-map>\
@@ -4814,7 +4817,7 @@ Press `\\[org-agenda-manipulate-query-add]', \
`\\[org-agenda-manipulate-query-subtract-re]' to add/sub regexp, \
`\\[universal-argument] \\[org-agenda-redo]' for a fresh search\n"))
(add-text-properties pos (1- (point))
- (list 'face 'org-agenda-structure)))
+ (list 'face 'org-agenda-structure-secondary)))
(buffer-string)))
(org-agenda-mark-header-line (point-min))
(when rtnall
@@ -4835,10 +4838,10 @@ Press `\\[org-agenda-manipulate-query-add]', \
"Use `org-todo-keyword-faces' for the selected todo KEYWORDS."
(concat
(if (or (equal keywords "ALL") (not keywords))
- (propertize "ALL" 'face 'warning)
+ (propertize "ALL" 'face 'org-agenda-structure-filter)
(mapconcat
(lambda (kw)
- (propertize kw 'face (org-get-todo-face kw)))
+ (propertize kw 'face (list (org-get-todo-face kw)
'org-agenda-structure)))
(org-split-string keywords "|")
"|"))
"\n"))
@@ -4923,7 +4926,7 @@ to search again: (0)[ALL]"))
(insert "\n "))
(insert " " s))))
(insert "\n"))
- (add-text-properties pos (1- (point)) (list 'face
'org-agenda-structure))
+ (add-text-properties pos (1- (point)) (list 'face
'org-agenda-structure-secondary))
(buffer-string)))
(org-agenda-mark-header-line (point-min))
(when rtnall
@@ -5014,7 +5017,7 @@ The prefix arg TODO-ONLY limits the search to TODO
entries."
(concat "Match: " match)))
(setq pos (point))
(insert match "\n")
- (add-text-properties pos (1- (point)) (list 'face 'org-warning))
+ (add-text-properties pos (1- (point)) (list 'face
'org-agenda-structure-filter))
(setq pos (point))
(unless org-agenda-multi
(insert (substitute-command-keys
@@ -5022,7 +5025,7 @@ The prefix arg TODO-ONLY limits the search to TODO
entries."
\\<org-agenda-mode-map>`\\[universal-argument] \\[org-agenda-redo]' \
to search again\n")))
(add-text-properties pos (1- (point))
- (list 'face 'org-agenda-structure))
+ (list 'face 'org-agenda-structure-secondary))
(buffer-string)))
(org-agenda-mark-header-line (point-min))
(when rtnall
diff --git a/lisp/org-faces.el b/lisp/org-faces.el
index a4fb0f0..b151045 100644
--- a/lisp/org-faces.el
+++ b/lisp/org-faces.el
@@ -507,6 +507,16 @@ content of these blocks will still be treated as Org
syntax."
"Face used in agenda for captions and dates."
:group 'org-faces)
+(defface org-agenda-structure-secondary '((t (:inherit org-agenda-structure)))
+ "Face used for secondary information in agenda block headers."
+ :group 'org-faces)
+
+(defface org-agenda-structure-filter '((t (:inherit (org-warning
org-agenda-structure))))
+ "Face used for the current type of task filter in the agenda.
+It inherits from `org-agenda-structure' so it can adapt to
+it (e.g. if that is assigned a diffent font height or family)."
+ :group 'org-faces)
+
(defface org-agenda-date '((t (:inherit org-agenda-structure)))
"Face used in agenda for normal days."
:group 'org-faces)
@@ -516,6 +526,10 @@ content of these blocks will still be treated as Org
syntax."
"Face used in agenda for today."
:group 'org-faces)
+(defface org-agenda-date-weekend-today '((t (:inherit org-agenda-date-today)))
+ "Face used in agenda for today during weekends."
+ :group 'org-faces)
+
(defface org-agenda-clocking '((t (:inherit secondary-selection)))
"Face marking the current clock item in the agenda."
:group 'org-faces)
@@ -558,6 +572,11 @@ which days belong to the weekend."
"Face for items scheduled previously, and not yet done."
:group 'org-faces)
+(defface org-imminent-deadline '((t :inherit org-warning))
+ "Face for current deadlines in the agenda.
+See also `org-agenda-deadline-faces'."
+ :group 'org-faces)
+
(defface org-upcoming-deadline
'((((class color) (min-colors 88) (background light)) (:foreground
"Firebrick"))
(((class color) (min-colors 88) (background dark)) (:foreground
"chocolate1"))
@@ -573,7 +592,7 @@ See also `org-agenda-deadline-faces'."
See also `org-agenda-deadline-faces'.")
(defcustom org-agenda-deadline-faces
- '((1.0 . org-warning)
+ '((1.0 . org-imminent-deadline)
(0.5 . org-upcoming-deadline)
(0.0 . org-upcoming-distant-deadline))
"Faces for showing deadlines in the agenda.
