feat: add calendar widget components

Add date picker and event calendar components inspired by shadcn/radix
Calendar and org-mode-agenda-cli.

Components:
- ui.calendar: Month grid date picker with navigation, today/selected
  highlighting, outside-month dimming. Pure date math utilities
  (days-in-month, day-of-week, calendar-days, etc.)
- ui.calendar-events: Event-aware grid with colored pills, horizontal
  day ticker strip with dot indicators, and agenda list view with
  grouped events by day

CSS: Token-based styling with dark mode support for event color
variants (accent/danger/success/warning). Responsive breakpoints.

All three targets supported (squint/cljs/clj). Dev pages show calendar
on its own page with interactive demos (date selection, month nav,
event grid, ticker, agenda list).

Tests: 27 new assertions covering date math, class generation,
component structure, event filtering/sorting.
This commit is contained in:
Florian Schroedl
2026-03-29 09:42:29 +02:00
parent d4f21f80a5
commit 25f868fb69
10 changed files with 1990 additions and 6 deletions

4
bb.edn
View File

@@ -48,6 +48,8 @@
[ui.sidebar-test]
[ui.chip-test]
[ui.separator-test]
[ui.calendar-test]
[ui.calendar-events-test]
[ui.theme-test])
:task (let [{:keys [fail error]} (t/run-tests
'ui.button-test
@@ -69,6 +71,8 @@
'ui.sidebar-test
'ui.chip-test
'ui.separator-test
'ui.calendar-test
'ui.calendar-events-test
'ui.theme-test)]
(when (pos? (+ fail error))
(System/exit 1)))}

View File

@@ -21,7 +21,9 @@
[ui.form :as form]
[ui.sidebar :as sidebar]
[ui.icon :as icon]
[ui.separator :as separator]))
[ui.separator :as separator]
[ui.calendar :as calendar]
[ui.calendar-events :as cal-events]))
;; ── Query Params ────────────────────────────────────────────────────
@@ -314,6 +316,51 @@
(form/form-field {:label "Email" :error "Please enter a valid email address."}
(form/form-input {:type :email :error true :value "invalid-email"}))]))
(def sample-calendar-events
[{:title "Team standup" :date "2026-03-29" :time-start "09:00" :time-end "09:30" :color :accent}
{:title "Lunch with Alex" :date "2026-03-29" :time-start "12:00" :time-end "13:00" :color :success}
{:title "Deploy v2.0" :date "2026-03-29" :time-start "15:00" :color :danger}
{:title "Design review" :date "2026-03-30" :time-start "10:00" :color :warning}
{:title "All-day planning" :date "2026-03-31" :color nil :done? true}
{:title "Sprint retro" :date "2026-04-01" :time-start "14:00" :time-end "15:00" :color :accent}
{:title "1:1 with manager" :date "2026-04-02" :time-start "11:00" :color :success}
{:title "Release party" :date "2026-04-03" :time-start "17:00" :color :danger}])
(defn calendar-demo []
(section "Calendar"
[:h5 "Date Picker"]
[:div {:style "display: flex; gap: 1.5rem; flex-wrap: wrap;"}
(calendar/calendar {:year 2026 :month 3 :today-str "2026-03-29"
:selected-date "2026-03-29"})
(calendar/calendar {:year 2026 :month 4 :today-str "2026-03-29"})]
[:h5 "Event Grid"]
(cal-events/calendar-event-grid {:year 2026 :month 3 :today-str "2026-03-29"
:selected-date "2026-03-29"
:events sample-calendar-events})
[:h5 "Day Ticker"]
(cal-events/ticker-strip {:days [{:date "2026-03-27" :day-num 27 :day-label "Fr"}
{:date "2026-03-28" :day-num 28 :day-label "Sa"}
{:date "2026-03-29" :day-num 29 :day-label "Su"}
{:date "2026-03-30" :day-num 30 :day-label "Mo"}
{:date "2026-03-31" :day-num 31 :day-label "Tu"}
{:date "2026-04-01" :day-num 1 :day-label "We"}
{:date "2026-04-02" :day-num 2 :day-label "Th"}
{:date "2026-04-03" :day-num 3 :day-label "Fr"}]
:today-str "2026-03-29"
:selected "2026-03-29"
:events sample-calendar-events})
[:h5 "Agenda List"]
(cal-events/agenda-list {:days [{:date "2026-03-29" :label "Today"}
{:date "2026-03-30" :label "Tomorrow"}
{:date "2026-03-31" :label "Tue"}
{:date "2026-04-01" :label "Wed"}
{:date "2026-04-02" :label "Thu"}
{:date "2026-04-03" :label "Fri"}]
:events sample-calendar-events})))
;; ── Pages ───────────────────────────────────────────────────────────
(defn page-header [title subtitle]
@@ -362,6 +409,11 @@
["Dev & Technical"
[:code :terminal :database :globe :shield :zap :book-open :map-pin]]])
(defn calendar-page []
[:div
(page-header "Calendar" "Date picker, event grid, ticker strip, and agenda list.")
(calendar-demo)])
(defn icons-page []
[:div
(page-header "Icons" (str (count icon/icon-names) " icons based on Lucide. All render as inline SVG with stroke=\"currentColor\"."))
@@ -454,12 +506,14 @@
(def nav-items
[{:id :components :label "Components" :icon-name :package :href "/"}
{:id :calendar :label "Calendar" :icon-name :calendar :href "/calendar"}
{:id :icons :label "Icons" :icon-name :image :href "/icons"}
{:id :sidebar :label "Sidebar" :icon-name :layout-dashboard :href "/sidebar"}])
(defn resolve-page [uri]
(case uri
"/" :components
"/calendar" :calendar
"/icons" :icons
"/sidebar" :sidebar
nil))
@@ -549,6 +603,7 @@
(sidebar/sidebar-mobile-toggle {})]
(case active-page
:components (components-page)
:calendar (calendar-page)
:icons (icons-page)
:sidebar (sidebar-page)
[:div (page-header "Not Found" "This page doesn't exist.")])]))]]))))

View File

