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'.
This commit is contained in:
Protesilaos Stavrou 2021-06-02 12:51:07 +03:00 committed by Bastien
parent 54c2327f3a
commit 4b7d80cb60
2 changed files with 30 additions and 8 deletions

View File

@ -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

View File

@ -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.