[elpa] externals/nano-agenda 6db277f 2/6: Added colors according to busy level

[ELPA Syncer]

branch: externals/nano-agenda
commit 6db277fac38388ecb7c7114ddd9396cd699e4e3c
Author: Nicolas P. Rougier <Nicolas.Rougier@inria.fr>
Commit: Nicolas P. Rougier <Nicolas.Rougier@inria.fr>

    Added colors according to busy level
---
 README.md      |  2 --
 nano-agenda.el | 47 +++++++++++++++++++++++++++++------------------
 2 files changed, 29 insertions(+), 20 deletions(-)

diff --git a/README.md b/README.md
index f80e895..e2a3021 100644
--- a/README.md
+++ b/README.md
@@ -6,5 +6,3 @@ current selected date) alongside a view of your agenda 
displaying
 timestamped entries. 
 
 ![](nano-agenda.png)
-
-
diff --git a/nano-agenda.el b/nano-agenda.el
index 09ce11a..a725535 100644
--- a/nano-agenda.el
+++ b/nano-agenda.el
@@ -65,9 +65,22 @@
 (defvar nano-agenda--busy-levels (list)
   "Cached list of (date busy-level) for internal use")
 
+(defvar nano-agenda-today-symbol  "•"
+  "Symbol to show curren day")
+
+(defvar nano-agenda-busy-backgrounds  (list "#FFF9DB" "#FFF3BF" "#FFEC99" 
"#FFE066" "#FFD43B"
+                                           "#FCC419" "#FAB005" "#F59F00" 
"#F08C00" "#E67700")
+  "Background colors to be used to highlight a day in calendar
+  view according to busy level.")
+
+(defvar nano-agenda-busy-foregrounds (list "#000000" "#000000" "#000000" 
"#000000" "#000000"
+                                          "#000000" "#000000" "#000000" 
"#000000" "#FFFFFF")
+  "Foreground colors to be used to highlight a day in calendar
+  view according to busy level.")
+
 (defface nano-agenda-default
   '((t :inherit default))
-  "Default face"
+  "Default face (for casual day)"
   :group 'nano-agenda-faces)
 
 (defface nano-agenda-selected
@@ -75,16 +88,6 @@
   "Face for the selected day"
   :group 'nano-agenda-faces)
 
-(defface nano-agenda-today
-  '((t :inherit (font-lock-string-face bold)))
-  "Today face when not selected."
-  :group 'nano-agenda-faces)
-
-(defface nano-agenda-selected-today
-  '((t :inherit (font-lock-string-face nano-strong) :inverse-video t))
-  "Today face when selected."
-  :group 'nano-agenda-faces)
-
 (defface nano-agenda-weekend
   '((t :inherit font-lock-comment-face))
   "Weekend face"
@@ -97,7 +100,7 @@
 
 (defface nano-agenda-outday
   '((t :inherit font-lock-comment-face))
-  "Out day face"
+  "Out day face, that is, day outside curent month."
   :group 'nano-agenda-faces)
 
 (defface nano-agenda-day-name
@@ -408,15 +411,20 @@ for efficiency."
          (start    (make-ts :year year :month month :day 1
                             :hour 0 :minute 0 :second 0))
          (dow      (mod (+ 6 (ts-dow start)) 7))
-         (start    (ts-dec 'day dow start))
-         (body     ""))
+         (start    (ts-dec 'day dow start)))
 
     (dotimes (row 6)
       (dotimes (col 7)
         (let* ((day (+ (* row 7) col))
                (date (ts-inc 'day day start))
+
                ;; Slow
-               ;; (level (nano-agenda--busy-level date))
+               (level (nano-agenda--busy-level date))
+               (level (min (length nano-agenda-busy-foregrounds) level))
+               (foreground (nth (- level 1) nano-agenda-busy-foregrounds))
+               (background (nth (- level 1) nano-agenda-busy-backgrounds))
+               ;; ----
+
                (map (make-sparse-keymap))
                (is-today (and (= (ts-year date) (ts-year today))
                               (= (ts-doy date) (ts-doy today))))
@@ -429,10 +437,11 @@ for efficiency."
                                                       (ts-day date)
                                                       (ts-year date))))
                (is-weekend (or (= (ts-dow date) 0) (= (ts-dow date) 6)))
-               (face (cond (is-selected-today 'nano-agenda-selected-today)
+               (face (cond ;; (is-selected-today 'nano-agenda-selected-today)
                            (is-selected       'nano-agenda-selected)
-                           (is-today          'nano-agenda-today)
+                           ;; (is-today          'nano-agenda-today)
                            (is-outday         'nano-agenda-outday)
+                           ((> level 0)       `(:foreground ,foreground 
:background ,background ))
                            (is-weekend        'nano-agenda-weekend)
                            (is-holidays       'nano-agenda-holidays)
                            (t                 'nano-agenda-default))))
@@ -449,7 +458,9 @@ for efficiency."
                                                    (if is-holidays (format " 
(%s)" (nth 0 is-holidays))
                                                      ""))
                                 'keymap map))
-            (if (< col 6) (insert " "))))
+            (if (< col 6)
+                (insert (propertize (if is-today "•" " ") 'face face))
+              )))
       (if (< row 5) (insert "\n")))))
 
 (provide 'nano-agenda)