[elpa] externals/org 4b7d80c 50/85: Add faces to improve contextuality of agenda views

[ELPA Syncer]

branch: externals/org
commit 4b7d80cb60ebf18a87864f5da9d931efa7a8c949
Author: Protesilaos Stavrou <info@protesilaos.com>
Commit: Bastien <bzg@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.