;; kalendor builtins: ;; ;; named-kalendor management ;; ;; * kalendor/add (name label builder) ;; create and return a new instance (overriding name if existing) ;; * kalendor/find (name) ;; return the instance with this name ;; * kalendor/delete (name) ;; return the instance with this name ;; * kalendor/names ;; return a list of names ;; * kalendor/list ;; return named-kalendor instances ;; ;; simple builders ;; ;; * kalendor-build/annual ;; * kalendor-build/union ;; * kalendor-build/intersect ;; * kalendor-build/subtract ;; * kalendor-build/list ;; * kalendor-build/interval ;; * kalendor-build/weekday ;; * kalendor-build/month ;; ;; retrieve dates ;; ;; * kalendor/dates (k from upto) ;; where k is a name, a named kalendor, or a builder ;; ;;
(chapter-start 'kalendor “utilities for defining, building, and manipulating calendars. ”)
(dox-add-doc 'kalendor-build/named 'def '(“apply a name and label to a calendar”) '(kal name label) nil '(kalendor)) (dox-add-doc 'kalendor-build/weekday 'def '(“all dates for the given day of the week ;
if there is a second integer parameter n, limit to the nth of the given day each month") '(day n) nil '(kalendor))
(dox-add-doc 'kalendor-build/annual 'def '(“the same specified date in every year”) '(date month) nil '(kalendor)) (dox-add-doc 'kalendor-build/union 'def '(“the union of all dates provided by the given calendars”) 'args nil '(kalendor)) (dox-add-doc 'kalendor-build/intersect 'def '(“the intersection of all dates provided by the given calendars”) 'args nil '(kalendor)) (dox-add-doc 'kalendor-build/subtract 'def '(“all the dates of 'keep, except for any dates in 'toss”) '(keep toss) nil '(kalendor)) (dox-add-doc 'kalendor-build/list 'def '(“a preset list of dates”) 'args nil '(kalendor)) (dox-add-doc 'kalendor-build/interval 'def '(“all the dates from 'from upto 'upto (inclusive)”) '(from upto) nil '(kalendor)) (dox-add-doc 'kalendor-build/month 'def '(“all the dates in the given month, every year.
'month is an integer, january is 1") '(month) nil '(kalendor))
(dox-add-doc 'kalendor/find 'def '(“find the given calendar in the store”) '(name) nil '(kalendor)) (dox-add-doc 'kalendor/add 'def '(“add the given calendar to the store”) '(kal) nil '(kalendor)) (dox-add-doc 'kalendor/delete 'def '(“remove the given calendar from the store”) '(name) nil '(kalendor)) (dox-add-doc 'kalendor/names 'def '(“get the list of stored calendar names”) nil nil '(kalendor)) (dox-add-doc 'kalendor/list 'def '(“get the list of stored calendars”) nil nil '(kalendor)) (dox-add-doc 'kalendor/dates 'def '(“get the set of dates from calendar between the given dates”) '(kal from upto) nil '(kalendor))
(assign kalendor/substitutions
{ named 'kalendor-build/named weekday 'kalendor-build/weekday annual 'kalendor-build/annual union 'kalendor-build/union intersect 'kalendor-build/intersect subtract 'kalendor-build/subtract list 'kalendor-build/list interval 'kalendor-build/interval month 'kalendor-build/month lookup 'kalendor/find })
(def kalendor/replace-names (expr)
; used internally by 'kalendor macro (if (sym? expr) (if (kalendor/find expr) `(kalendor/find ',expr) (hash-get kalendor/substitutions expr) (hash-get kalendor/substitutions expr) expr) (pair? expr) (cons (kalendor/replace-names (car expr)) (kalendor/replace-names (cdr expr))) expr))
(def kalendor/test (kal from upto)
; used internally for testing kalendor expressions (map to-string (kalendor/dates kal from upto)))
(mac kalendor (name label expr)
; create a calendar but do not add it to the store ; Note that for a more concise 'expr, you can refer to previously-named calendars by name, and all kalendor-build/XXX functions simply by XXX (kalendor/replace-names `(named ',name ,label ,expr)))
(mac kalendor/public (name label expr)
; create a calendar and add it to the store with the given name. ; Note that for a more concise 'expr, you can refer to previously-named calendars by name, and all kalendor-build/XXX functions simply by XXX `(kalendor/add (kalendor ,name ,label ,expr)))
(kalendor/public mondays { en “Mondays” fr “lundis” de “Montag” } (weekday 1)) (kalendor/public tuesdays { en “Tuesdays” fr “mardis” de “Dienstag” } (weekday 2)) (kalendor/public wednesdays { en “Wednesdays” fr “mercredis” de “Mittwoch” } (weekday 3)) (kalendor/public thursdays { en “Thursdays” fr “jeudis” de “Donnerstag” } (weekday 4)) (kalendor/public fridays { en “Fridays” fr “vendredis” de “Freitag” } (weekday 5)) (kalendor/public saturdays { en “Saturdays” fr “samedis” de “Samstag” } (weekday 6)) (kalendor/public sundays { en “Sundays” fr “dimanches” de “Sonntag” } (weekday 0)) (kalendor/public weekends { en “weekends” fr “weekends” de “Wochenende” } (union saturdays sundays))
(= kal (hash)) (= kal.a-01-jan (kalendor a-01-jan { en “1 jan” fr “1 janv” de “1. Januar” } (annual 1 1))) (= kal.a-17-mar (kalendor a-17-mar { en “17 mar” fr “17 mars” de “17. Marz” } (annual 17 3))) (= kal.a-01-may (kalendor a-01-may { en “1 may” fr “1 mai” de “1. May” } (annual 1 5))) (= kal.a-08-may (kalendor a-08-may { en “8 may” fr “8 mai” de “8. May” } (annual 8 5))) (= kal.a-01-jun (kalendor a-01-jun { en “1 jun” fr “1 juin” de “1. Juni” } (annual 1 6))) (= kal.a-14-jul (kalendor a-14-jul { en “14 jul” fr “14 jul” de “14. Juli” } (annual 14 7))) (= kal.a-01-aug (kalendor a-01-aug { en “1 aug” fr “1 août” de “1. Aug” } (annual 1 8))) (= kal.a-15-aug (kalendor a-15-aug { en “15 aug” fr “15 août” de “15. Aug” } (annual 15 8))) (= kal.a-01-nov (kalendor a-01-nov { en “1 nov” fr “1 nov” de “1. Nov” } (annual 1 11))) (= kal.a-11-nov (kalendor a-11-nov { en “Armistice Day - 11 nov” fr “Jour de l'Armistice - 11 nov” de “Waffenstillstandstag - 11. Nov” } (annual 11 11))) (= kal.a-25-dec (kalendor a-25-dec { en “25 dec” fr “25 déc” de “25. Dez” } (annual 25 12))) (= kal.a-26-dec (kalendor a-26-dec { en “26 dec” fr “26 déc” de “26. Dez” } (annual 26 12)))
(= kal.first-monday-may (kalendor first-monday-may { en “First monday May” fr “premier lundi mai” de “Erste Montag May” } (intersect (weekday 1 1) (month 5)))) (= kal.first-monday-jun (kalendor first-monday-jun { en “First monday Jun” fr “premier lundi juin” de “Erste Montag Juni” } (intersect (weekday 1 1) (month 6)))) (= kal.first-monday-aug (kalendor first-monday-aug { en “First monday Aug” fr “premier lundi août” de “Erste Montag Aug” } (intersect (weekday 1 1) (month 8)))) (= kal.last-monday-oct (kalendor last-monday-oct { en “Last monday Oct” fr “dernier lundi oct” de “Letzte Montag Oct” } (intersect (weekday 1 -1) (month 10))))
(kalendor/public easter
{ en "Easter" fr "Pâques" de "Ostern" } (list "2001-04-15" "2002-03-31" "2003-04-20" "2004-04-11" "2005-03-27" "2006-04-16" "2007-04-08" "2008-03-23" "2009-04-12" "2010-04-04" "2011-04-24" "2012-04-08" "2013-03-31" "2014-04-20" "2015-04-05" "2016-03-27" "2017-04-16" "2018-04-01" "2019-04-21" "2020-04-12" "2021-04-04" "2022-04-17" "2023-04-09" "2024-03-31" "2025-04-20"))
(kalendor/public ascension-thursday
{ en "Ascension Thursday" fr "Jeudi de l'Ascension" de "Himmelfahrtstag" } (list "2000-06-01" "2001-05-24" "2002-05-09" "2003-05-29" "2004-05-20" "2005-05-05" "2006-05-25" "2007-05-17" "2008-05-01" "2009-05-21" "2010-05-13" "2011-06-02" "2012-05-17" "2013-05-09" "2014-05-29" "2015-05-14" "2016-05-05" "2017-05-25" "2018-05-10" "2019-05-30" "2020-05-21" "2021-05-13" "2022-05-26" "2023-05-18" "2024-05-09" "2025-05-29" "2026-05-14" "2027-05-06" "2028-05-25" "2029-05-10" "2030-05-30" "2031-05-22" "2032-05-06" "2033-05-26" "2034-05-18" "2035-05-03"))
(kalendor/public whit-monday
{ en "Whit Monday" fr "Lundi de Pentecôte" de "Pfingstmontag" } (list "2000-06-12" "2001-06-04" "2002-05-20" "2003-06-09" "2004-05-31" "2008-05-12" "2009-06-01" "2010-05-24" "2011-06-13" "2012-05-28" "2013-05-20" "2014-06-09" "2015-05-25" "2016-05-16" "2017-06-05" "2018-05-21" "2019-06-10" "2020-06-01" "2021-05-24" "2022-06-06" "2023-05-29" "2024-05-20" "2025-06-09" "2026-05-25" "2027-05-17" "2028-06-05" "2029-05-21" "2030-06-10" "2031-06-02" "2032-05-17" "2033-06-06" "2034-05-29" "2035-05-14"))
(mac kalendor/private (place . kal)
(w/uniq k `(let ,k (kalendor ,@kal) (hash-set ,place (hash-get ,k 'name) ,k))))
(assign kalendor/presets {
france (fn () (let france/private {} (kalendor/public france-public-holidays { en "French public holidays" fr "Jours fériés France" de "Ferien, Frankreich" } (union kal.a-01-jan easter kal.a-01-may kal.a-08-may ascension-thursday whit-monday kal.a-14-jul kal.a-15-aug kal.a-01-nov kal.a-11-nov kal.a-25-dec)) (kalendor/public france-non-working-days { en "weekends and public holidays, France" fr "Jours fériés et weekends, France" de "Ferien und Wochenende, Frankreich" } (union weekends (lookup 'france-public-holidays))) (kalendor/private france/private october { en "October school holidays, France" fr "vacances scolaires France, octobre" de "Schulferien Frankreich, Oktober" } (union (interval "2015-10-17" "2015-11-01") (interval "2016-10-19" "2016-11-02") (interval "2017-10-21" "2017-11-05") (interval "2018-10-20" "2018-11-04") (interval "2019-10-19" "2019-11-03") )) (kalendor/private france/private december { en "December school holidays, France" fr "Vacances scolaires France, décembre" de "Schulferien Frankreich, Dezember" } (union (interval "2015-12-19" "2016-01-03") (interval "2016-12-17" "2017-01-02") (interval "2017-12-23" "2018-01-07") (interval "2018-12-22" "2019-01-06") (interval "2019-12-21" "2020-01-05") )) (kalendor/private france/private winter/zone-a { en "Winter school holidays, France, Zone A" fr "Vacances scolaires France, hiver, zone A" de "Schulferien Frankreich, Winter, Zone A" } (union (interval "2016-02-13" "2016-02-29") (interval "2017-02-18" "2017-03-05") (interval "2018-02-10" "2018-02-25") (interval "2019-02-16" "2019-03-03") (interval "2020-02-22" "2020-03-08") )) (kalendor/private france/private winter/zone-b { en "Winter school holidays, France, Zone B" fr "Vacances scolaires France, hiver, zone B" de "Schulferien Frankreich, Winter, Zone B" } (union (interval "2016-02-06" "2016-02-21") (interval "2017-02-11" "2017-02-26") (interval "2018-02-24" "2018-03-11") (interval "2019-02-09" "2019-02-24") (interval "2020-02-15" "2020-03-01") )) (kalendor/private france/private winter/zone-c { en "Winter school holidays, France, Zone C" fr "Vacances scolaires France, hiver, zone c" de "Schulferien Frankreich, Winter, Zone C" } (union (interval "2016-02-20" "2016-03-06") (interval "2017-02-04" "2017-02-19") (interval "2018-02-17" "2018-03-04") (interval "2019-02-23" "2019-03-10") (interval "2020-02-08" "2020-02-23") )) (kalendor/private france/private easter/zone-a { en "Easter school holidays, France, Zone C" fr "Vacances scolaires France, Paques, zone c" de "Schulferien Frankreich, Ostern, Zone C" } (union (interval "2016-04-16" "2016-05-01") (interval "2017-04-01" "2017-04-17") (interval "2018-04-14" "2018-04-29") (interval "2019-04-13" "2019-04-28") (interval "2020-04-18" "2020-05-03") )) (kalendor/private france/private easter/zone-b { en "Easter school holidays, France, Zone B" fr "Vacances scolaires France, Paques, zone B" de "Schulferien Frankreich, Ostern, Zone B" } (union (interval "2016-04-02" "2016-04-17") (interval "2017-04-08" "2017-04-23") (interval "2018-04-21" "2018-05-06") (interval "2019-04-06" "2019-04-22") (interval "2020-04-18" "2020-04-26") )) (kalendor/private france/private easter/zone-c { en "Easter school holidays, France, Zone C" fr "Vacances scolaires France, Paques, zone C" de "Schulferien Frankreich, Ostern, Zone C" } (union (interval "2016-02-13" "2016-02-29") (interval "2017-02-18" "2017-03-05") (interval "2018-02-10" "2018-02-25") (interval "2019-04-20" "2019-05-05") (interval "2020-04-04" "2020-04-19") )) (kalendor/private france/private summer { en "Summer school holidays, France" fr "vacances scolaires France, été" de "Schulferien Frankreich, Sommer" } (union (interval "2016-07-04" "2016-08-31") (interval "2017-07-08" "2017-09-03") (interval "2018-07-07" "2018-09-01") (interval "2019-07-06" "2019-09-01") (interval "2020-07-04" "2020-09-01") )) (kalendor/public france-school-holidays-zone-c { en "school holidays, France, zone C" fr "vacances scolaires France, zone C" de "Schulferien Frankreich, Zone C" } (union france/private.october france/private.december france/private.winter/zone-c france/private.easter/zone-c france/private.summer)) (kalendor/public france-school-holidays-zone-b { en "school holidays, France, zone B" fr "vacances scolaires France, zone B" de "Schulferien Frankreich, Zone B" } (union france/private.october france/private.december france/private.winter/zone-b france/private.easter/zone-b france/private.summer)) (kalendor/public france-school-holidays-zone-a { en "school holidays, France, zone A" fr "vacances scolaires France, zone A" de "Schulferien Frankreich, Zone A" } (union france/private.october france/private.december france/private.winter/zone-a france/private.easter/zone-a france/private.summer))))})
(def kalendor/install (preset)
; install some preset calendars. 'preset must be one of '(france) ((or (hash-get kalendor/presets preset) noop)))