@@ -18,7 +18,9 @@
[ui.form :as form]
[ui.sidebar :as sidebar]
[ui.icon :as icon]
[ui.separator :as separator]))
[ui.separator :as separator]
[ui.calendar :as calendar]
[ui.calendar-events :as cal-events]))
;; ── State ───────────────────────────────────────────────────────────
@@ -276,6 +278,76 @@
(form/form-field {:label "Email" :error "Please enter a valid email address."}
(form/form-input {:type :email :error true :value "invalid-email"}))]))
(defonce !cal-state (atom {:year 2026 :month 3 :selected-date nil}))
(def sample-calendar-events
[{:title "Team standup" :date "2026-03-29" :time-start "09:00" :time-end "09:30" :color :accent}
{:title "Lunch with Alex" :date "2026-03-29" :time-start "12:00" :time-end "13:00" :color :success}
{:title "Deploy v2.0" :date "2026-03-29" :time-start "15:00" :color :danger}
{:title "Design review" :date "2026-03-30" :time-start "10:00" :color :warning}
{:title "All-day planning" :date "2026-03-31" :color nil :done? true}
{:title "Sprint retro" :date "2026-04-01" :time-start "14:00" :time-end "15:00" :color :accent}
{:title "1:1 with manager" :date "2026-04-02" :time-start "11:00" :color :success}
{:title "Release party" :date "2026-04-03" :time-start "17:00" :color :danger}])
(defn calendar-demo []
(let [{:keys [year month selected-date]} @!cal-state
today-str "2026-03-29"]
(section "Calendar"
[:h5 "Date Picker (interactive)"]
[:div {:style {:display "flex" :gap "1.5rem" :flex-wrap "wrap"}}
(calendar/calendar {:year year :month month
:today-str today-str
:selected-date selected-date
:on-select (fn [d] (swap! !cal-state assoc :selected-date d))
:on-prev-month (fn [_]
(let [[ny nm] (calendar/prev-month year month)]
(swap! !cal-state assoc :year ny :month nm)))
:on-next-month (fn [_]
(let [[ny nm] (calendar/next-month year month)]
(swap! !cal-state assoc :year ny :month nm)))})]
(when selected-date
[:p {:style {:color "var(--fg-1)" :font-size "var(--font-sm)"}}
(str "Selected: " selected-date)])
[:h5 "Event Grid"]
(cal-events/calendar-event-grid {:year year :month month
:today-str today-str
:selected-date selected-date
:events sample-calendar-events
:on-select (fn [d] (swap! !cal-state assoc :selected-date d))
:on-prev-month (fn [_]
(let [[ny nm] (calendar/prev-month year month)]
(swap! !cal-state assoc :year ny :month nm)))
:on-next-month (fn [_]
(let [[ny nm] (calendar/next-month year month)]
(swap! !cal-state assoc :year ny :month nm)))
:on-event-click (fn [evt] (js/console.log "Event clicked:" (:title evt)))})
[:h5 "Day Ticker"]
(cal-events/ticker-strip {:days [{:date "2026-03-27" :day-num 27 :day-label "Fr"}
{:date "2026-03-28" :day-num 28 :day-label "Sa"}
{:date "2026-03-29" :day-num 29 :day-label "Su"}
{:date "2026-03-30" :day-num 30 :day-label "Mo"}
{:date "2026-03-31" :day-num 31 :day-label "Tu"}
{:date "2026-04-01" :day-num 1 :day-label "We"}
{:date "2026-04-02" :day-num 2 :day-label "Th"}
{:date "2026-04-03" :day-num 3 :day-label "Fr"}]
:today-str today-str
:selected (or selected-date today-str)
:events sample-calendar-events
:on-select (fn [d] (swap! !cal-state assoc :selected-date d))})
[:h5 "Agenda List"]
(cal-events/agenda-list {:days [{:date "2026-03-29" :label "Today"}
{:date "2026-03-30" :label "Tomorrow"}
{:date "2026-03-31" :label "Tue"}
{:date "2026-04-01" :label "Wed"}
{:date "2026-04-02" :label "Thu"}
{:date "2026-04-03" :label "Fri"}]
:events sample-calendar-events
:on-event-click (fn [evt] (js/console.log "Agenda event:" (:title evt)))}))))
;; ── Pages ───────────────────────────────────────────────────────────
(defn components-page []
@@ -318,6 +390,11 @@
["Dev & Technical"
[:code :terminal :database :globe :shield :zap :book-open :map-pin]]])
(defn calendar-page []
[:div
(page-header "Calendar" "Date picker, event grid, ticker strip, and agenda list.")
(calendar-demo)])
(defn icons-page []
[:div
(page-header "Icons" (str (count icon/icon-names) " icons based on Lucide. All render as inline SVG with stroke=\"currentColor\"."))
@@ -409,6 +486,7 @@
(def nav-items
[{:id :components :label "Components" :icon-name :package}
{:id :calendar :label "Calendar" :icon-name :calendar}
{:id :icons :label "Icons" :icon-name :image}
{:id :sidebar :label "Sidebar" :icon-name :layout-dashboard}])
@@ -504,6 +582,7 @@
(sidebar/sidebar-mobile-toggle {:on-click toggle-sidebar!})]
(case active-page
:components (components-page)
:calendar (calendar-page)
:icons (icons-page)
:sidebar (sidebar-page)
(components-page))]))))
@@ -516,6 +595,7 @@
(defn ^:export init! []
(d/set-dispatch! (fn [_ _]))
(add-watch !page :render (fn [_ _ _ _] (render!)))
(add-watch !cal-state :render (fn [_ _ _ _] (render!)))
(render!))
(defn ^:export reload! []

View File

@@ -17,7 +17,9 @@
[ui.form :as form]
[ui.sidebar :as sidebar]
[ui.icon :as icon]
[ui.separator :as separator]))
[ui.separator :as separator]
[ui.calendar :as calendar]
[ui.calendar-events :as cal-events]))
;; ── State ───────────────────────────────────────────────────────────
@@ -294,6 +296,86 @@
(form/form-field {:label "Email" :error "Please enter a valid email address."}
(form/form-input {:type "email" :error true :value "invalid-email"}))]))
(def !cal-state (atom {:year 2026 :month 3 :selected-date nil}))
(def sample-calendar-events
[{:title "Team standup" :date "2026-03-29" :time-start "09:00" :time-end "09:30" :color "accent"}
{:title "Lunch with Alex" :date "2026-03-29" :time-start "12:00" :time-end "13:00" :color "success"}
{:title "Deploy v2.0" :date "2026-03-29" :time-start "15:00" :color "danger"}
{:title "Design review" :date "2026-03-30" :time-start "10:00" :color "warning"}
{:title "All-day planning" :date "2026-03-31" :color nil :done? true}
{:title "Sprint retro" :date "2026-04-01" :time-start "14:00" :time-end "15:00" :color "accent"}
{:title "1:1 with manager" :date "2026-04-02" :time-start "11:00" :color "success"}
{:title "Release party" :date "2026-04-03" :time-start "17:00" :color "danger"}])
(defn calendar-demo []
(let [{:keys [year month selected-date]} @!cal-state
today-str "2026-03-29"]
(section "Calendar"
[:h5 "Date Picker (interactive)"]
[:div {:style {"display" "flex" "gap" "1.5rem" "flex-wrap" "wrap"}}
(calendar/calendar {:year year :month month
:today-str today-str
:selected-date selected-date
:on-select (fn [d]
(swap! !cal-state assoc :selected-date d)
(render!))
:on-prev-month (fn [_]
(let [[ny nm] (calendar/prev-month year month)]
(swap! !cal-state assoc :year ny :month nm)
(render!)))
:on-next-month (fn [_]
(let [[ny nm] (calendar/next-month year month)]
(swap! !cal-state assoc :year ny :month nm)
(render!)))})]
(when selected-date
[:p {:style {"color" "var(--fg-1)" "font-size" "var(--font-sm)"}}
(str "Selected: " selected-date)])
[:h5 "Event Grid"]
(cal-events/calendar-event-grid {:year year :month month
:today-str today-str
:selected-date selected-date
:events sample-calendar-events
:on-select (fn [d]
(swap! !cal-state assoc :selected-date d)
(render!))
:on-prev-month (fn [_]
(let [[ny nm] (calendar/prev-month year month)]
(swap! !cal-state assoc :year ny :month nm)
(render!)))
:on-next-month (fn [_]
(let [[ny nm] (calendar/next-month year month)]
(swap! !cal-state assoc :year ny :month nm)
(render!)))
:on-event-click (fn [evt] (js/console.log "Event clicked:" (:title evt)))})
[:h5 "Day Ticker"]
(cal-events/ticker-strip {:days [{:date "2026-03-27" :day-num 27 :day-label "Fr"}
{:date "2026-03-28" :day-num 28 :day-label "Sa"}
{:date "2026-03-29" :day-num 29 :day-label "Su"}
{:date "2026-03-30" :day-num 30 :day-label "Mo"}
{:date "2026-03-31" :day-num 31 :day-label "Tu"}
{:date "2026-04-01" :day-num 1 :day-label "We"}
{:date "2026-04-02" :day-num 2 :day-label "Th"}
{:date "2026-04-03" :day-num 3 :day-label "Fr"}]
:today-str today-str
:selected (or selected-date today-str)
:events sample-calendar-events
:on-select (fn [d]
(swap! !cal-state assoc :selected-date d)
(render!))})
[:h5 "Agenda List"]
(cal-events/agenda-list {:days [{:date "2026-03-29" :label "Today"}
{:date "2026-03-30" :label "Tomorrow"}
{:date "2026-03-31" :label "Tue"}
{:date "2026-04-01" :label "Wed"}
{:date "2026-04-02" :label "Thu"}
{:date "2026-04-03" :label "Fri"}]
:events sample-calendar-events
:on-event-click (fn [evt] (js/console.log "Agenda event:" (:title evt)))}))))
;; ── Pages ───────────────────────────────────────────────────────────
(defn components-page []
@@ -351,6 +433,11 @@
(into [:div {:style {"display" "grid" "grid-template-columns" "repeat(auto-fill, minmax(5rem, 1fr))" "gap" "var(--size-4)"}}]
(map icon-card icons)))))
(defn calendar-page []
[:div
(page-header "Calendar" "Date picker, event grid, ticker strip, and agenda list.")
(calendar-demo)])
(defn icons-page []
[:div
(page-header "Icons" (str (count icon/icon-names) " icons based on Lucide. All render as inline SVG with stroke=\"currentColor\"."))
@@ -435,6 +522,7 @@
(def nav-items
[{:id "components" :label "Components" :icon-name "package"}
{:id "calendar" :label "Calendar" :icon-name "calendar"}
{:id "icons" :label "Icons" :icon-name "image"}
{:id "sidebar" :label "Sidebar" :icon-name "layout-dashboard"}])
@@ -519,6 +607,7 @@
(sidebar/sidebar-mobile-toggle {:on-click toggle-sidebar!})]
(case active-page
"components" (components-page)
"calendar" (calendar-page)
"icons" (icons-page)
"sidebar" (sidebar-page)
(components-page))]))))

349
src/ui/calendar.cljc Normal file
View File

@@ -0,0 +1,349 @@
(ns ui.calendar
(:require [clojure.string :as str]
[ui.button :as button]
[ui.icon :as icon]))
;; In squint, keywords are strings — name is identity
#?(:squint (defn- kw-name [s] s)
:cljs (defn- kw-name [s] (name s))
:clj (defn- kw-name [s] (name s)))
;; ── Date Utilities ──────────────────────────────────────────────────
;; Pure functions — no JS Date dependency. Work across all targets.
(def month-names
["January" "February" "March" "April" "May" "June"
"July" "August" "September" "October" "November" "December"])
(def short-month-names
["Jan" "Feb" "Mar" "Apr" "May" "Jun"
"Jul" "Aug" "Sep" "Oct" "Nov" "Dec"])
(def weekday-labels
["Mo" "Tu" "We" "Th" "Fr" "Sa" "Su"])
(defn leap-year?
"Returns true if year is a leap year."
[year]
(or (zero? (mod year 400))
(and (zero? (mod year 4))
(not (zero? (mod year 100))))))
(defn days-in-month
"Returns number of days in a given month (1-indexed)."
[year month]
(case (int month)
2 (if (leap-year? year) 29 28)
(4 6 9 11) 30
31))
(defn day-of-week
"Returns day of week for a date (0=Mon, 1=Tue, ... 6=Sun).
Uses Tomohiko Sakamoto's algorithm."
[year month day]
(let [t [0 3 2 5 0 3 5 1 4 6 2 4]
y (if (< month 3) (dec year) year)
dow (mod (+ y
(quot y 4)
(- (quot y 100))
(quot y 400)
(nth t (dec month))
day)
7)]
;; Convert from 0=Sun to 0=Mon
(mod (+ dow 6) 7)))
(defn first-day-of-week
"Returns day-of-week (0=Mon..6=Sun) for the 1st of the given month."
[year month]
(day-of-week year month 1))
(defn pad2
"Zero-pad a number to 2 digits."
[n]
(if (< n 10) (str "0" n) (str n)))
(defn date-str
"Format a date as YYYY-MM-DD string."
[year month day]
(str year "-" (pad2 month) "-" (pad2 day)))
(defn month-name
"Get full month name (1-indexed)."
[month]
(nth month-names (dec month)))
(defn short-month-name
"Get abbreviated month name (1-indexed)."
[month]
(nth short-month-names (dec month)))
(defn prev-month
"Returns [year month] for the previous month."
[year month]
(if (= month 1)
[(dec year) 12]
[year (dec month)]))
(defn next-month
"Returns [year month] for the next month."
[year month]
(if (= month 12)
[(inc year) 1]
[year (inc month)]))
(defn calendar-days
"Generate the grid of day maps for a month calendar.
Returns a vector of maps with :day, :month, :year, :date-str, :current-month?.
Includes leading days from previous month and trailing days from next month
to fill complete weeks (rows of 7)."
[year month]
(let [first-dow (first-day-of-week year month)
total-days (days-in-month year month)
[py pm] (prev-month year month)
prev-days (days-in-month py pm)
[ny nm] (next-month year month)
;; Leading days from previous month
leading (mapv (fn [i]
(let [d (- prev-days (- first-dow 1) (- i))]
{:day d :month pm :year py
:date-str (date-str py pm d)
:current-month? false}))
(range first-dow))
;; Days of current month
current (mapv (fn [d]
{:day (inc d) :month month :year year
:date-str (date-str year month (inc d))
:current-month? true})
(range total-days))
;; Trailing days from next month
all (into leading current)
trailing-count (let [r (mod (count all) 7)]
(if (zero? r) 0 (- 7 r)))
trailing (mapv (fn [d]
{:day (inc d) :month nm :year ny
:date-str (date-str ny nm (inc d))
:current-month? false})
(range trailing-count))]
(into all trailing)))
;; ── Class Generation ────────────────────────────────────────────────
(defn calendar-class-list
"Returns a vector of CSS class strings for the calendar container."
[_opts]
["cal"])
(defn calendar-classes
"Returns a space-joined class string for the calendar container."
[opts]
(str/join " " (calendar-class-list opts)))
(defn day-cell-class-list
"Returns a vector of CSS class strings for a day cell.
Options:
:today? - is this the current date
:selected? - is this date selected
:current-month? - is this day in the displayed month
:disabled? - is this day disabled/unselectable"
[{:keys [today? selected? current-month? disabled?]}]
(cond-> ["cal-day"]
(not current-month?) (conj "cal-day-outside")
today? (conj "cal-day-today")
selected? (conj "cal-day-selected")
disabled? (conj "cal-day-disabled")))
(defn day-cell-classes
"Returns a space-joined class string for a day cell."
[opts]
(str/join " " (day-cell-class-list opts)))
;; ── Components ──────────────────────────────────────────────────────
(defn calendar-header
"Render the calendar header with month/year title and navigation buttons.
Props:
:year - current year
:month - current month (1-indexed)
:on-prev-month - callback for previous month navigation
:on-next-month - callback for next month navigation
:class - additional CSS classes
:attrs - additional HTML attributes"
[{:keys [year month on-prev-month on-next-month class attrs]}]
#?(:squint
(let [classes (cond-> "cal-nav" class (str " " class))
base-attrs (merge {:class classes} attrs)]
[:div base-attrs
(button/button {:variant "ghost" :icon "chevron-left" :size "sm"
:on-click on-prev-month
:class "cal-nav-btn"
:attrs {:aria-label "Previous month"}})
[:div {:class "cal-nav-title"}
(str (month-name month) " " year)]
(button/button {:variant "ghost" :icon "chevron-right" :size "sm"
:on-click on-next-month
:class "cal-nav-btn"
:attrs {:aria-label "Next month"}})])
:cljs
(let [classes (cond-> ["cal-nav"] class (conj class))
base-attrs (merge {:class classes} attrs)]
[:div base-attrs
(button/button {:variant :ghost :icon :chevron-left :size :sm
:on-click on-prev-month
:class "cal-nav-btn"
:attrs {:aria-label "Previous month"}})
[:div {:class ["cal-nav-title"]}
(str (month-name month) " " year)]
(button/button {:variant :ghost :icon :chevron-right :size :sm
:on-click on-next-month
:class "cal-nav-btn"
:attrs {:aria-label "Next month"}})])
:clj
(let [classes (cond-> "cal-nav" class (str " " class))
base-attrs (merge {:class classes} attrs)]
[:div base-attrs
(button/button {:variant :ghost :icon :chevron-left :size :sm
:class "cal-nav-btn"
:attrs {:aria-label "Previous month"}})
[:div {:class "cal-nav-title"}
(str (month-name month) " " year)]
(button/button {:variant :ghost :icon :chevron-right :size :sm
:class "cal-nav-btn"
:attrs {:aria-label "Next month"}})])))
(defn calendar-weekdays
"Render the weekday header row.
Props:
:class - additional CSS classes
:attrs - additional HTML attributes"
[{:keys [class attrs]}]
#?(:squint
(let [classes (cond-> "cal-weekdays" class (str " " class))
base-attrs (merge {:class classes} attrs)]
(into [:div base-attrs]
(map (fn [label] [:div {:class "cal-weekday"} label])
weekday-labels)))
:cljs
(let [classes (cond-> ["cal-weekdays"] class (conj class))
base-attrs (merge {:class classes} attrs)]
(into [:div base-attrs]
(map (fn [label] [:div {:class ["cal-weekday"]} label])
weekday-labels)))
:clj
(let [classes (cond-> "cal-weekdays" class (str " " class))
base-attrs (merge {:class classes} attrs)]
(into [:div base-attrs]
(map (fn [label] [:div {:class "cal-weekday"} label])
weekday-labels)))))
(defn calendar-day
"Render a single day cell in the calendar grid.
Props:
:day - day info map from calendar-days
:today-str - YYYY-MM-DD string of today's date
:selected-date - YYYY-MM-DD string of selected date (or nil)
:on-select - callback fn called with date-str when clicked
:disabled? - whether this day is disabled"
[{:keys [day today-str selected-date on-select disabled?]}]
(let [{:keys [current-month? date-str]} day
d (:day day)
today? (= date-str today-str)
selected? (= date-str selected-date)
cls-opts {:today? today?
:selected? selected?
:current-month? current-month?
:disabled? disabled?}]
#?(:squint
[:button {:class (day-cell-classes cls-opts)
:on-click (when (and on-select (not disabled?))
(fn [_e] (on-select date-str)))
:disabled (when disabled? true)
:data-date date-str
:type "button"}
[:span {:class "cal-day-number"} (str d)]]
:cljs
[:button {:class (day-cell-class-list cls-opts)
:on (when (and on-select (not disabled?))
{:click (fn [_e] (on-select date-str))})
:disabled (when disabled? true)
:data-date date-str
:type "button"}
[:span {:class ["cal-day-number"]} (str d)]]
:clj
[:button {:class (day-cell-classes cls-opts)
:disabled (when disabled? true)
:data-date date-str
:type "button"}
[:span {:class "cal-day-number"} (str d)]])))
(defn calendar
"Render a month calendar date picker.
Inspired by shadcn/radix Calendar.
Props:
:year - displayed year (e.g. 2026)
:month - displayed month (1-12)
:today-str - YYYY-MM-DD string for today (for highlighting)
:selected-date - YYYY-MM-DD string of selected date (or nil)
:on-select - callback fn, receives date-str when a day is clicked
:on-prev-month - callback for previous month navigation
:on-next-month - callback for next month navigation
:class - additional CSS classes
:attrs - additional HTML attributes"
[{:keys [year month today-str selected-date on-select
on-prev-month on-next-month class attrs]}]
(let [days (calendar-days year month)]
#?(:squint
(let [classes (cond-> (calendar-classes {}) class (str " " class))
base-attrs (merge {:class classes} attrs)]
[:div base-attrs
(calendar-header {:year year :month month
:on-prev-month on-prev-month
:on-next-month on-next-month})
(calendar-weekdays {})
(into [:div {:class "cal-grid"}]
(map (fn [day-info]
(calendar-day {:day day-info
:today-str today-str
:selected-date selected-date
:on-select on-select}))
days))])
:cljs
(let [cls (calendar-class-list {})
classes (cond-> cls class (conj class))
base-attrs (merge {:class classes} attrs)]
[:div base-attrs
(calendar-header {:year year :month month
:on-prev-month on-prev-month
:on-next-month on-next-month})
(calendar-weekdays {})
(into [:div {:class ["cal-grid"]}]
(map (fn [day-info]
(calendar-day {:day day-info
:today-str today-str
:selected-date selected-date
:on-select on-select}))
days))])
:clj
(let [classes (cond-> (calendar-classes {}) class (str " " class))
base-attrs (merge {:class classes} attrs)]
[:div base-attrs
(calendar-header {:year year :month month})
(calendar-weekdays {})
(into [:div {:class "cal-grid"}]
(map (fn [day-info]
(calendar-day {:day day-info
:today-str today-str
:selected-date selected-date}))
days))]))))

138
src/ui/calendar.css Normal file
View File

@@ -0,0 +1,138 @@
/* ── Calendar ─────────────────────────────────────────────────────── */
/* Date picker inspired by shadcn/radix Calendar component. */
.cal {
display: flex;
flex-direction: column;
background: var(--bg-1);
border: var(--border-0);
border-radius: var(--radius-md);
padding: var(--size-3);
width: fit-content;
}
/* ── Navigation ──────────────────────────────────────────────────── */
.cal-nav {
display: flex;
align-items: center;
justify-content: space-between;
padding-bottom: var(--size-2);
}
.cal-nav-title {
font-size: var(--font-sm);
font-weight: 600;
color: var(--fg-0);
text-align: center;
flex: 1;
}
.cal-nav-btn {
flex-shrink: 0;
}
/* ── Weekday Headers ─────────────────────────────────────────────── */
.cal-weekdays {
display: grid;
grid-template-columns: repeat(7, 1fr);
margin-bottom: var(--size-1);
}
.cal-weekday {
text-align: center;
padding: var(--size-1) 0;
font-size: var(--font-xs);
font-weight: 500;
color: var(--fg-2);
user-select: none;
}
/* ── Day Grid ────────────────────────────────────────────────────── */
.cal-grid {
display: grid;
grid-template-columns: repeat(7, 1fr);
gap: var(--size-1);
}
/* ── Day Cell (Picker) ───────────────────────────────────────────── */
.cal-day {
appearance: none;
border: none;
background: transparent;
color: var(--fg-0);
font-family: inherit;
font-size: var(--font-sm);
font-weight: 400;
width: var(--size-9);
height: var(--size-9);
display: flex;
align-items: center;
justify-content: center;
border-radius: var(--radius-sm);
cursor: pointer;
transition: background 0.15s, color 0.15s;
position: relative;
}
.cal-day:hover:not(:disabled):not(.cal-day-selected) {
background: var(--bg-2);
}
.cal-day:focus-visible {
outline: 2px solid var(--accent);
outline-offset: -2px;
}
.cal-day-number {
position: relative;
z-index: 1;
line-height: 1;
}
/* Outside month days */
.cal-day-outside {
color: var(--fg-2);
opacity: 0.5;
}
.cal-day-outside:hover:not(:disabled) {
opacity: 0.7;
}
/* Today highlight */
.cal-day-today {
font-weight: 600;
background: var(--bg-2);
}
/* Selected day */
.cal-day-selected {
background: var(--accent);
color: var(--fg-on-accent);
font-weight: 600;
}
.cal-day-selected:hover:not(:disabled) {
background: var(--accent);
filter: brightness(1.1);
}
/* Today + Selected */
.cal-day-today.cal-day-selected {
background: var(--accent);
color: var(--fg-on-accent);
}
/* Disabled */
.cal-day-disabled {
opacity: 0.3;
cursor: not-allowed;
}
.cal-day-disabled:hover {
background: transparent;
}

502
src/ui/calendar_events.cljc Normal file
View File

@@ -0,0 +1,502 @@
(ns ui.calendar-events
(:require [clojure.string :as str]
[ui.calendar :as cal]))
;; In squint, keywords are strings — name is identity
#?(:squint (defn- kw-name [s] s)
:cljs (defn- kw-name [s] (name s))
:clj (defn- kw-name [s] (name s)))
;; ── Event Data Helpers ──────────────────────────────────────────────
;; Events are maps with:
;; :title - string
;; :date - "YYYY-MM-DD" string
;; :time-start - "HH:MM" string or nil
;; :time-end - "HH:MM" string or nil
;; :color - :accent, :danger, :success, :warning, or nil (default)
;; :done? - boolean
(def event-colors #{"accent" "danger" "success" "warning"})
(defn event-color-class
"Returns the CSS class for an event color."
[color]
(let [c (some-> color kw-name)]
(if (and c (contains? event-colors c))
(str "cal-event-" c)
"cal-event-default")))
(defn events-for-date
"Filter events matching a date string, sorted by time-start."
[events date-str]
(let [matching (filterv (fn [evt] (= date-str (:date evt))) events)]
(sort-by (fn [evt] (or (:time-start evt) "99:99")) matching)))
(defn format-time
"Format a HH:MM time string for display."
[time-str]
(when time-str
(let [parts (str/split time-str #":")]
(str (first parts) ":" (second parts)))))
(defn event-time-display
"Build a time range string like '14:00 15:30' or just '14:00'."
[evt]
(let [start (:time-start evt)
end (:time-end evt)]
(when start
(if end
(str (format-time start) " \u2013 " (format-time end))
(format-time start)))))
;; ── Class Generation ────────────────────────────────────────────────
(defn event-pill-class-list
"Returns a vector of CSS class strings for an event pill.
Options:
:color - :accent, :danger, :success, :warning, or nil
:done? - boolean"
[{:keys [color done?]}]
(cond-> ["cal-event-pill" (event-color-class color)]
done? (conj "cal-event-done")))
(defn event-pill-classes
"Returns a space-joined class string for an event pill."
[opts]
(str/join " " (event-pill-class-list opts)))
(defn ticker-day-class-list
"Returns a vector of CSS class strings for a ticker day.
Options:
:today? - boolean
:selected? - boolean"
[{:keys [today? selected?]}]
(cond-> ["cal-ticker-day"]
today? (conj "cal-ticker-today")
selected? (conj "cal-ticker-selected")))
(defn ticker-day-classes
"Returns a space-joined class string for a ticker day."
[opts]
(str/join " " (ticker-day-class-list opts)))
(defn agenda-event-class-list
"Returns a vector of CSS class strings for an agenda event row.
Options:
:done? - boolean"
[{:keys [done?]}]
(cond-> ["cal-agenda-event"]
done? (conj "cal-agenda-event-done")))
(defn agenda-event-classes
"Returns a space-joined class string for an agenda event row."
[opts]
(str/join " " (agenda-event-class-list opts)))
;; ── Components ──────────────────────────────────────────────────────
(defn event-pill
"Render a small event chip for use inside calendar day cells.
Props:
:event - event map
:on-click - click handler (receives event map)"
[{:keys [event on-click]}]
(let [title (:title event)
time-str (event-time-display event)
color (:color event)
done? (:done? event)]
#?(:squint
[:div {:class (event-pill-classes {:color color :done? done?})
:on-click (when on-click
(fn [e]
(.stopPropagation e)
(on-click event)))}
(when time-str
[:span {:class "cal-event-time"} time-str])
[:span {:class "cal-event-title"} title]]
:cljs
[:div {:class (event-pill-class-list {:color color :done? done?})
:on (when on-click
{:click (fn [e]
(.stopPropagation e)
(on-click event))})}
(when time-str
[:span {:class ["cal-event-time"]} time-str])
[:span {:class ["cal-event-title"]} title]]
:clj
[:div {:class (event-pill-classes {:color color :done? done?})}
(when time-str
[:span {:class "cal-event-time"} time-str])
[:span {:class "cal-event-title"} title]])))
(defn event-day-cell
"Render a day cell with event pills for the calendar event grid.
Props:
:day - day info map from calendar-days
:events - all events (will be filtered to this date)
:today-str - YYYY-MM-DD string for today
:selected-date - YYYY-MM-DD string of selected date
:on-select - callback for day selection
:on-event-click - callback for event click
:max-visible - max events to show before '+N more' (default 3)"
[{:keys [day events today-str selected-date on-select on-event-click max-visible]}]
(let [{:keys [current-month? date-str]} day
d (:day day)
today? (= date-str today-str)
selected? (= date-str selected-date)
day-events (events-for-date events date-str)
max-vis (or max-visible 3)
visible-evts (take max-vis day-events)
overflow (- (count day-events) max-vis)
cls-opts {:today? today?
:selected? selected?
:current-month? current-month?}]
#?(:squint
[:div {:class (str (cal/day-cell-classes cls-opts) " cal-event-day")
:on-click (when (and on-select (not (empty? date-str)))
(fn [_e] (on-select date-str)))
:data-date date-str}
[:div {:class "cal-day-number"} (str d)]
(into [:div {:class "cal-day-events"}]
(concat
(map (fn [evt] (event-pill {:event evt :on-click on-event-click}))
visible-evts)
(when (pos? overflow)
[[:div {:class "cal-event-more"} (str "+" overflow " more")]])))]
:cljs
[:div {:class (conj (cal/day-cell-class-list cls-opts) "cal-event-day")
:on (when on-select
{:click (fn [_e] (on-select date-str))})
:data-date date-str}
[:div {:class ["cal-day-number"]} (str d)]
(into [:div {:class ["cal-day-events"]}]
(concat
(map (fn [evt] (event-pill {:event evt :on-click on-event-click}))
visible-evts)
(when (pos? overflow)
[[:div {:class ["cal-event-more"]} (str "+" overflow " more")]])))]
:clj
[:div {:class (str (cal/day-cell-classes cls-opts) " cal-event-day")
:data-date date-str}
[:div {:class "cal-day-number"} (str d)]
(into [:div {:class "cal-day-events"}]
(concat
(map (fn [evt] (event-pill {:event evt}))
visible-evts)
(when (pos? overflow)
[[:div {:class "cal-event-more"} (str "+" overflow " more")]])))])))
(defn calendar-event-grid
"Render a month grid calendar with events displayed in day cells.
Props:
:year - displayed year
:month - displayed month (1-12)
:today-str - YYYY-MM-DD string for today
:selected-date - YYYY-MM-DD string of selected date
:events - vector of event maps
:on-select - callback for day selection
:on-prev-month - callback for prev month nav
:on-next-month - callback for next month nav
:on-event-click - callback for event click
:max-visible - max events per cell (default 3)
:class - additional CSS classes
:attrs - additional HTML attributes"
[{:keys [year month today-str selected-date events on-select
on-prev-month on-next-month on-event-click max-visible
class attrs]}]
(let [days (cal/calendar-days year month)]
#?(:squint
(let [classes (cond-> "cal cal-has-events" class (str " " class))
base-attrs (merge {:class classes} attrs)]
[:div base-attrs
(cal/calendar-header {:year year :month month
:on-prev-month on-prev-month
:on-next-month on-next-month})
(cal/calendar-weekdays {})
(into [:div {:class "cal-grid cal-grid-events"}]
(map (fn [day-info]
(event-day-cell {:day day-info
:events events
:today-str today-str
:selected-date selected-date
:on-select on-select
:on-event-click on-event-click
:max-visible max-visible}))
days))])
:cljs
(let [cls ["cal" "cal-has-events"]
classes (cond-> cls class (conj class))
base-attrs (merge {:class classes} attrs)]
[:div base-attrs
(cal/calendar-header {:year year :month month
:on-prev-month on-prev-month
:on-next-month on-next-month})
(cal/calendar-weekdays {})
(into [:div {:class ["cal-grid" "cal-grid-events"]}]
(map (fn [day-info]
(event-day-cell {:day day-info
:events events
:today-str today-str
:selected-date selected-date
:on-select on-select
:on-event-click on-event-click
:max-visible max-visible}))
days))])
:clj
(let [classes (cond-> "cal cal-has-events" class (str " " class))
base-attrs (merge {:class classes} attrs)]
[:div base-attrs
(cal/calendar-header {:year year :month month})
(cal/calendar-weekdays {})
(into [:div {:class "cal-grid cal-grid-events"}]
(map (fn [day-info]
(event-day-cell {:day day-info
:events events
:today-str today-str
:selected-date selected-date
:max-visible max-visible}))
days))]))))
;; ── Day Ticker ──────────────────────────────────────────────────────
(defn ticker-dot
"Render a small colored dot for an event in the ticker."
[{:keys [event]}]
(let [color (:color event)]
#?(:squint
[:span {:class (str "cal-ticker-dot " (event-color-class color))}]
:cljs
[:span {:class ["cal-ticker-dot" (event-color-class color)]}]
:clj
[:span {:class (str "cal-ticker-dot " (event-color-class color))}])))
(defn ticker-day-item
"Render a single day in the ticker strip.
Props:
:date - YYYY-MM-DD string
:day-num - day number
:day-label - short day name (e.g. 'Mo')
:today-str - YYYY-MM-DD string for today
:selected - YYYY-MM-DD string of selected date
:events - all events (filtered internally)
:on-select - callback for selection"
[{:keys [date day-num day-label today-str selected events on-select]}]
(let [today? (= date today-str)
selected? (= date selected)
day-evts (events-for-date events date)]
#?(:squint
[:div {:class (ticker-day-classes {:today? today? :selected? selected?})
:on-click (when on-select (fn [_e] (on-select date)))}
[:div {:class "cal-ticker-day-name"} day-label]
[:div {:class "cal-ticker-day-num"} (str day-num)]
(into [:div {:class "cal-ticker-dots"}]
(map (fn [evt] (ticker-dot {:event evt}))
(take 4 day-evts)))]
:cljs
[:div {:class (ticker-day-class-list {:today? today? :selected? selected?})
:on (when on-select {:click (fn [_e] (on-select date))})}
[:div {:class ["cal-ticker-day-name"]} day-label]
[:div {:class ["cal-ticker-day-num"]} (str day-num)]
(into [:div {:class ["cal-ticker-dots"]}]
(map (fn [evt] (ticker-dot {:event evt}))
(take 4 day-evts)))]
:clj
[:div {:class (ticker-day-classes {:today? today? :selected? selected?})}
[:div {:class "cal-ticker-day-name"} day-label]
[:div {:class "cal-ticker-day-num"} (str day-num)]
(into [:div {:class "cal-ticker-dots"}]
(map (fn [evt] (ticker-dot {:event evt}))
(take 4 day-evts)))])))
(def ^:private weekday-short-names
["Mon" "Tue" "Wed" "Thu" "Fri" "Sat" "Sun"])
(defn ticker-strip
"Render a horizontal scrollable day ticker strip.
Shows days from the given list with event dot indicators.
Props:
:days - vector of {:date :day-num :day-label} maps
:today-str - YYYY-MM-DD string for today
:selected - YYYY-MM-DD string of selected date
:events - all events
:on-select - callback for day selection
:class - additional CSS classes
:attrs - additional HTML attributes"
[{:keys [days today-str selected events on-select class attrs]}]
#?(:squint
(let [classes (cond-> "cal-ticker" class (str " " class))
base-attrs (merge {:class classes} attrs)]
[:div base-attrs
(into [:div {:class "cal-ticker-scroll"}]
(map (fn [d]
(ticker-day-item {:date (:date d)
:day-num (:day-num d)
:day-label (:day-label d)
:today-str today-str
:selected selected
:events events
:on-select on-select}))
days))])
:cljs
(let [classes (cond-> ["cal-ticker"] class (conj class))
base-attrs (merge {:class classes} attrs)]
[:div base-attrs
(into [:div {:class ["cal-ticker-scroll"]}]
(map (fn [d]
(ticker-day-item {:date (:date d)
:day-num (:day-num d)
:day-label (:day-label d)
:today-str today-str
:selected selected
:events events
:on-select on-select}))
days))])
:clj
(let [classes (cond-> "cal-ticker" class (str " " class))
base-attrs (merge {:class classes} attrs)]
[:div base-attrs
(into [:div {:class "cal-ticker-scroll"}]
(map (fn [d]
(ticker-day-item {:date (:date d)
:day-num (:day-num d)
:day-label (:day-label d)
:today-str today-str
:selected selected
:events events}))
days))])))
;; ── Agenda List ─────────────────────────────────────────────────────
(defn agenda-event-row
"Render a single event row in the agenda list.
Props:
:event - event map
:on-click - click handler"
[{:keys [event on-click]}]
(let [title (:title event)
time-str (event-time-display event)
color (:color event)
done? (:done? event)]
#?(:squint
[:div {:class (agenda-event-classes {:done? done?})
:on-click (when on-click (fn [_e] (on-click event)))}
[:div {:class (str "cal-agenda-dot " (event-color-class color))}]
[:div {:class "cal-agenda-event-body"}
(when time-str
[:div {:class "cal-agenda-event-time"} time-str])
[:div {:class "cal-agenda-event-title"} title]]]
:cljs
[:div {:class (agenda-event-class-list {:done? done?})
:on (when on-click {:click (fn [_e] (on-click event))})}
[:div {:class ["cal-agenda-dot" (event-color-class color)]}]
[:div {:class ["cal-agenda-event-body"]}
(when time-str
[:div {:class ["cal-agenda-event-time"]} time-str])
[:div {:class ["cal-agenda-event-title"]} title]]]
:clj
[:div {:class (agenda-event-classes {:done? done?})}
[:div {:class (str "cal-agenda-dot " (event-color-class color))}]
[:div {:class "cal-agenda-event-body"}
(when time-str
[:div {:class "cal-agenda-event-time"} time-str])
[:div {:class "cal-agenda-event-title"} title]]])))
(defn agenda-day-group
"Render a day group in the agenda list with header and event rows.
Props:
:date - YYYY-MM-DD string
:label - display label (e.g. 'Today', 'Tomorrow', 'Mon')
:events - all events (filtered internally)
:on-event-click - callback for event click"
[{:keys [date label events on-event-click]}]
(let [day-evts (events-for-date events date)]
(when (seq day-evts)
#?(:squint
[:div {:class "cal-agenda-day-group"}
[:div {:class "cal-agenda-day-header"}
[:span {:class "cal-agenda-day-label"} label]
[:span {:class "cal-agenda-day-date"} (str/replace date "-" "/")]]
(into [:div {:class "cal-agenda-day-events"}]
(map (fn [evt]
(agenda-event-row {:event evt :on-click on-event-click}))
day-evts))]
:cljs
[:div {:class ["cal-agenda-day-group"]}
[:div {:class ["cal-agenda-day-header"]}
[:span {:class ["cal-agenda-day-label"]} label]
[:span {:class ["cal-agenda-day-date"]} (str/replace date "-" "/")]]
(into [:div {:class ["cal-agenda-day-events"]}]
(map (fn [evt]
(agenda-event-row {:event evt :on-click on-event-click}))
day-evts))]
:clj
[:div {:class "cal-agenda-day-group"}
[:div {:class "cal-agenda-day-header"}
[:span {:class "cal-agenda-day-label"} label]
[:span {:class "cal-agenda-day-date"} (str/replace date "-" "/")]]
(into [:div {:class "cal-agenda-day-events"}]
(map (fn [evt]
(agenda-event-row {:event evt}))
day-evts))]))))
(defn agenda-list
"Render the full agenda list view with grouped events by day.
Props:
:days - vector of {:date :label} maps for days to show
:events - all events
:on-event-click - callback for event click
:class - additional CSS classes
:attrs - additional HTML attributes"
[{:keys [days events on-event-click class attrs]}]
(let [groups (keep (fn [d]
(agenda-day-group {:date (:date d)
:label (:label d)
:events events
:on-event-click on-event-click}))
days)
empty? (not (seq groups))]
#?(:squint
(let [classes (cond-> "cal-agenda-list" class (str " " class))
base-attrs (merge {:class classes} attrs)]
(if empty?
[:div base-attrs
[:div {:class "cal-agenda-empty"} "No events"]]
(into [:div base-attrs] groups)))
:cljs
(let [classes (cond-> ["cal-agenda-list"] class (conj class))
base-attrs (merge {:class classes} attrs)]
(if empty?
[:div base-attrs
[:div {:class ["cal-agenda-empty"]} "No events"]]
(into [:div base-attrs] groups)))
:clj
(let [classes (cond-> "cal-agenda-list" class (str " " class))
base-attrs (merge {:class classes} attrs)]
(if empty?
[:div base-attrs
[:div {:class "cal-agenda-empty"} "No events"]]
(into [:div base-attrs] groups))))))

484
src/ui/calendar_events.css Normal file
View File

@@ -0,0 +1,484 @@
/* ── Calendar Events ──────────────────────────────────────────────── */
/* Event grid, ticker strip, and agenda list for calendar widget. */
/* ── Event Grid ──────────────────────────────────────────────────── */
.cal-has-events {
width: 100%;
}
.cal-grid-events {
gap: 0;
}
.cal-grid-events .cal-day,
.cal-event-day {
width: auto;
height: auto;
min-height: var(--size-16);
align-items: flex-start;
justify-content: flex-start;
flex-direction: column;
padding: var(--size-1);
border-radius: 0;
border-right: var(--border-0);
border-bottom: var(--border-0);
cursor: pointer;
}
.cal-grid-events .cal-day:nth-child(7n) {
border-right: none;
}
.cal-event-day .cal-day-number {
font-size: var(--font-xs);
font-weight: 500;
color: var(--fg-2);
margin-bottom: var(--size-1);
line-height: 1;
width: var(--size-6);
height: var(--size-6);
display: flex;
align-items: center;
justify-content: center;
border-radius: 9999px;
}
.cal-event-day.cal-day-today .cal-day-number {
background: var(--accent);
color: var(--fg-on-accent);
font-weight: 600;
}
.cal-event-day.cal-day-selected {
background: var(--bg-2);
}
.cal-event-day.cal-day-selected .cal-day-number {
font-weight: 600;
color: var(--fg-0);
}
.cal-event-day.cal-day-outside {
background: var(--bg-0);
opacity: 1;
}
.cal-event-day.cal-day-outside .cal-day-number {
opacity: 0.4;
}
.cal-event-day:hover:not(.cal-day-outside) {
background: var(--bg-2);
}
/* ── Day Events Container ────────────────────────────────────────── */
.cal-day-events {
display: flex;
flex-direction: column;
gap: var(--size-1);
overflow: hidden;
width: 100%;
min-width: 0;
}
/* ── Event Pill ──────────────────────────────────────────────────── */
.cal-event-pill {
font-size: var(--font-xs);
line-height: 1.4;
padding: var(--size-1);
border-radius: var(--radius-sm);
white-space: nowrap;
overflow: hidden;
text-overflow: ellipsis;
display: flex;
align-items: center;
gap: var(--size-1);
font-weight: 500;
cursor: pointer;
transition: filter 0.12s;
border-left: 3px solid transparent;
}
.cal-event-pill:hover {
filter: brightness(0.95);
}
.cal-event-done {
opacity: 0.45;
text-decoration: line-through;
}
.cal-event-time {
font-size: var(--font-xs);
opacity: 0.65;
flex-shrink: 0;
font-weight: 400;
}
.cal-event-title {
overflow: hidden;
text-overflow: ellipsis;
}
/* ── Event Color Variants ────────────────────────────────────────── */
.cal-event-accent {
background: var(--accent-100);
color: var(--accent-800);
border-left-color: var(--accent-500);
}
.cal-event-danger {
background: var(--danger-100);
color: var(--danger-800);
border-left-color: var(--danger-500);
}
.cal-event-success {
background: var(--success-100);
color: var(--success-800);
border-left-color: var(--success-500);
}
.cal-event-warning {
background: var(--warning-100);
color: var(--warning-800);
border-left-color: var(--warning-500);
}
.cal-event-default {
background: var(--gray-200);
color: var(--gray-700);
border-left-color: var(--gray-400);
}
/* ── Dark mode event colors ──────────────────────────────────────── */
[data-theme="dark"] .cal-event-accent {
background: var(--accent-950);
color: var(--accent-200);
border-left-color: var(--accent-400);
}
[data-theme="dark"] .cal-event-danger {
background: var(--danger-950);
color: var(--danger-200);
border-left-color: var(--danger-400);
}
[data-theme="dark"] .cal-event-success {
background: var(--success-950);
color: var(--success-200);
border-left-color: var(--success-400);
}
[data-theme="dark"] .cal-event-warning {
background: var(--warning-950);
color: var(--warning-200);
border-left-color: var(--warning-400);
}
[data-theme="dark"] .cal-event-default {
background: var(--gray-800);
color: var(--gray-200);
border-left-color: var(--gray-500);
}
@media (prefers-color-scheme: dark) {
:root:not([data-theme="light"]) .cal-event-accent {
background: var(--accent-950);
color: var(--accent-200);
border-left-color: var(--accent-400);
}
:root:not([data-theme="light"]) .cal-event-danger {
background: var(--danger-950);
color: var(--danger-200);
border-left-color: var(--danger-400);
}
:root:not([data-theme="light"]) .cal-event-success {
background: var(--success-950);
color: var(--success-200);
border-left-color: var(--success-400);
}
:root:not([data-theme="light"]) .cal-event-warning {
background: var(--warning-950);
color: var(--warning-200);
border-left-color: var(--warning-400);
}
:root:not([data-theme="light"]) .cal-event-default {
background: var(--gray-800);
color: var(--gray-200);
border-left-color: var(--gray-500);
}
}
/* ── Event More Indicator ────────────────────────────────────────── */
.cal-event-more {
font-size: var(--font-xs);
color: var(--fg-2);
padding: 0 var(--size-1);
cursor: pointer;
font-weight: 500;
}
.cal-event-more:hover {
color: var(--fg-1);
}
/* ── Ticker Strip ────────────────────────────────────────────────── */
.cal-ticker {
border-bottom: var(--border-0);
background: var(--bg-1);
overflow: hidden;
}
.cal-ticker-scroll {
display: flex;
overflow-x: auto;
scroll-snap-type: x mandatory;
-webkit-overflow-scrolling: touch;
scrollbar-width: none;
padding: var(--size-2);
gap: 0;
}
.cal-ticker-scroll::-webkit-scrollbar {
display: none;
}
.cal-ticker-day {
display: flex;
flex-direction: column;
align-items: center;
gap: var(--size-1);
min-width: var(--size-16);
padding: var(--size-1) var(--size-2);
cursor: pointer;
border-radius: var(--radius-md);
scroll-snap-align: center;
transition: background 0.15s;
flex-shrink: 0;
}
.cal-ticker-day:hover {
background: var(--bg-2);
}
.cal-ticker-day-name {
font-size: var(--font-xs);
font-weight: 600;
text-transform: uppercase;
letter-spacing: 0.06em;
color: var(--fg-2);
line-height: 1;
}
.cal-ticker-day-num {
font-size: var(--font-md);
font-weight: 500;
color: var(--fg-1);
width: var(--size-8);
height: var(--size-8);
display: flex;
align-items: center;
justify-content: center;
border-radius: 9999px;
line-height: 1;
}
.cal-ticker-today .cal-ticker-day-name {
color: var(--accent);
}
.cal-ticker-today .cal-ticker-day-num {
background: var(--accent);
color: var(--fg-on-accent);
font-weight: 600;
}
.cal-ticker-selected {
background: var(--bg-2);
}
.cal-ticker-selected .cal-ticker-day-num {
font-weight: 600;
color: var(--fg-0);
}
.cal-ticker-today.cal-ticker-selected .cal-ticker-day-num {
background: var(--accent);
color: var(--fg-on-accent);
}
.cal-ticker-dots {
display: flex;
gap: var(--size-1);
min-height: var(--size-2);
align-items: center;
justify-content: center;
}
.cal-ticker-dot {
width: var(--size-2);
height: var(--size-2);
border-radius: 9999px;
flex-shrink: 0;
}
.cal-ticker-dot.cal-event-accent { background: var(--accent); }
.cal-ticker-dot.cal-event-danger { background: var(--danger); }
.cal-ticker-dot.cal-event-success { background: var(--success); }
.cal-ticker-dot.cal-event-warning { background: var(--warning); }
.cal-ticker-dot.cal-event-default { background: var(--fg-2); }
/* ── Agenda List ─────────────────────────────────────────────────── */
.cal-agenda-list {
display: flex;
flex-direction: column;
overflow-y: auto;
}
.cal-agenda-day-group {
border-bottom: var(--border-0);
}
.cal-agenda-day-header {
display: flex;
align-items: baseline;
gap: var(--size-2);
padding: var(--size-3) var(--size-4) var(--size-1);
}
.cal-agenda-day-label {
font-size: var(--font-sm);
font-weight: 700;
text-transform: uppercase;
letter-spacing: 0.02em;
color: var(--fg-0);
}
.cal-agenda-day-date {
font-size: var(--font-xs);
color: var(--fg-2);
font-weight: 400;
}
.cal-agenda-day-events {
display: flex;
flex-direction: column;
}
.cal-agenda-event {
display: flex;
align-items: flex-start;
gap: var(--size-3);
padding: var(--size-2) var(--size-4);
cursor: pointer;
transition: background 0.12s;
}
.cal-agenda-event:hover {
background: var(--bg-2);
}
.cal-agenda-event-done {
opacity: 0.45;
}
.cal-agenda-event-done .cal-agenda-event-title {
text-decoration: line-through;
}
.cal-agenda-dot {
width: var(--size-3);
height: var(--size-3);
border-radius: 9999px;
margin-top: var(--size-1);
flex-shrink: 0;
}
.cal-agenda-dot.cal-event-accent { background: var(--accent); }
.cal-agenda-dot.cal-event-danger { background: var(--danger); }
.cal-agenda-dot.cal-event-success { background: var(--success); }
.cal-agenda-dot.cal-event-warning { background: var(--warning); }
.cal-agenda-dot.cal-event-default { background: var(--fg-2); }
.cal-agenda-event-body {
display: flex;
flex-direction: column;
gap: var(--size-1);
min-width: 0;
}
.cal-agenda-event-time {
font-size: var(--font-xs);
font-weight: 500;
color: var(--fg-1);
line-height: 1.3;
}
.cal-agenda-event-title {
font-size: var(--font-sm);
font-weight: 500;
color: var(--fg-0);
line-height: 1.35;
word-break: break-word;
}
.cal-agenda-empty {
padding: var(--size-8) var(--size-4);
text-align: center;
color: var(--fg-2);
font-size: var(--font-sm);
}
/* ── Responsive ──────────────────────────────────────────────────── */
@media (max-width: 768px) {
.cal-event-day {
min-height: var(--size-12);
padding: var(--size-1);
}
.cal-event-day .cal-day-number {
width: var(--size-5);
height: var(--size-5);
font-size: var(--font-xs);
}
.cal-event-pill {
font-size: var(--font-xs);
padding: var(--size-1);
gap: var(--size-1);
border-left-width: 2px;
}
.cal-event-time {
display: none;
}
.cal-ticker-day {
min-width: var(--size-13);
padding: var(--size-1);
}
.cal-ticker-day-num {
font-size: var(--font-base);
width: var(--size-7);
height: var(--size-7);
}
.cal-agenda-event {
padding: var(--size-2) var(--size-3);
}
.cal-agenda-day-header {
padding: var(--size-2) var(--size-3) var(--size-1);
}
}

