Browse Source

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'.
Protesilaos Stavrou 4 years ago
parent
commit
4b7d80cb60
2 changed files with 30 additions and 8 deletions
  1. 10 7
      lisp/org-agenda.el
  2. 20 1
      lisp/org-faces.el

+ 10 - 7
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."
   "Return the face DATE should be displayed with."
   (cond ((and (functionp org-agenda-day-face-function)
   (cond ((and (functionp org-agenda-day-face-function)
 	      (funcall org-agenda-day-face-function date)))
 	      (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)
 	((org-agenda-today-p date) 'org-agenda-date-today)
 	((memq (calendar-day-of-week date) org-agenda-weekend-days)
 	((memq (calendar-day-of-week date) org-agenda-weekend-days)
 	 'org-agenda-date-weekend)
 	 'org-agenda-date-weekend)
@@ -4804,7 +4807,7 @@ is active."
 			       (list 'face 'org-agenda-structure))
 			       (list 'face 'org-agenda-structure))
 	  (setq pos (point))
 	  (setq pos (point))
 	  (insert string "\n")
 	  (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))
 	  (setq pos (point))
 	  (unless org-agenda-multi
 	  (unless org-agenda-multi
 	    (insert (substitute-command-keys "\\<org-agenda-mode-map>\
 	    (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, \
 `\\[org-agenda-manipulate-query-subtract-re]' to add/sub regexp, \
 `\\[universal-argument] \\[org-agenda-redo]' for a fresh search\n"))
 `\\[universal-argument] \\[org-agenda-redo]' for a fresh search\n"))
 	    (add-text-properties pos (1- (point))
 	    (add-text-properties pos (1- (point))
-				 (list 'face 'org-agenda-structure)))
+				 (list 'face 'org-agenda-structure-secondary)))
 	  (buffer-string)))
 	  (buffer-string)))
       (org-agenda-mark-header-line (point-min))
       (org-agenda-mark-header-line (point-min))
       (when rtnall
       (when rtnall
@@ -4835,10 +4838,10 @@ Press `\\[org-agenda-manipulate-query-add]', \
   "Use `org-todo-keyword-faces' for the selected todo KEYWORDS."
   "Use `org-todo-keyword-faces' for the selected todo KEYWORDS."
   (concat
   (concat
    (if (or (equal keywords "ALL") (not keywords))
    (if (or (equal keywords "ALL") (not keywords))
-       (propertize "ALL" 'face 'warning)
+       (propertize "ALL" 'face 'org-agenda-structure-filter)
      (mapconcat
      (mapconcat
       (lambda (kw)
       (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 "|")
       (org-split-string keywords "|")
       "|"))
       "|"))
    "\n"))
    "\n"))
@@ -4923,7 +4926,7 @@ to search again: (0)[ALL]"))
                     (insert "\n                     "))
                     (insert "\n                     "))
                   (insert " " s))))
                   (insert " " s))))
 	    (insert "\n"))
 	    (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)))
 	  (buffer-string)))
       (org-agenda-mark-header-line (point-min))
       (org-agenda-mark-header-line (point-min))
       (when rtnall
       (when rtnall
@@ -5014,7 +5017,7 @@ The prefix arg TODO-ONLY limits the search to TODO entries."
 				     (concat "Match: " match)))
 				     (concat "Match: " match)))
 	  (setq pos (point))
 	  (setq pos (point))
 	  (insert match "\n")
 	  (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))
 	  (setq pos (point))
 	  (unless org-agenda-multi
 	  (unless org-agenda-multi
 	    (insert (substitute-command-keys
 	    (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]' \
 \\<org-agenda-mode-map>`\\[universal-argument] \\[org-agenda-redo]' \
 to search again\n")))
 to search again\n")))
 	  (add-text-properties pos (1- (point))
 	  (add-text-properties pos (1- (point))
-			       (list 'face 'org-agenda-structure))
+			       (list 'face 'org-agenda-structure-secondary))
 	  (buffer-string)))
 	  (buffer-string)))
       (org-agenda-mark-header-line (point-min))
       (org-agenda-mark-header-line (point-min))
       (when rtnall
       (when rtnall

+ 20 - 1
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."
   "Face used in agenda for captions and dates."
   :group 'org-faces)
   :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)))
 (defface org-agenda-date '((t (:inherit org-agenda-structure)))
   "Face used in agenda for normal days."
   "Face used in agenda for normal days."
   :group 'org-faces)
   :group 'org-faces)
@@ -516,6 +526,10 @@ content of these blocks will still be treated as Org syntax."
   "Face used in agenda for today."
   "Face used in agenda for today."
   :group 'org-faces)
   :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)))
 (defface org-agenda-clocking '((t (:inherit secondary-selection)))
   "Face marking the current clock item in the agenda."
   "Face marking the current clock item in the agenda."
   :group 'org-faces)
   :group 'org-faces)
@@ -558,6 +572,11 @@ which days belong to the weekend."
   "Face for items scheduled previously, and not yet done."
   "Face for items scheduled previously, and not yet done."
   :group 'org-faces)
   :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
 (defface org-upcoming-deadline
   '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick"))
   '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick"))
     (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1"))
     (((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'.")
 See also `org-agenda-deadline-faces'.")
 
 
 (defcustom org-agenda-deadline-faces
 (defcustom org-agenda-deadline-faces
-  '((1.0 . org-warning)
+  '((1.0 . org-imminent-deadline)
     (0.5 . org-upcoming-deadline)
     (0.5 . org-upcoming-deadline)
     (0.0 . org-upcoming-distant-deadline))
     (0.0 . org-upcoming-distant-deadline))
   "Faces for showing deadlines in the agenda.
   "Faces for showing deadlines in the agenda.