aboutsummaryrefslogtreecommitdiff
path: root/modules
diff options
context:
space:
mode:
authorCraig Jennings <c@cjennings.net>2026-07-18 12:57:32 -0500
committerCraig Jennings <c@cjennings.net>2026-07-18 12:57:32 -0500
commitb426cd089503053fd203a034f3cbbe173252d5c3 (patch)
tree583c679fb3daa94445efd818313ce0805c6abdbc /modules
parentb5a7ac309217a1aeece1c043cf29002cfea6c9ef (diff)
downloaddotemacs-b426cd089503053fd203a034f3cbbe173252d5c3.tar.gz
dotemacs-b426cd089503053fd203a034f3cbbe173252d5c3.zip
fix(calendar-sync): honor BYDAY rules and drop cancelled events
The expander ignored BYDAY on monthly and yearly rules and stepped DTSTART's day-of-month instead, so a "2nd Wednesday" series rendered on the 12th of every month, the wrong weekday most months. It now resolves nth-weekday entries (2WE, -1TU), bare weekdays with BYSETPOS, and yearly BYMONTH+BYDAY, so each occurrence lands on the day the rule names. Nothing read the VEVENT STATUS property, so cancelled events rendered as normal meetings: a cancelled instance of a series reappeared at its original time, and standalone cancelled events stayed on the agenda. parse-event now drops STATUS:CANCELLED events, which also kills cancelled series masters. A cancelled RECURRENCE-ID override removes its occurrence instead of overriding it. The fixes are coupled: until BYDAY generates the right dates, a cancelled override can't match the occurrence it removes.
Diffstat (limited to 'modules')
-rw-r--r--modules/calendar-sync-ics.el34
-rw-r--r--modules/calendar-sync-recurrence.el176
2 files changed, 183 insertions, 27 deletions
diff --git a/modules/calendar-sync-ics.el b/modules/calendar-sync-ics.el
index 9c1b005b..7fecce10 100644
--- a/modules/calendar-sync-ics.el
+++ b/modules/calendar-sync-ics.el
@@ -188,6 +188,22 @@ Monday = 1, Sunday = 7."
(dow (nth 6 decoded))) ; 0 = Sunday, 1 = Monday, etc.
(if (= dow 0) 7 dow)))
+(defun calendar-sync--nth-weekday-of-month (year month weekday n)
+ "Return the day-of-month of the Nth WEEKDAY in YEAR/MONTH, or nil.
+WEEKDAY is 1-7 (Monday = 1), matching `calendar-sync--date-weekday'.
+Positive N counts from the start of the month (1 = first); negative N
+counts from the end (-1 = last). Returns nil when the month has no such
+occurrence (a 5th Friday most months), or when N is zero."
+ (when (and (integerp n) (not (zerop n)))
+ (let* ((first-dow (calendar-sync--date-weekday (list year month 1)))
+ (first-day (1+ (mod (- weekday first-dow) 7)))
+ (next-month (calendar-sync--add-months (list year month 1) 1))
+ (last-day (nth 2 (calendar-sync--add-days next-month -1)))
+ (total (1+ (/ (- last-day first-day) 7)))
+ (index (if (> n 0) n (+ total n 1))))
+ (when (and (>= index 1) (<= index total))
+ (+ first-day (* 7 (1- index)))))))
+
(defun calendar-sync--add-days (date days)
"Add DAYS to DATE (year month day).
Returns new (year month day).
@@ -564,18 +580,30 @@ would push the last day BEFORE the start and emit a backwards range."
;;; Single Event Parsing
+(defun calendar-sync--event-cancelled-p (event-str)
+ "Return non-nil when EVENT-STR carries STATUS:CANCELLED.
+This is the VEVENT's own STATUS property (RFC 5545 3.8.1.11), not the
+user's attendee PARTSTAT. Matching is case-insensitive."
+ (let ((status (calendar-sync--get-property event-str "STATUS")))
+ (and status (string= (upcase status) "CANCELLED"))))
+
(defun calendar-sync--parse-event (event-str)
"Parse single VEVENT string EVENT-STR into plist.
Returns plist with :uid :summary :description :location :start :end
:attendees :organizer :url :status.
Returns nil if event lacks required fields (DTSTART, SUMMARY).
Skips events with RECURRENCE-ID (individual instances of recurring events
-are handled separately via exception collection).
+are handled separately via exception collection) and events whose own
+STATUS is CANCELLED -- a cancelled meeting must not render, and a
+cancelled series master kills its whole series because RRULE expansion
+builds its base event through this function.
Handles TZID-qualified timestamps by converting to local time.
Cleans text fields (description, location, summary) via
`calendar-sync--clean-text'."
- ;; Skip individual instances of recurring events (they're collected as exceptions)
- (unless (calendar-sync--get-property event-str "RECURRENCE-ID")
+ ;; Skip individual instances of recurring events (they're collected as
+ ;; exceptions) and cancelled events (they must not render).
+ (unless (or (calendar-sync--get-property event-str "RECURRENCE-ID")
+ (calendar-sync--event-cancelled-p event-str))
(let* ((uid (calendar-sync--get-property event-str "UID"))
(summary (calendar-sync--clean-text
(calendar-sync--get-property event-str "SUMMARY")))
diff --git a/modules/calendar-sync-recurrence.el b/modules/calendar-sync-recurrence.el
index 1cb25636..a3bd4dc4 100644
--- a/modules/calendar-sync-recurrence.el
+++ b/modules/calendar-sync-recurrence.el
@@ -90,6 +90,9 @@ dropped by `calendar-sync--filter-declined'."
(list :recurrence-id (calendar-sync--localize-parsed-datetime
recurrence-id-parsed recurrence-id-is-utc recurrence-id-tzid)
:recurrence-id-raw recurrence-id
+ ;; A cancelled override removes its occurrence downstream
+ ;; rather than rescheduling it.
+ :cancelled (calendar-sync--event-cancelled-p event-str)
:start start-parsed
:end end-parsed
:summary summary
@@ -164,24 +167,30 @@ Compares year, month, day, hour, minute."
"Apply EXCEPTIONS to OCCURRENCES list.
OCCURRENCES is list of event plists from RRULE expansion.
EXCEPTIONS is hash table from `calendar-sync--collect-recurrence-exceptions'.
-Returns new list with matching occurrences replaced by exception times."
+Returns new list with matching occurrences replaced by exception times.
+A cancelled exception (STATUS:CANCELLED override) removes its occurrence
+from the list instead of overriding it."
(if (or (null occurrences) (null exceptions))
occurrences
- (mapcar
- (lambda (occurrence)
- (let* ((uid (plist-get occurrence :uid))
- (uid-exceptions (and uid (gethash uid exceptions))))
- (if (null uid-exceptions)
- occurrence
- ;; Check if any exception matches this occurrence
- (let ((matching-exception
- (cl-find-if (lambda (exc)
- (calendar-sync--occurrence-matches-exception-p occurrence exc))
- uid-exceptions)))
- (if matching-exception
- (calendar-sync--apply-single-exception occurrence matching-exception)
- occurrence)))))
- occurrences)))
+ (delq nil
+ (mapcar
+ (lambda (occurrence)
+ (let* ((uid (plist-get occurrence :uid))
+ (uid-exceptions (and uid (gethash uid exceptions))))
+ (if (null uid-exceptions)
+ occurrence
+ ;; Check if any exception matches this occurrence
+ (let ((matching-exception
+ (cl-find-if (lambda (exc)
+ (calendar-sync--occurrence-matches-exception-p occurrence exc))
+ uid-exceptions)))
+ (cond
+ ((null matching-exception) occurrence)
+ ;; Cancelled instance: drop it entirely.
+ ((plist-get matching-exception :cancelled) nil)
+ (t (calendar-sync--apply-single-exception
+ occurrence matching-exception)))))))
+ occurrences))))
;;; EXDATE (Excluded Date) Handling
@@ -291,7 +300,9 @@ OCCURRENCE-DATE should be a list (year month day hour minute second)."
(defun calendar-sync--parse-rrule (rrule-str)
"Parse RRULE string into plist.
-Returns plist with :freq :interval :byday :until :count."
+Returns plist with :freq :interval :byday :bysetpos :bymonth :until :count.
+BYMONTH keeps only the first value of a comma-separated list -- feeds in
+practice emit a single month there."
(let ((parts (split-string rrule-str ";"))
(result '()))
(dolist (part parts)
@@ -302,6 +313,8 @@ Returns plist with :freq :interval :byday :until :count."
("FREQ" (setq result (plist-put result :freq (intern (downcase value)))))
("INTERVAL" (setq result (plist-put result :interval (string-to-number value))))
("BYDAY" (setq result (plist-put result :byday (split-string value ","))))
+ ("BYSETPOS" (setq result (plist-put result :bysetpos (string-to-number value))))
+ ("BYMONTH" (setq result (plist-put result :bymonth (string-to-number value))))
("UNTIL" (setq result (plist-put result :until (calendar-sync--parse-timestamp value))))
("COUNT" (setq result (plist-put result :count (string-to-number value))))))))
;; Set defaults
@@ -389,18 +402,133 @@ BASE-EVENT is the event plist, RRULE is parsed rrule, RANGE is date range."
(calendar-sync--log-silently "calendar-sync: WARNING: Hit max iterations (%d) expanding weekly event" max-iterations))
(nreverse occurrences)))
+(defun calendar-sync--parse-byday-entry (entry)
+ "Parse a single RRULE BYDAY ENTRY into a cons (ORDINAL . WEEKDAY).
+ENTRY is a string like \"2WE\" (2nd Wednesday), \"-1TU\" (last Tuesday),
+or \"SU\" (bare weekday). ORDINAL is nil for a bare weekday. WEEKDAY is
+1-7 (Monday = 1). Returns nil for unparseable input."
+ (when (and (stringp entry)
+ (string-match "\\`\\(-?[0-9]+\\)?\\([A-Z][A-Z]\\)\\'" entry))
+ (let ((ordinal (match-string 1 entry))
+ (weekday (calendar-sync--weekday-to-number (match-string 2 entry))))
+ (when weekday
+ (cons (and ordinal (string-to-number ordinal)) weekday)))))
+
+(defun calendar-sync--byday-days-in-month (year month byday-entries bysetpos)
+ "Return the sorted day-of-month list BYDAY-ENTRIES select in YEAR/MONTH.
+An entry with an ordinal (\"2WE\") resolves directly via
+`calendar-sync--nth-weekday-of-month'. A bare entry (\"SU\") expands to
+every matching weekday in the month. When BYSETPOS is non-nil it then
+selects one day from the combined set (1-based; negative counts from the
+end), per RFC 5545 3.8.5.3. Months with no match return nil."
+ (let ((days '()))
+ (dolist (entry byday-entries)
+ (let ((parsed (calendar-sync--parse-byday-entry entry)))
+ (when parsed
+ (let ((ordinal (car parsed))
+ (weekday (cdr parsed)))
+ (if ordinal
+ (let ((day (calendar-sync--nth-weekday-of-month year month weekday ordinal)))
+ (when day (push day days)))
+ (let ((n 1) day)
+ (while (setq day (calendar-sync--nth-weekday-of-month year month weekday n))
+ (push day days)
+ (setq n (1+ n)))))))))
+ (setq days (sort (delete-dups days) #'<))
+ (if (and bysetpos days)
+ (let* ((total (length days))
+ (index (if (> bysetpos 0) bysetpos (+ total bysetpos 1))))
+ (if (and (>= index 1) (<= index total))
+ (list (nth (1- index) days))
+ '()))
+ days)))
+
+(defun calendar-sync--expand-monthly-byday (base-event rrule range)
+ "Expand a monthly nth-weekday (BYDAY) recurring event.
+BASE-EVENT is the event plist, RRULE is parsed rrule (carrying :byday and
+optionally :bysetpos), RANGE is date range. Steps month by month from
+DTSTART's month, landing each occurrence on the day its BYDAY rule selects
+-- never on DTSTART's day-of-month."
+ (let* ((start (plist-get base-event :start))
+ (interval (plist-get rrule :interval))
+ (byday (plist-get rrule :byday))
+ (bysetpos (plist-get rrule :bysetpos))
+ (until (plist-get rrule :until))
+ (count (plist-get rrule :count))
+ (occurrences '())
+ (month-anchor (list (nth 0 start) (nth 1 start) 1))
+ (start-day (nth 2 start))
+ (first-month t)
+ (num-generated 0)
+ (range-end-time (cadr range))
+ (max-iterations 1000)
+ (iterations 0))
+ (when (<= interval 0)
+ (error "Invalid RRULE interval: %s (must be > 0)" interval))
+ (while (and (< iterations max-iterations)
+ (or count until
+ (time-less-p (calendar-sync--date-to-time month-anchor) range-end-time))
+ (or (not count) (< num-generated count))
+ ;; A month starting after UNTIL can't contain an occurrence
+ ;; on-or-before it (UNTIL is inclusive, RFC 5545 3.3.10).
+ (or (not until) (calendar-sync--date-on-or-before-p month-anchor until)))
+ (setq iterations (1+ iterations))
+ (dolist (day (calendar-sync--byday-days-in-month
+ (nth 0 month-anchor) (nth 1 month-anchor) byday bysetpos))
+ (let* ((occurrence-date (list (nth 0 month-anchor) (nth 1 month-anchor) day))
+ (occurrence-datetime (append occurrence-date (nthcdr 3 start))))
+ ;; The series starts at DTSTART: skip earlier days in the first month.
+ (unless (and first-month (< day start-day))
+ (when (or (not until) (calendar-sync--date-on-or-before-p occurrence-date until))
+ (when (or (not count) (< num-generated count))
+ (setq num-generated (1+ num-generated))
+ (when (calendar-sync--date-in-range-p occurrence-datetime range)
+ (push (calendar-sync--create-occurrence base-event occurrence-datetime)
+ occurrences)))))))
+ (setq first-month nil)
+ (setq month-anchor (calendar-sync--add-months month-anchor interval)))
+ (when (>= iterations max-iterations)
+ (calendar-sync--log-silently
+ "calendar-sync: WARNING: Hit max iterations (%d) expanding monthly BYDAY event"
+ max-iterations))
+ (nreverse occurrences)))
+
(defun calendar-sync--expand-monthly (base-event rrule range)
"Expand monthly recurring event.
-BASE-EVENT is the event plist, RRULE is parsed rrule, RANGE is date range."
- (calendar-sync--expand-simple-recurrence
- base-event rrule range #'calendar-sync--add-months))
+BASE-EVENT is the event plist, RRULE is parsed rrule, RANGE is date range.
+A rule with BYDAY (nth weekday, e.g. 2WE, -1TU, or SU with BYSETPOS)
+expands via `calendar-sync--expand-monthly-byday'; a plain rule steps
+DTSTART's day-of-month."
+ (if (plist-get rrule :byday)
+ (calendar-sync--expand-monthly-byday base-event rrule range)
+ (calendar-sync--expand-simple-recurrence
+ base-event rrule range #'calendar-sync--add-months)))
+
+(defun calendar-sync--expand-yearly-byday (base-event rrule range)
+ "Expand a yearly nth-weekday event (e.g. BYMONTH=3;BYDAY=2SU).
+BASE-EVENT is the event plist, RRULE is parsed rrule, RANGE is date range.
+Reuses the monthly BYDAY expander with a 12-month step, anchored on
+:bymonth (falling back to DTSTART's month)."
+ (let* ((start (plist-get base-event :start))
+ (month (or (plist-get rrule :bymonth) (nth 1 start)))
+ (sched-event (plist-put (copy-sequence base-event) :start
+ (append (list (nth 0 start) month (nth 2 start))
+ (nthcdr 3 start))))
+ (sched-rrule (plist-put (copy-sequence rrule) :interval
+ (* 12 (or (plist-get rrule :interval) 1)))))
+ (calendar-sync--expand-monthly-byday sched-event sched-rrule range)))
(defun calendar-sync--expand-yearly (base-event rrule range)
"Expand yearly recurring event.
-BASE-EVENT is the event plist, RRULE is parsed rrule, RANGE is date range."
- (calendar-sync--expand-simple-recurrence
- base-event rrule range
- (lambda (date interval) (calendar-sync--add-months date (* 12 interval)))))
+BASE-EVENT is the event plist, RRULE is parsed rrule, RANGE is date range.
+A rule with BYDAY (the DST clock-change shape, BYMONTH=n;BYDAY=nWD)
+expands via `calendar-sync--expand-yearly-byday'; a plain rule repeats
+DTSTART's calendar date."
+ (if (plist-get rrule :byday)
+ (calendar-sync--expand-yearly-byday base-event rrule range)
+ (calendar-sync--expand-simple-recurrence
+ base-event rrule range
+ (lambda (date interval) (calendar-sync--add-months date (* 12 interval))))))
(defun calendar-sync--expand-recurring-event (event-str range)
"Expand recurring event EVENT-STR into individual occurrences within RANGE.