View File

@@ -0,0 +1,117 @@
(ns ui.calendar-events-test
(:require [clojure.test :refer [deftest is testing]]
[ui.calendar-events :as cal-events]))
(def sample-events
[{:title "Team standup" :date "2026-03-29" :time-start "09:00" :time-end "09:30" :color :accent}
{:title "Lunch with Alex" :date "2026-03-29" :time-start "12:00" :time-end "13:00" :color :success}
{:title "Deploy v2.0" :date "2026-03-29" :time-start "15:00" :color :danger}
{:title "Design review" :date "2026-03-30" :time-start "10:00" :color :warning}
{:title "All-day planning" :date "2026-03-31" :color nil :done? true}])
(deftest event-color-class-test
(testing "named colors"
(is (= "cal-event-accent" (cal-events/event-color-class :accent)))
(is (= "cal-event-danger" (cal-events/event-color-class :danger)))
(is (= "cal-event-success" (cal-events/event-color-class :success)))
(is (= "cal-event-warning" (cal-events/event-color-class :warning))))
(testing "nil or unknown returns default"
(is (= "cal-event-default" (cal-events/event-color-class nil)))
(is (= "cal-event-default" (cal-events/event-color-class :unknown)))))
(deftest events-for-date-test
(testing "returns events for a matching date"
(let [evts (cal-events/events-for-date sample-events "2026-03-29")]
(is (= 3 (count evts)))))
(testing "sorted by time-start"
(let [evts (cal-events/events-for-date sample-events "2026-03-29")]
(is (= "09:00" (:time-start (first evts))))
(is (= "15:00" (:time-start (last evts))))))
(testing "returns empty for non-matching date"
(is (empty? (cal-events/events-for-date sample-events "2026-04-01"))))
(testing "events without time sort last"
(let [evts (cal-events/events-for-date sample-events "2026-03-31")]
(is (= 1 (count evts)))
(is (= "All-day planning" (:title (first evts)))))))
(deftest format-time-test
(testing "formats HH:MM"
(is (= "09:00" (cal-events/format-time "09:00")))
(is (= "14:30" (cal-events/format-time "14:30"))))
(testing "nil returns nil"
(is (nil? (cal-events/format-time nil)))))
(deftest event-time-display-test
(testing "time range with start and end"
(is (= "09:00 \u2013 09:30"
(cal-events/event-time-display {:time-start "09:00" :time-end "09:30"}))))
(testing "start only"
(is (= "15:00"
(cal-events/event-time-display {:time-start "15:00"}))))
(testing "no time"
(is (nil? (cal-events/event-time-display {})))))
(deftest event-pill-class-list-test
(testing "default"
(is (= ["cal-event-pill" "cal-event-default"]
(cal-events/event-pill-class-list {}))))
(testing "with color"
(is (= ["cal-event-pill" "cal-event-accent"]
(cal-events/event-pill-class-list {:color :accent}))))
(testing "done event"
(is (= ["cal-event-pill" "cal-event-default" "cal-event-done"]
(cal-events/event-pill-class-list {:done? true}))))
(testing "color + done"
(is (= ["cal-event-pill" "cal-event-danger" "cal-event-done"]
(cal-events/event-pill-class-list {:color :danger :done? true})))))
(deftest ticker-day-class-list-test
(testing "default"
(is (= ["cal-ticker-day"]
(cal-events/ticker-day-class-list {}))))
(testing "today"
(is (= ["cal-ticker-day" "cal-ticker-today"]
(cal-events/ticker-day-class-list {:today? true}))))
(testing "selected"
(is (= ["cal-ticker-day" "cal-ticker-selected"]
(cal-events/ticker-day-class-list {:selected? true}))))
(testing "today + selected"
(is (= ["cal-ticker-day" "cal-ticker-today" "cal-ticker-selected"]
(cal-events/ticker-day-class-list {:today? true :selected? true})))))
(deftest agenda-event-class-list-test
(testing "default"
(is (= ["cal-agenda-event"]
(cal-events/agenda-event-class-list {}))))
(testing "done"
(is (= ["cal-agenda-event" "cal-agenda-event-done"]
(cal-events/agenda-event-class-list {:done? true})))))
(deftest event-pill-component-test
(testing "renders event pill (clj target)"
(let [evt {:title "Test" :color :accent :time-start "10:00"}
result (cal-events/event-pill {:event evt})]
(is (= :div (first result)))
(is (= "cal-event-pill cal-event-accent"
(get-in result [1 :class]))))))
(deftest agenda-event-row-component-test
(testing "renders agenda event row (clj target)"
(let [evt {:title "Meeting" :color :danger :time-start "14:00" :time-end "15:00"}
result (cal-events/agenda-event-row {:event evt})]
(is (= :div (first result)))
(is (= "cal-agenda-event"
(get-in result [1 :class]))))))
(deftest agenda-day-group-component-test
(testing "renders day group with events"
(let [result (cal-events/agenda-day-group {:date "2026-03-29"
:label "Today"
:events sample-events})]
(is (some? result))
(is (= :div (first result)))))
(testing "returns nil for date with no events"
(let [result (cal-events/agenda-day-group {:date "2026-04-01"
:label "Wed"
:events sample-events})]
(is (nil? result)))))

