Commit710ce708Recorded23 Mar 2026Repositorysigil-caldav

Add timezone and calendar-name support to ical-event

Message

Add timezone field to ical-event struct for TZID-aware event creation. When set, ical-generate emits DTSTART;TZID=<tz>:<local-time> instead of UTC Z format, preventing recurring events from shifting after DST changes. Also add calendar-name field for tracking which calendar an event belongs to.

  • Add format-ical-local-datetime for timezone-aware datetime output
  • Extract TZID from parsed iCal DTSTART params
  • Add timezone: keyword to caldav-event-create!
  • Preserve both fields through clone-event (recurrence expansion)
  • Fix local datetime test that only passed in UTC timezone
Changed
 src/sigil/caldav.sgl       |  3 +++
 src/sigil/caldav/event.sgl |  8 +++++---
 src/sigil/caldav/ical.sgl  | 90 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++---------------
 test/test-caldav.sgl       | 38 +++++++++++++++++++++++++++++++++++---
 4 files changed, 118 insertions(+), 21 deletions(-)
Diff
src/sigil/caldav.sglmodified
@@ -53,6 +53,8 @@
53
ical-event-created ical-event-last-modified
54
ical-event-all-day? ical-event-url ical-event-rrule
55
ical-event-recurrence-id
+56
ical-event-calendar-name set-ical-event-calendar-name!
+57
ical-event-timezone set-ical-event-timezone!
58
set-ical-event-summary! set-ical-event-description!
59
set-ical-event-dtstart! set-ical-event-dtend!
60
set-ical-event-location! set-ical-event-status!
@@ -62,6 +64,7 @@
64
ical-parse ical-generate
65
generate-event-uid
66
parse-ical-datetime format-ical-datetime
+67
format-ical-local-datetime
68
parse-ical-date format-ical-date
69
ical-expand-recurrence
70
src/sigil/caldav/event.sglmodified
@@ -180,13 +180,14 @@
180
(all-day? #f)
181
(rrule #f)
182
(organizer #f)
−183
(attendees '())))
+183
(attendees '())
+184
(timezone #f)))
185
(: caldav-client? (calendar-href: string?) (summary: string?)
186
(dtstart: number?) (dtend: (maybe number?))
187
(description: (maybe string?)) (location: (maybe string?))
188
(status: (maybe string?)) (all-day?: boolean?)
189
(rrule: (maybe string?)) (organizer: (maybe string?))
−189
(attendees: list?) -> ical-event?)
+190
(attendees: list?) (timezone: (maybe string?)) -> ical-event?)
191
(unless calendar-href
192
(error "caldav-event-create!: calendar-href: is required"))
193
(unless dtstart
@@ -204,7 +205,8 @@
205
all-day?: all-day?
206
rrule: rrule
207
organizer: organizer
−207
attendees: attendees))
+208
attendees: attendees
+209
timezone: timezone))
210
(ical-text (ical-generate event))
211
(event-url (string-append calendar-href uid ".ics"))
212
(response (caldav-put client event-url ical-text
src/sigil/caldav/ical.sglmodified
@@ -21,6 +21,8 @@
21
ical-event-created ical-event-last-modified
22
ical-event-all-day? ical-event-url ical-event-rrule
23
ical-event-recurrence-id
+24
ical-event-calendar-name set-ical-event-calendar-name!
+25
ical-event-timezone set-ical-event-timezone!
26
set-ical-event-summary! set-ical-event-description!
27
set-ical-event-dtstart! set-ical-event-dtend!
28
set-ical-event-location! set-ical-event-status!
@@ -39,6 +41,7 @@
41
;; Date/time conversion
42
parse-ical-datetime
43
format-ical-datetime
+44
format-ical-local-datetime
45
parse-ical-date
46
format-ical-date
47
@@ -66,7 +69,9 @@
69
(all-day? default: #f mutable: #t)
70
(url default: #f mutable: #t)
71
(rrule default: #f mutable: #t)
−69
(recurrence-id default: #f mutable: #t))
+72
(recurrence-id default: #f mutable: #t)
+73
(calendar-name default: #f mutable: #t)
+74
(timezone default: #f mutable: #t))
75
76
77
;; ============================================================
@@ -184,6 +189,32 @@
189
(pad-digits (list-ref parts 5) 2)
190
"Z")))
191
+192
;;; Format a Unix timestamp as an iCalendar local datetime string.
+193
;;;
+194
;;; Uses the system timezone to produce local date/time components.
+195
;;; No Z suffix — intended for use with TZID parameters.
+196
;;;
+197
;;; ```scheme
+198
;;; (format-ical-local-datetime 1710493200) ; => "20240315T110000" (in EET)
+199
;;; ```
+200
(define (format-ical-local-datetime ts)
+201
(: number? -> string?)
+202
(let* ((parts (time->list ts))
+203
;; time->list returns (second minute hour day month year ...)
+204
(s (list-ref parts 0))
+205
(mi (list-ref parts 1))
+206
(h (list-ref parts 2))
+207
(d (list-ref parts 3))
+208
(mo (list-ref parts 4))
+209
(y (list-ref parts 5)))
+210
(string-append (pad-digits y 4)
+211
(pad-digits mo 2)
+212
(pad-digits d 2)
+213
"T"
+214
(pad-digits h 2)
+215
(pad-digits mi 2)
+216
(pad-digits s 2))))
+217
218
;;; Format a Unix timestamp as an iCalendar date string.
219
;;;
220
;;; ```scheme
@@ -270,6 +301,19 @@
301
(cons (parse-ical-date value) #t)
302
(cons (parse-ical-datetime value) #f)))
303
+304
;; Extract TZID value from parameter string, e.g. "TZID=Europe/Athens"
+305
(define (extract-tzid params)
+306
(if (and (string? params)
+307
(string-contains? (string-upcase params) "TZID="))
+308
(let* ((upper (string-upcase params))
+309
(pos (string-find upper "TZID="))
+310
(rest (substring params (+ pos 5) (string-length params)))
+311
(semi (string-find rest ";")))
+312
(if semi
+313
(substring rest 0 semi)
+314
rest))
+315
#f))
+316
317
;; Extract a mailto: address, or return the raw value
318
(define (parse-cal-address value)
319
(if (string-starts-with? (string-downcase value) "mailto:")
@@ -379,7 +423,10 @@
423
(let ((dt (parse-dt-value params value)))
424
(set-ical-event-dtstart! ev (car dt))
425
(when (cdr dt)
−382
(set-ical-event-all-day?! ev #t))))
+426
(set-ical-event-all-day?! ev #t))
+427
(let ((tzid (extract-tzid params)))
+428
(when tzid
+429
(set-ical-event-timezone! ev tzid)))))
430
((equal? name "DTEND")
431
(let ((dt (parse-dt-value params value)))
432
(set-ical-event-dtend! ev (car dt))))
@@ -444,18 +491,29 @@
491
(add! (emit-line "UID" (ical-event-uid event)))
492
493
;; Date/time
−447
(when (ical-event-dtstart event)
−448
(if (ical-event-all-day? event)
−449
(add! (emit-line "DTSTART;VALUE=DATE"
−450
(format-ical-date (ical-event-dtstart event))))
−451
(add! (emit-line "DTSTART"
−452
(format-ical-datetime (ical-event-dtstart event))))))
−453
(when (ical-event-dtend event)
−454
(if (ical-event-all-day? event)
−455
(add! (emit-line "DTEND;VALUE=DATE"
−456
(format-ical-date (ical-event-dtend event))))
−457
(add! (emit-line "DTEND"
−458
(format-ical-datetime (ical-event-dtend event))))))
+494
(let ((tz (ical-event-timezone event)))
+495
(when (ical-event-dtstart event)
+496
(cond
+497
((ical-event-all-day? event)
+498
(add! (emit-line "DTSTART;VALUE=DATE"
+499
(format-ical-date (ical-event-dtstart event)))))
+500
(tz
+501
(add! (emit-line (string-append "DTSTART;TZID=" tz)
+502
(format-ical-local-datetime (ical-event-dtstart event)))))
+503
(else
+504
(add! (emit-line "DTSTART"
+505
(format-ical-datetime (ical-event-dtstart event)))))))
+506
(when (ical-event-dtend event)
+507
(cond
+508
((ical-event-all-day? event)
+509
(add! (emit-line "DTEND;VALUE=DATE"
+510
(format-ical-date (ical-event-dtend event)))))
+511
(tz
+512
(add! (emit-line (string-append "DTEND;TZID=" tz)
+513
(format-ical-local-datetime (ical-event-dtend event)))))
+514
(else
+515
(add! (emit-line "DTEND"
+516
(format-ical-datetime (ical-event-dtend event))))))))
517
518
;; Text properties
519
(when (not (string-empty? (ical-event-summary event)))
@@ -668,7 +726,9 @@
726
all-day?: (ical-event-all-day? event)
727
url: (ical-event-url event)
728
rrule: (ical-event-rrule event)
−671
recurrence-id: new-start)))
+729
recurrence-id: new-start
+730
calendar-name: (ical-event-calendar-name event)
+731
timezone: (ical-event-timezone event))))
732
ev))
733
734
;; Check if a timestamp is within the query range
test/test-caldav.sglmodified
@@ -2,6 +2,7 @@
2
3
(import (sigil test)
4
(sigil string)
+5
(sigil time)
6
(sigil caldav ical)
7
(sigil caldav client)
8
(sigil sxml reader))
@@ -17,9 +18,11 @@
18
(let ((ts (parse-ical-datetime "20240315T090000Z")))
19
(assert-equal "20240315T090000Z" (format-ical-datetime ts))))
20
−20
(test "parses local datetime (treated as UTC)"
−21
(let ((ts (parse-ical-datetime "20240315T090000")))
−22
(assert-equal "20240315T090000Z" (format-ical-datetime ts))))
+21
(test "parses local datetime in system timezone"
+22
(let* ((ts-local (parse-ical-datetime "20240315T090000"))
+23
(ts-utc (parse-ical-datetime "20240315T090000Z")))
+24
;; Local time differs from UTC by the timezone offset
+25
(assert-equal (- ts-utc (time-utc-offset)) ts-local)))
26
27
(test "round-trips midnight"
28
(let ((ts (parse-ical-datetime "20240101T000000Z")))
@@ -189,6 +192,35 @@
192
(att2 (car (ical-event-attendees ev2))))
193
(assert-equal "[email protected]" (ical-attendee-email att2)))))
194
+195
(test "generates event with TZID when timezone is set"
+196
(let* ((ev (ical-event uid: "tz-test-1"
+197
summary: "Local Meeting"
+198
dtstart: (parse-ical-datetime "20260323T150000Z")
+199
dtend: (parse-ical-datetime "20260323T160000Z")
+200
timezone: "Europe/Athens"))
+201
(text (ical-generate ev)))
+202
(assert-true (string-contains? text "DTSTART;TZID=Europe/Athens:"))
+203
(assert-true (string-contains? text "DTEND;TZID=Europe/Athens:"))
+204
;; Should NOT have bare DTSTART: or Z suffix for times
+205
(assert-false (string-contains? text "DTSTART:20260323"))
+206
(assert-false (string-contains? text "DTEND:20260323"))))
+207
+208
(test "generates UTC format when no timezone set"
+209
(let* ((ev (ical-event uid: "no-tz-1"
+210
summary: "UTC Event"
+211
dtstart: (parse-ical-datetime "20260323T150000Z")
+212
dtend: (parse-ical-datetime "20260323T160000Z")))
+213
(text (ical-generate ev)))
+214
(assert-true (string-contains? text "DTSTART:20260323T150000Z"))
+215
(assert-true (string-contains? text "DTEND:20260323T160000Z"))))
+216
+217
(test "parses TZID from DTSTART params"
+218
(let* ((ical-text "BEGIN:VCALENDAR\r\nVERSION:2.0\r\nBEGIN:VEVENT\r\nUID:[email protected]\r\nDTSTART;TZID=Europe/Athens:20260323T170000\r\nDTEND;TZID=Europe/Athens:20260323T180000\r\nSUMMARY:Athens Meeting\r\nEND:VEVENT\r\nEND:VCALENDAR")
+219
(events (ical-parse ical-text))
+220
(ev (car events)))
+221
(assert-equal "Europe/Athens" (ical-event-timezone ev))
+222
(assert-equal "Athens Meeting" (ical-event-summary ev))))
+223
224
(test "round-trip: parse then generate preserves key fields"
225
(let* ((events (ical-parse simple-ical))
226
(ev (car events))