瀏覽代碼

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 3 年之前
父節點
當前提交
4b7d80cb60
共有 2 個文件被更改,包括 30 次插入8 次删除
  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."
   (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

+ 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."
   :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.