166
test/ui/calendar_test.clj Normal file
View File

@@ -0,0 +1,166 @@
(ns ui.calendar-test
(:require [clojure.test :refer [deftest is testing]]
[ui.calendar :as cal]))
(deftest leap-year-test
(testing "standard leap years"
(is (true? (cal/leap-year? 2024)))
(is (true? (cal/leap-year? 2000)))
(is (true? (cal/leap-year? 1600))))
(testing "non-leap years"
(is (false? (cal/leap-year? 2023)))
(is (false? (cal/leap-year? 1900)))
(is (false? (cal/leap-year? 2100)))))
(deftest days-in-month-test
(testing "31-day months"
(is (= 31 (cal/days-in-month 2026 1)))
(is (= 31 (cal/days-in-month 2026 3)))
(is (= 31 (cal/days-in-month 2026 5)))
(is (= 31 (cal/days-in-month 2026 7)))
(is (= 31 (cal/days-in-month 2026 8)))
(is (= 31 (cal/days-in-month 2026 10)))
(is (= 31 (cal/days-in-month 2026 12))))
(testing "30-day months"
(is (= 30 (cal/days-in-month 2026 4)))
(is (= 30 (cal/days-in-month 2026 6)))
(is (= 30 (cal/days-in-month 2026 9)))
(is (= 30 (cal/days-in-month 2026 11))))
(testing "February"
(is (= 28 (cal/days-in-month 2026 2)))
(is (= 29 (cal/days-in-month 2024 2)))
(is (= 28 (cal/days-in-month 1900 2)))
(is (= 29 (cal/days-in-month 2000 2)))))
(deftest day-of-week-test
(testing "known dates"
;; 2026-03-29 is a Sunday = 6 in our system (0=Mon)
(is (= 6 (cal/day-of-week 2026 3 29)))
;; 2026-01-01 is a Thursday = 3
(is (= 3 (cal/day-of-week 2026 1 1)))
;; 2024-01-01 is a Monday = 0
(is (= 0 (cal/day-of-week 2024 1 1)))
;; 2023-12-25 is a Monday = 0
(is (= 0 (cal/day-of-week 2023 12 25)))))
(deftest first-day-of-week-test
(testing "first-day-of-week delegates to day-of-week"
;; March 2026 starts on Sunday = 6
(is (= 6 (cal/first-day-of-week 2026 3)))
;; January 2024 starts on Monday = 0
(is (= 0 (cal/first-day-of-week 2024 1)))))
(deftest pad2-test
(testing "single digit padded"
(is (= "01" (cal/pad2 1)))
(is (= "09" (cal/pad2 9))))
(testing "double digit not padded"
(is (= "10" (cal/pad2 10)))
(is (= "31" (cal/pad2 31)))))
(deftest date-str-test
(testing "formats date as YYYY-MM-DD"
(is (= "2026-03-29" (cal/date-str 2026 3 29)))
(is (= "2026-01-01" (cal/date-str 2026 1 1)))))
(deftest month-name-test
(testing "month names"
(is (= "January" (cal/month-name 1)))
(is (= "December" (cal/month-name 12)))
(is (= "March" (cal/month-name 3)))))
(deftest prev-month-test
(testing "normal"
(is (= [2026 2] (cal/prev-month 2026 3))))
(testing "year boundary"
(is (= [2025 12] (cal/prev-month 2026 1)))))
(deftest next-month-test
(testing "normal"
(is (= [2026 4] (cal/next-month 2026 3))))
(testing "year boundary"
(is (= [2027 1] (cal/next-month 2026 12)))))
(deftest calendar-days-test
(testing "generates correct number of days in complete weeks"
(let [days (cal/calendar-days 2026 3)]
;; Must be divisible by 7
(is (zero? (mod (count days) 7)))
;; Must contain all 31 days of March 2026
(let [current (filter :current-month? days)]
(is (= 31 (count current)))
(is (= 1 (:day (first current))))
(is (= 31 (:day (last current)))))))
(testing "leading days from previous month"
;; March 2026 starts on Sunday (6), so 6 leading days from Feb
(let [days (cal/calendar-days 2026 3)
leading (take-while #(not (:current-month? %)) days)]
(is (= 6 (count leading)))
(is (= 2 (:month (first leading))))))
(testing "trailing days from next month"
(let [days (cal/calendar-days 2026 3)
trailing (drop-while #(or (:current-month? %)
(= 2 (:month %)))
days)]
;; All trailing days should be in April
(is (every? #(= 4 (:month %)) trailing))))
(testing "month starting on Monday has no leading days"
;; June 2026 starts on Monday
(let [days (cal/calendar-days 2026 6)
leading (take-while #(not (:current-month? %)) days)]
(is (= 0 (count leading))))))
(deftest calendar-class-list-test
(testing "default"
(is (= ["cal"] (cal/calendar-class-list {})))))
(deftest day-cell-class-list-test
(testing "default day"
(is (= ["cal-day"] (cal/day-cell-class-list {:current-month? true}))))
(testing "today"
(is (= ["cal-day" "cal-day-today"]
(cal/day-cell-class-list {:current-month? true :today? true}))))
(testing "selected"
(is (= ["cal-day" "cal-day-selected"]
(cal/day-cell-class-list {:current-month? true :selected? true}))))
(testing "outside month"
(is (= ["cal-day" "cal-day-outside"]
(cal/day-cell-class-list {:current-month? false}))))
(testing "disabled"
(is (= ["cal-day" "cal-day-disabled"]
(cal/day-cell-class-list {:current-month? true :disabled? true}))))
(testing "today + selected"
(is (= ["cal-day" "cal-day-today" "cal-day-selected"]
(cal/day-cell-class-list {:current-month? true :today? true :selected? true})))))
(deftest calendar-component-test
(testing "renders correct hiccup structure (clj target)"
(let [result (cal/calendar {:year 2026 :month 3 :today-str "2026-03-29"})]
(is (= :div (first result)))
(is (= "cal" (get-in result [1 :class])))))
(testing "extra class gets appended"
(let [result (cal/calendar {:year 2026 :month 3 :class "my-cal"})]
(is (= "cal my-cal" (get-in result [1 :class])))))
(testing "calendar header contains month and year"
(let [result (cal/calendar-header {:year 2026 :month 3})]
;; Header is a div with nav-title containing "March 2026"
(is (= :div (first result)))
;; Find the title div
(let [children (drop 2 result)
title-div (some #(when (and (vector? %)
(= :div (first %))
(= "cal-nav-title" (get-in % [1 :class])))
%)
children)]
(is (some? title-div))
(is (= "March 2026" (last title-div)))))))