Skip to content

Instantly share code, notes, and snippets.

@rougier
Created July 31, 2020 17:54
Show Gist options
  • Save rougier/e6c53fd9809994515f1327332baea09a to your computer and use it in GitHub Desktop.
Save rougier/e6c53fd9809994515f1327332baea09a to your computer and use it in GitHub Desktop.
Emacs year calendar in a dedicated frame
;; Material colors from https://material.io/design/color/
(defconst levels
(list "L50" "L100" "L200" "L300" "L400"
"L500" "L600" "L700" "L800" "L900"
"A100" "A200" "A400" "A700"))
(defconst red
(list "#FFEBEE" "#FFCDD2" "#EF9A9A" "#E57373" "#EF5350"
"#F44336" "#E53935" "#D32F2F" "#C62828" "#B71C1C"
"#FF8A80" "#FF5252" "#FF1744" "#D50000"))
(defconst pink
(list "#FCE4EC" "#F8BBD0" "#F48FB1" "#F06292" "#EC407A"
"#E91E63" "#D81B60" "#C2185B" "#AD1457" "#880E4F"
"#FF80AB" "#FF4081" "#F50057" "#C51162" ))
(defconst purple
(list "#F3E5F5" "#E1BEE7" "#CE93D8" "#BA68C8" "#AB47BC"
"#9C27B0" "#8E24AA" "#7B1FA2" "#6A1B9A" "#4A148C"
"#EA80FC" "#E040FB" "#D500F9" "#AA00FF" ))
(defconst deep-purple
(list "#EDE7F6" "#D1C4E9" "#B39DDB" "#9575CD" "#7E57C2"
"#673AB7" "#5E35B1" "#512DA8" "#4527A0" "#311B92"
"#B388FF" "#7C4DFF" "#651FFF" "#6200EA" ))
(defconst indigo
(list "#E8EAF6" "#C5CAE9" "#9FA8DA" "#7986CB" "#5C6BC0"
"#3F51B5" "#3949AB" "#303F9F" "#283593" "#1A237E"
"#8C9EFF" "#536DFE" "#3D5AFE" "#304FFE" ))
(defconst blue
(list "#E3F2FD" "#BBDEFB" "#90CAF9" "#64B5F6" "#42A5F5"
"#2196F3" "#1E88E5" "#1976D2" "#1565C0" "#0D47A1"
"#82B1FF" "#448AFF" "#2979FF" "#2962FF" ))
(defconst light-blue
(list "#E1F5FE" "#B3E5FC" "#81D4FA" "#4FC3F7" "#29B6F6"
"#03A9F4" "#039BE5" "#0288D1" "#0277BD" "#01579B"
"#80D8FF" "#40C4FF" "#00B0FF" "#0091EA" ))
(defconst cyan
(list "#E0F7FA" "#B2EBF2" "#80DEEA" "#4DD0E1" "#26C6DA"
"#00BCD4" "#00ACC1" "#0097A7" "#00838F" "#006064"
"#84FFFF" "#18FFFF" "#00E5FF" "#00B8D4" ))
(defconst teal
(list "#E0F2F1" "#B2DFDB" "#80CBC4" "#4DB6AC" "#26A69A"
"#009688" "#00897B" "#00796B" "#00695C" "#004D40"
"#A7FFEB" "#64FFDA" "#1DE9B6" "#00BFA5" ))
(defconst green
(list "#E8F5E9" "#C8E6C9" "#A5D6A7" "#81C784" "#66BB6A"
"#4CAF50" "#43A047" "#388E3C" "#2E7D32" "#1B5E20"
"#B9F6CA" "#69F0AE" "#00E676" "#00C853" ))
(defconst light-green
(list "#F1F8E9" "#DCEDC8" "#C5E1A5" "#AED581" "#9CCC65"
"#8BC34A" "#7CB342" "#689F38" "#558B2F" "#33691E"
"#CCFF90" "#B2FF59" "#76FF03" "#64DD17" ))
(defconst lime
(list "#F9FBE7" "#F0F4C3" "#E6EE9C" "#DCE775" "#D4E157"
"#CDDC39" "#C0CA33" "#AFB42B" "#9E9D24" "#827717"
"#F4FF81" "#EEFF41" "#C6FF00" "#AEEA00" ))
(defconst yellow
(list "#FFFDE7" "#FFF9C4" "#FFF59D" "#FFF176" "#FFEE58"
"#FFEB3B" "#FDD835" "#FBC02D" "#F9A825" "#F57F17"
"#FFFF8D" "#FFFF00" "#FFEA00" "#FFD600" ))
(defconst amber
(list "#FFF8E1" "#FFECB3" "#FFE082" "#FFD54F" "#FFCA28"
"#FFC107" "#FFB300" "#FFA000" "#FF8F00" "#FF6F00"
"#FFE57F" "#FFD740" "#FFC400" "#FFAB00" ))
(defconst orange
(list "#FFF3E0" "#FFE0B2" "#FFCC80" "#FFB74D" "#FFA726"
"#FF9800" "#FB8C00" "#F57C00" "#EF6C00" "#E65100"
"#FFD180" "#FFAB40" "#FF9100" "#FF6D00" ))
(defconst deep-orange
(list "#FBE9E7" "#FFCCBC" "#FFAB91" "#FF8A65" "#FF7043"
"#FF5722" "#F4511E" "#E64A19" "#D84315" "#BF360C"
"#FF9E80" "#FF6E40" "#FF3D00" "#DD2C00" ))
(defconst brown
(list "#EFEBE9" "#D7CCC8" "#BCAAA4" "#A1887F" "#8D6E63"
"#795548" "#6D4C41" "#5D4037" "#4E342E" "#3E2723" ))
(defconst grey
(list "#FAFAFA" "#F5F5F5" "#EEEEEE" "#E0E0E0" "#BDBDBD"
"#9E9E9E" "#757575" "#616161" "#424242" "#212121" ))
(defconst blue-grey
(list "#ECEFF1" "#CFD8DC" "#B0BEC5" "#90A4AE" "#78909C"
"#607D8B" "#546E7A" "#455A64" "#37474F" "#263238" ))
(require 'cl-lib)
(defun material-color (palette level)
"Return the color from the given palette and specified level."
(nth (cl-position level levels :test #'equal) palette))
(provide 'material-colors)
(require 'calendar)
(require 'holidays)
(require 'material-colors)
(setq org-agenda-start-on-weekday 1)
(setq calendar-mark-holidays-flag t)
(setq material-shade deep-orange)
(defface calendar-face-level-1 nil "")
(defface calendar-face-level-2 nil "")
(defface calendar-face-level-3 nil "")
(defface calendar-face-level-4 nil "")
(defface calendar-face-level-5 nil "")
(defface calendar-face-level-6 nil "")
(defface calendar-face-level-7 nil "")
(defface calendar-face-level-8 nil "")
(defface calendar-face-level-9 nil "")
(defface calendar-face-vacation nil "")
(defface calendar-face-weekend nil "")
(set-face-attribute 'calendar-face-level-1 nil
:background (material-color material-shade "L50"))
(set-face-attribute 'calendar-face-level-2 nil
:background (material-color material-shade "L100"))
(set-face-attribute 'calendar-face-level-3 nil
:background (material-color material-shade "L200"))
(set-face-attribute 'calendar-face-level-4 nil
:background (material-color material-shade "L300"))
(set-face-attribute 'calendar-face-level-5 nil
:inherit 'face-strong
:foreground "white"
:background (material-color material-shade "L400"))
(set-face-attribute 'calendar-face-level-6 nil
:inherit 'face-strong
:foreground "white"
:background (material-color material-shade "L500"))
(set-face-attribute 'calendar-face-level-7 nil
:inherit 'face-strong
:foreground "white"
:background (material-color material-shade "L600"))
(set-face-attribute 'calendar-face-level-8 nil
:inherit 'face-strong
:foreground "white"
:background (material-color material-shade "L700"))
(set-face-attribute 'calendar-face-level-9 nil
:inherit 'face-strong
:foreground "white"
:background (material-color material-shade "L800"))
(set-face-attribute 'calendar-face-vacation nil
:inherit 'face-strong
:background (material-color purple "L50")
:foreground (material-color blue-grey "L900"))
(set-face-attribute 'calendar-face-weekend nil
:inherit 'default
:background "white"
:foreground (material-color blue-grey "L300"))
(defadvice calendar-generate-month
(after highlight-weekend-days (month year indent) activate)
"Highlight weekend days"
(dotimes (i 31)
(let* ((date (list month (1+ i) year))
(file "~/Documents/org/agenda.org")
(entries (org-agenda-get-day-entries file date))
(count (length entries)))
(cond ((= count 0) (if (and (not (equal date (calendar-current-date)))
(or (= (calendar-day-of-week date) 0)
(= (calendar-day-of-week date) 6)))
(calendar-mark-visible-date date 'calendar-face-weekend)))
((= count 1) (calendar-mark-visible-date date 'calendar-face-level-1))
((= count 2) (calendar-mark-visible-date date 'calendar-face-level-2))
((= count 3) (calendar-mark-visible-date date 'calendar-face-level-3))
((= count 4) (calendar-mark-visible-date date 'calendar-face-level-4))
((= count 5) (calendar-mark-visible-date date 'calendar-face-level-5))
((= count 6) (calendar-mark-visible-date date 'calendar-face-level-6))
((= count 7) (calendar-mark-visible-date date 'calendar-face-level-7))
((= count 8) (calendar-mark-visible-date date 'calendar-face-level-8))
(t (calendar-mark-visible-date date 'calendar-face-level-9)))
)))
(defun calendar-cursor-to-visible-date (date)
"Move the cursor to date (if on the screen)"
(let* ((month (- (calendar-extract-month date) 1))
(day (- (calendar-extract-day date) 1))
(year (calendar-extract-year date))
(month-start (calendar-day-of-week (list (+ month 1) 1 year)))
(month-start (% (+ month-start 6) 7))
(month-width 25)
(month-height 9)
(month-col (* (% month 3) month-width))
(month-row (+ (* (/ month 3) month-height) 3))
(day-col (* (% (+ day month-start) 7) 3))
(day-row (/ (+ day month-start) 7))
(row (+ month-row day-row))
(col (+ month-col day-col 1 1)))
(goto-line row)
(move-to-column col)
))
(defun new-calendar-frame (char-width char-height)
""
(interactive)
(select-frame (make-frame))
(set-frame-width (selected-frame) char-width)
(set-frame-height (selected-frame) char-height)
(set-frame-position (selected-frame)
(/ (- (display-pixel-width) (frame-outer-width)) 2)
(/ (- (display-pixel-height) (frame-outer-height)) 2))
(x-focus-frame nil)
(switch-to-buffer (generate-new-buffer "*Year Calendar*"))
(local-set-key (kbd "C-x C-c") 'kill-and-close)
(setq header-line-format nil)
(setq mode-line-format nil))
(defun year-calendar (&optional year)
""
(interactive)
(new-calendar-frame 74 36)
(let* ((month 0)
(year (if year year (string-to-number (format-time-string "%Y" )))))
(switch-to-buffer (get-buffer-create calendar-buffer))
(when (not (eq major-mode 'calendar-mode))
(calendar-mode))
(setq buffer-read-only nil)
(erase-buffer)
(dotimes (j 4)
(dotimes (i 3)
(calendar-generate-month
(setq month (+ month 1))
year
(+ 1 (* 25 i))))
(goto-char (point-max))
(insert (make-string (- 10 (count-lines (point-min) (point-max))) ?\n))
(widen)
(goto-char (point-max))
(narrow-to-region (point-max) (point-max)))
(widen)
(goto-char (point-min))
(setq buffer-read-only t)
(setq header-line-format nil)
(setq mode-line-format nil)
(let ((displayed-month 2) (displayed-year 2020)) (calendar-mark-holidays))
(let ((displayed-month 5) (displayed-year 2020)) (calendar-mark-holidays))
(let ((displayed-month 8) (displayed-year 2020)) (calendar-mark-holidays))
(let ((displayed-month 11) (displayed-year 2020)) (calendar-mark-holidays))
(calendar-cursor-to-visible-date (calendar-current-date))))
@rougier
Copy link
Author

rougier commented Jul 31, 2020

Screenshot 2020-07-31 at 19 45 10

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment