mirror of
git://git.sv.gnu.org/emacs.git
synced 2026-04-03 21:02:08 -07:00
* lisp/calendar/icalendar-mode.el: Update file header. Fix error display in 'icalendar-errors-mode': * lisp/calendar/icalendar.el (icalendar-error-regexp): Fix to allow " *UNFOLDED:" prefix in buffer names. (Extra colon was breaking match.) (icalendar-format-error): Suppress this prefix preferentially in long buffer names. Add declarations to some iCalendar macros: * lisp/calendar/icalendar-macs.el (icalendar-with-node-value) (icalendar-with-child-of) (icalendar-with-param-of) (icalendar-with-node-children) (icalendar-with-node-value) (icalendar-with-param) * lisp/calendar/icalendar-ast.el (icalendar-make-property) (icalendar-make-component) (icalendar-make-node-from-templates): Add (declare ...) forms. Add `icalendar-trimp' to icalendar-utils.el: * lisp/calendar/icalendar-utils.el (icalendar-trimp): New function. * lisp/calendar/diary-icalendar.el (diary-icalendar-format-entry) (diary-icalendar-parse-attendees-and-organizer) (diary-icalendar-parse-location) (diary-icalendar-parse-url) (diary-icalendar-parse-uid): Use it to replace diary-icalendar--nonempty. (diary-icalendar--nonempty): Remove. Move VTIMEZONE creation to icalendar-recur.el: The following changes move `diary-icalendar-current-tz-to-vtimezone' and associated code to icalendar-recur.el. Library users are likely to need this function, so it makes sense to keep it with other time zone-related code in that file, instead of having them depend on diary-icalendar. * lisp/calendar/icalendar-recur.el (icalendar-tz-data-insufficient) (icalendar-tz-unsupported): New error types. (icalendar-recur-current-tz-to-vtimezone): Rename from `diary-icalendar-current-tz-to-vtimezone'; signal new error types. (icalendar-recur--tz-warning): Rename from `diary-icalendar--tz-warning'. (icalendar-recur--emacs-local-tzid): Rename from `diary-icalendar--emacs-local-tzid'. (icalendar-recur--tz-info-sexp-p): Rename from `diary-icalendar--tz-info-sexp-p'. * lisp/calendar/diary-icalendar.el (diary-icalendar-current-tz-to-vtimezone): Reimplement with `icalendar-recur-current-tz-to-vtimezone'. (diary-icalendar--tz-warning) (diary-icalendar--emacs-local-tzid) (diary-icalendar--tz-info-sexp-p): Renamed and moved; see above. (diary-time-zone-export-strategy): Update validation function name.
754 lines
33 KiB
EmacsLisp
754 lines
33 KiB
EmacsLisp
;;; icalendar-utils.el --- iCalendar utility functions -*- lexical-binding: t; -*-
|
|
|
|
;; Copyright (C) 2024 Richard Lawrence
|
|
|
|
;; Author: Richard Lawrence <rwl@recursewithless.net>
|
|
;; Created: January 2025
|
|
;; Keywords: calendar
|
|
|
|
;; This file is part of GNU Emacs.
|
|
|
|
;; This file is free software: you can redistribute it and/or modify
|
|
;; it under the terms of the GNU General Public License as published by
|
|
;; the Free Software Foundation, either version 3 of the License, or
|
|
;; (at your option) any later version.
|
|
|
|
;; This file is distributed in the hope that it will be useful,
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
;; GNU General Public License for more details.
|
|
|
|
;; You should have received a copy of the GNU General Public License
|
|
;; along with this file. If not, see <https://www.gnu.org/licenses/>.
|
|
|
|
;;; Commentary:
|
|
|
|
;; This file contains a variety of utility functions to work with
|
|
;; iCalendar data which are used throughout the rest of the iCalendar
|
|
;; library. Most of the functions here deal with calendar and clock
|
|
;; arithmetic, and help smooth over the type distinction between plain
|
|
;; dates and date-times.
|
|
|
|
;;; Code:
|
|
(require 'cl-lib)
|
|
(require 'calendar)
|
|
(eval-when-compile (require 'icalendar-macs))
|
|
(require 'icalendar-parser)
|
|
|
|
;; Accessors for commonly used properties
|
|
|
|
(defun ical:component-dtstart (component)
|
|
"Return the value of the `icalendar-dtstart' property of COMPONENT.
|
|
COMPONENT can be any component node."
|
|
(ical:with-property-of component 'ical:dtstart nil value))
|
|
|
|
(defun ical:component-dtend (component)
|
|
"Return the value of the `icalendar-dtend' property of COMPONENT.
|
|
COMPONENT can be any component node."
|
|
(ical:with-property-of component 'ical:dtend nil value))
|
|
|
|
(defun ical:component-rdate (component)
|
|
"Return the value of the `icalendar-rdate' property of COMPONENT.
|
|
COMPONENT can be any component node."
|
|
(ical:with-property-of component 'ical:rdate nil value))
|
|
|
|
(defun ical:component-summary (component)
|
|
"Return the value of the `icalendar-summary' property of COMPONENT.
|
|
COMPONENT can be any component node."
|
|
(ical:with-property-of component 'ical:summary nil value))
|
|
|
|
(defun ical:component-description (component)
|
|
"Return the value of the `icalendar-description' property of COMPONENT.
|
|
COMPONENT can be any component node."
|
|
(ical:with-property-of component 'ical:description nil value))
|
|
|
|
(defun ical:component-tzname (component)
|
|
"Return the value of the `icalendar-tzname' property of COMPONENT.
|
|
COMPONENT can be any component node."
|
|
(ical:with-property-of component 'ical:tzname nil value))
|
|
|
|
(defun ical:component-uid (component)
|
|
"Return the value of the `icalendar-uid' property of COMPONENT.
|
|
COMPONENT can be any component node."
|
|
(ical:with-property-of component 'ical:uid nil value))
|
|
|
|
(defun ical:component-url (component)
|
|
"Return the value of the `icalendar-url' property of COMPONENT.
|
|
COMPONENT can be any component node."
|
|
(ical:with-property-of component 'ical:url nil value))
|
|
|
|
(defun ical:property-tzid (property)
|
|
"Return the value of the `icalendar-tzid' parameter of PROPERTY."
|
|
(ical:with-param-of property 'ical:tzidparam nil value))
|
|
|
|
;; String manipulation
|
|
(defun ical:trimp (s &optional trim-left trim-right)
|
|
"Like `string-trim', but return nil if the trimmed string is empty."
|
|
(when (and s (stringp s))
|
|
(let ((trimmed (string-trim s trim-left trim-right)))
|
|
(unless (equal "" trimmed) trimmed))))
|
|
|
|
(defun ical:strip-mailto (s)
|
|
"Remove \"mailto:\" case-insensitively from the start of S."
|
|
(let ((case-fold-search t))
|
|
(replace-regexp-in-string "^mailto:" "" s)))
|
|
|
|
|
|
;; Date/time
|
|
|
|
;; N.B. Notation: "date/time" is used in function names when a function
|
|
;; can accept either `icalendar-date' or `icalendar-date-time' values;
|
|
;; in contrast, "date-time" means it accepts *only*
|
|
;; `icalendar-date-time' values, not plain dates.
|
|
;; TODO: turn all the 'date/time' functions into methods dispatched by
|
|
;; type?
|
|
|
|
(defun ical:date-time-to-date (dt)
|
|
"Convert an `icalendar-date-time' value DT to an `icalendar-date'."
|
|
(list (decoded-time-month dt)
|
|
(decoded-time-day dt)
|
|
(decoded-time-year dt)))
|
|
|
|
(cl-defun ical:date-to-date-time (dt &key (hour 0) (minute 0) (second 0) (tz nil))
|
|
"Convert an `icalendar-date' value DT to an `icalendar-date-time'.
|
|
|
|
The following keyword arguments are accepted:
|
|
:hour, :minute, :second - integers representing a local clock time on date DT
|
|
:tz - an `icalendar-vtimezone' in which to interpret this clock time
|
|
|
|
If these arguments are all unspecified, the hour, minute, and second
|
|
slots of the returned date-time will be zero, and it will contain no
|
|
time zone information. See `icalendar-make-date-time' for more on these
|
|
arguments."
|
|
(ical:make-date-time
|
|
:year (calendar-extract-year dt)
|
|
:month (calendar-extract-month dt)
|
|
:day (calendar-extract-day dt)
|
|
:hour hour
|
|
:minute minute
|
|
:second second
|
|
:tz tz))
|
|
|
|
(defun ical:date/time-to-date (dt)
|
|
"Extract a Gregorian date from DT.
|
|
An `icalendar-date' value is returned unchanged.
|
|
An `icalendar-date-time' value is converted to an `icalendar-date'."
|
|
(if (cl-typep dt 'ical:date)
|
|
dt
|
|
(ical:date-time-to-date dt)))
|
|
|
|
;; Type-aware accessors for date/time slots that work for both ical:date
|
|
;; and ical:date-time:
|
|
;; NOTE: cl-typecase ONLY works here if dt is valid according to
|
|
;; `ical:-decoded-date-time-p'! May need to adjust this if it's
|
|
;; necessary to work with incomplete decoded-times
|
|
(defun ical:date/time-year (dt)
|
|
"Return DT's year slot.
|
|
DT may be either an `icalendar-date' or an `icalendar-date-time'."
|
|
(cl-typecase dt
|
|
(ical:date (calendar-extract-year dt))
|
|
(ical:date-time (decoded-time-year dt))))
|
|
|
|
(defun ical:date/time-month (dt)
|
|
"Return DT's month slot.
|
|
DT may be either an `icalendar-date' or an `icalendar-date-time'."
|
|
(cl-typecase dt
|
|
(ical:date (calendar-extract-month dt))
|
|
(ical:date-time (decoded-time-month dt))))
|
|
|
|
(defun ical:date/time-monthday (dt)
|
|
"Return DT's day of the month slot.
|
|
DT may be either an `icalendar-date' or an `icalendar-date-time'."
|
|
(cl-typecase dt
|
|
(ical:date (calendar-extract-day dt))
|
|
(ical:date-time (decoded-time-day dt))))
|
|
|
|
(defun ical:date/time-weekno (dt &optional weekstart)
|
|
"Return DT's ISO week number.
|
|
DT may be either an `icalendar-date' or an `icalendar-date-time'.
|
|
WEEKSTART defaults to 1; it represents the day which starts the week,
|
|
and should be an integer between 0 (= Sunday) and 6 (= Saturday)."
|
|
;; TODO: Add support for weekstart.
|
|
;; calendar-iso-from-absolute doesn't support this yet.
|
|
(when (and weekstart (not (= weekstart 1)))
|
|
(error "Support for WEEKSTART other than 1 (=Monday) not implemented yet"))
|
|
(let* ((gdate (ical:date/time-to-date dt))
|
|
(isodate (calendar-iso-from-absolute
|
|
(calendar-absolute-from-gregorian gdate)))
|
|
(weekno (car isodate)))
|
|
weekno))
|
|
|
|
(defun ical:date/time-weekday (dt)
|
|
"Return DT's day of the week.
|
|
DT may be either an `icalendar-date' or an `icalendar-date-time'."
|
|
(cl-typecase dt
|
|
(ical:date (calendar-day-of-week dt))
|
|
(ical:date-time
|
|
(or (decoded-time-weekday dt)
|
|
;; compensate for possibly-nil weekday slot if the date-time
|
|
;; has been constructed by `make-decoded-time'; cf. comment
|
|
;; in `icalendar--decoded-date-time-p':
|
|
(calendar-day-of-week (ical:date-time-to-date dt))))))
|
|
|
|
(defun ical:date/time-hour (dt)
|
|
"Return DT's hour slot, or nil.
|
|
DT may be either an `icalendar-date' or an `icalendar-date-time'."
|
|
(when (cl-typep dt 'ical:date-time)
|
|
(decoded-time-hour dt)))
|
|
|
|
(defun ical:date/time-minute (dt)
|
|
"Return DT's minute slot, or nil.
|
|
DT may be either an `icalendar-date' or an `icalendar-date-time'."
|
|
(when (cl-typep dt 'ical:date-time)
|
|
(decoded-time-minute dt)))
|
|
|
|
(defun ical:date/time-second (dt)
|
|
"Return DT's second slot, or nil.
|
|
DT may be either an `icalendar-date' or an `icalendar-date-time'."
|
|
(when (cl-typep dt 'ical:date-time)
|
|
(decoded-time-second dt)))
|
|
|
|
(defun ical:date/time-zone (dt)
|
|
"Return DT's time zone slot, or nil.
|
|
DT may be either an `icalendar-date' or an `icalendar-date-time'."
|
|
(when (cl-typep dt 'ical:date-time)
|
|
(decoded-time-zone dt)))
|
|
|
|
;;; Date/time comparisons and arithmetic:
|
|
(defun ical:date< (dt1 dt2)
|
|
"Return non-nil if date DT1 is strictly earlier than date DT2.
|
|
DT1 and DT2 must both be `icalendar-date' values of the form (MONTH DAY YEAR)."
|
|
(< (calendar-absolute-from-gregorian dt1)
|
|
(calendar-absolute-from-gregorian dt2)))
|
|
|
|
(defun ical:date<= (dt1 dt2)
|
|
"Return non-nil if date DT1 is earlier than or the same date as DT2.
|
|
DT1 and DT2 must both be `icalendar-date' values of the form (MONTH DAY YEAR)."
|
|
(or (calendar-date-equal dt1 dt2) (ical:date< dt1 dt2)))
|
|
|
|
(defun ical:date-time-locally-earlier (dt1 dt2 &optional or-equal)
|
|
"Return non-nil if date-time DT1 is locally earlier than DT2.
|
|
|
|
Unlike `icalendar-date-time<', this function assumes both times are
|
|
local to some time zone and does not consider their zone information.
|
|
|
|
If OR-EQUAL is non-nil, this function acts like `<=' rather than `<':
|
|
it will return non-nil if DT1 and DT2 are locally the same time."
|
|
(let ((year1 (decoded-time-year dt1))
|
|
(year2 (decoded-time-year dt2))
|
|
(month1 (decoded-time-month dt1))
|
|
(month2 (decoded-time-month dt2))
|
|
(day1 (decoded-time-day dt1))
|
|
(day2 (decoded-time-day dt2))
|
|
(hour1 (decoded-time-hour dt1))
|
|
(hour2 (decoded-time-hour dt2))
|
|
(minute1 (decoded-time-minute dt1))
|
|
(minute2 (decoded-time-minute dt2))
|
|
(second1 (decoded-time-second dt1))
|
|
(second2 (decoded-time-second dt2)))
|
|
(or (< year1 year2)
|
|
(and (= year1 year2)
|
|
(or (< month1 month2)
|
|
(and (= month1 month2)
|
|
(or (< day1 day2)
|
|
(and (= day1 day2)
|
|
(or (< hour1 hour2)
|
|
(and (= hour1 hour2)
|
|
(or (< minute1 minute2)
|
|
(and (= minute1 minute2)
|
|
(if or-equal
|
|
(<= second1 second2)
|
|
(< second1 second2))))))))))))))
|
|
|
|
(defun ical:date-time-locally< (dt1 dt2)
|
|
"Return non-nil if date-time DT1 is locally strictly earlier than DT2.
|
|
|
|
Unlike `icalendar-date-time<', this function assumes both times are
|
|
local to some time zone and does not consider their zone information."
|
|
(ical:date-time-locally-earlier dt1 dt2 nil))
|
|
|
|
(defun ical:date-time-locally<= (dt1 dt2)
|
|
"Return non-nil if date-time DT1 is locally earlier than, or equal to, DT2.
|
|
|
|
Unlike `icalendar-date-time<=', this function assumes both times are
|
|
local to some time zone and does not consider their zone information."
|
|
(ical:date-time-locally-earlier dt1 dt2 t))
|
|
|
|
(defun ical:date-time< (dt1 dt2)
|
|
"Return non-nil if date-time DT1 is strictly earlier than DT2.
|
|
|
|
DT1 and DT2 must both be decoded times, and either both or neither
|
|
should have time zone information.
|
|
|
|
If one has a time zone offset and the other does not, the offset
|
|
returned from `current-time-zone' is used as the missing offset; if
|
|
`current-time-zone' cannot provide this information, an error is
|
|
signaled."
|
|
(let ((zone1 (decoded-time-zone dt1))
|
|
(zone2 (decoded-time-zone dt2)))
|
|
(cond ((and (integerp zone1) (integerp zone2))
|
|
(time-less-p (encode-time dt1) (encode-time dt2)))
|
|
((and (null zone1) (null zone2))
|
|
(ical:date-time-locally< dt1 dt2))
|
|
(t
|
|
;; Cf. RFC5545 Sec. 3.3.5:
|
|
;; "The recipient of an iCalendar object with a property value
|
|
;; consisting of a local time, without any relative time zone
|
|
;; information, SHOULD interpret the value as being fixed to whatever
|
|
;; time zone the "ATTENDEE" is in at any given moment. This means
|
|
;; that two "Attendees", in different time zones, receiving the same
|
|
;; event definition as a floating time, may be participating in the
|
|
;; event at different actual times. Floating time SHOULD only be
|
|
;; used where that is the reasonable behavior."
|
|
;; I'm interpreting this to mean that if we get here, where
|
|
;; one date-time has zone information and the other doesn't,
|
|
;; we should use the offset from (current-time-zone).
|
|
(let* ((user-tz (current-time-zone))
|
|
(user-offset (car user-tz))
|
|
(dt1z (ical:date-time-variant dt1 :zone (or zone1 user-offset)))
|
|
(dt2z (ical:date-time-variant dt2 :zone (or zone2 user-offset))))
|
|
(if user-offset
|
|
(time-less-p (encode-time dt1z) (encode-time dt2z))
|
|
(error "Too little zone information for comparison: %s %s"
|
|
dt1 dt2)))))))
|
|
|
|
;; Two different notions of equality are relevant to decoded times:
|
|
;; strict equality (`icalendar-date-time=') of all slots, or
|
|
;; simultaneity (`icalendar-date-time-simultaneous-p').
|
|
;; Most tests probably want the strict notion, because it distinguishes
|
|
;; between simultaneous events decoded into different time zones,
|
|
;; whereas most user-facing functions (e.g. sorting events by date and time)
|
|
;; probably want simultaneity.
|
|
(defun ical:date-time= (dt1 dt2)
|
|
"Return non-nil if DT1 and DT2 are decoded-times with identical slot values.
|
|
|
|
Note that this function returns nil if DT1 and DT2 represent times in
|
|
different time zones, even if they are simultaneous. For the latter, see
|
|
`icalendar-date-time-simultaneous-p'."
|
|
(equal dt1 dt2))
|
|
|
|
(defun ical:date-time-locally-simultaneous-p (dt1 dt2)
|
|
"Return non-nil if DT1 and DT2 are locally simultaneous date-times.
|
|
Note that this function ignores zone information in dt1 and dt2. It
|
|
returns non-nil if DT1 and DT2 represent the same clock time in
|
|
different time zones, even if they encode to different absolute times."
|
|
(and (eq (decoded-time-year dt1) (decoded-time-year dt2))
|
|
(eq (decoded-time-month dt1) (decoded-time-month dt2))
|
|
(eq (decoded-time-day dt1) (decoded-time-day dt2))
|
|
(eq (decoded-time-hour dt1) (decoded-time-hour dt2))
|
|
(eq (decoded-time-minute dt1) (decoded-time-minute dt2))
|
|
(eq (decoded-time-second dt1) (decoded-time-second dt2))))
|
|
|
|
(defun ical:date-time-simultaneous-p (dt1 dt2)
|
|
"Return non-nil if DT1 and DT2 are simultaneous date-times.
|
|
|
|
This function returns non-nil if DT1 and DT2 encode to the same Lisp
|
|
timestamp. Thus they can count as simultaneous even if they represent
|
|
times in different timezones. If both date-times lack an offset from
|
|
UTC, they are treated as simultaneous if they encode to the same
|
|
timestamp in UTC.
|
|
|
|
If only one date-time has an offset, they are treated as
|
|
non-simultaneous if they represent different clock times according to
|
|
`icalendar-date-time-locally-simultaneous-p'. Otherwise an error is
|
|
signaled."
|
|
(let ((zone1 (decoded-time-zone dt1))
|
|
(zone2 (decoded-time-zone dt2)))
|
|
(cond ((and (integerp zone1) (integerp zone2))
|
|
(time-equal-p (encode-time dt1) (encode-time dt2)))
|
|
((and (null zone1) (null zone2))
|
|
(time-equal-p (encode-time (ical:date-time-variant dt1 :zone 0))
|
|
(encode-time (ical:date-time-variant dt2 :zone 0))))
|
|
(t
|
|
;; Best effort:
|
|
;; TODO: I'm not convinced this is the right thing to do yet.
|
|
;; Might want to be stricter here and fix the problem of comparing
|
|
;; times with and without zone information elsewhere.
|
|
(if (ical:date-time-locally-simultaneous-p dt1 dt2)
|
|
(error "Missing zone information: %s %s" dt1 dt2)
|
|
nil)))))
|
|
|
|
(defun ical:date-time<= (dt1 dt2)
|
|
"Return non-nil if DT1 is earlier than, or simultaneous with, DT2.
|
|
DT1 and DT2 must both be decoded times, and either both or neither must have
|
|
time zone information."
|
|
(or (ical:date-time< dt1 dt2)
|
|
(ical:date-time-simultaneous-p dt1 dt2)))
|
|
|
|
(defun ical:date/time< (dt1 dt2)
|
|
"Return non-nil if DT1 is strictly earlier than DT2.
|
|
DT1 and DT2 must be either `icalendar-date' or `icalendar-date-time'
|
|
values. If they are not of the same type, only the date in the
|
|
`icalendar-date-time' value will be considered."
|
|
(cl-typecase dt1
|
|
(ical:date
|
|
(if (cl-typep dt2 'ical:date)
|
|
(ical:date< dt1 dt2)
|
|
(ical:date< dt1 (ical:date-time-to-date dt2))))
|
|
|
|
(ical:date-time
|
|
(if (cl-typep dt2 'ical:date-time)
|
|
(ical:date-time< dt1 dt2)
|
|
(ical:date< (ical:date-time-to-date dt1) dt2)))))
|
|
|
|
(defun ical:date/time<= (dt1 dt2)
|
|
"Return non-nil if DT1 is earlier than or simultaneous to DT2.
|
|
DT1 and DT2 must be either `icalendar-date' or `icalendar-date-time'
|
|
values. If they are not of the same type, only the date in the
|
|
`icalendar-date-time' value will be considered."
|
|
(cl-typecase dt1
|
|
(ical:date
|
|
(if (cl-typep dt2 'ical:date)
|
|
(ical:date<= dt1 dt2)
|
|
(ical:date<= dt1 (ical:date-time-to-date dt2))))
|
|
|
|
(ical:date-time
|
|
(if (cl-typep dt2 'ical:date-time)
|
|
(ical:date-time<= dt1 dt2)
|
|
(ical:date<= (ical:date-time-to-date dt1) dt2)))))
|
|
|
|
(defun ical:date/time-min (&rest dts)
|
|
"Return the earliest date or date-time among DTS.
|
|
|
|
The DTS may be any `icalendar-date' or `icalendar-date-time' values, and
|
|
will be ordered by `icalendar-date/time<='."
|
|
(car (sort dts :lessp #'ical:date/time<=)))
|
|
|
|
(defun ical:date/time-max (&rest dts)
|
|
"Return the latest date or date-time among DTS.
|
|
|
|
The DTS may be any `icalendar-date' or `icalendar-date-time' values, and
|
|
will be ordered by `icalendar-date/time<='."
|
|
(car (sort dts :reverse t :lessp #'ical:date/time<=)))
|
|
|
|
(defun ical:date-add (date unit n)
|
|
"Add N UNITs to DATE.
|
|
|
|
UNIT should be `:year', `:month', `:week', or `:day'; time units will be
|
|
ignored. N may be a positive or negative integer."
|
|
(if (memq unit '(:hour :minute :second))
|
|
date
|
|
(let* ((dt (ical:make-date-time :year (calendar-extract-year date)
|
|
:month (calendar-extract-month date)
|
|
:day (calendar-extract-day date)))
|
|
(delta (if (eq unit :week)
|
|
(make-decoded-time :day (* 7 n))
|
|
(make-decoded-time unit n)))
|
|
(new-dt (decoded-time-add dt delta)))
|
|
(ical:date-time-to-date new-dt))))
|
|
|
|
(defun ical:date-time-add (dt delta &optional vtimezone)
|
|
"Like `decoded-time-add', but also updates weekday and time zone slots.
|
|
|
|
DT and DELTA should be `icalendar-date-time' values (decoded times), as
|
|
in `decoded-time-add'. VTIMEZONE, if given, should be an
|
|
`icalendar-vtimezone'. The resulting date-time will be given the offset
|
|
determined by VTIMEZONE at the local time determined by adding DELTA to
|
|
DT.
|
|
|
|
This function assumes that time units in DELTA larger than an hour
|
|
should not affect the local clock time in the result, even when crossing
|
|
an observance boundary in VTIMEZONE. This means that e.g. if DT is at
|
|
9AM daylight savings time on the day before the transition to standard
|
|
time, then the result of adding a DELTA of two days will be at 9AM
|
|
standard time, even though this is not exactly 48 hours later. Adding a
|
|
DELTA of 48 hours, on the other hand, will result in a time exactly 48
|
|
hours later, but at a different local time."
|
|
(require 'icalendar-recur) ; for icr:tz-decode-time; avoids circular requires
|
|
(declare-function icalendar-recur-tz-decode-time "icalendar-recur")
|
|
|
|
(if (not vtimezone)
|
|
;; the simple case: we have no time zone info, so just use
|
|
;; `decoded-time-add':
|
|
(let ((sum (decoded-time-add dt delta)))
|
|
(ical:date-time-variant sum))
|
|
;; `decoded-time-add' does not take time zone shifts into account,
|
|
;; so we need to do the adjustment ourselves. We first add the units
|
|
;; larger than an hour using `decoded-time-add', holding the clock
|
|
;; time fixed, as described in the docstring. Then we add the time
|
|
;; units as a fixed number of seconds and re-decode the resulting
|
|
;; absolute time into the time zone.
|
|
(let* ((cal-delta (make-decoded-time :year (or (decoded-time-year delta) 0)
|
|
:month (or (decoded-time-month delta) 0)
|
|
:day (or (decoded-time-day delta) 0)))
|
|
(cal-sum (decoded-time-add dt cal-delta))
|
|
(dt-w/zone (ical:date-time-variant cal-sum
|
|
:tz vtimezone))
|
|
(secs-delta (+ (or (decoded-time-second delta) 0)
|
|
(* 60 (or (decoded-time-minute delta) 0))
|
|
(* 60 60 (or (decoded-time-hour delta) 0))))
|
|
(sum-ts (time-add (encode-time dt-w/zone) secs-delta)))
|
|
(icalendar-recur-tz-decode-time sum-ts vtimezone))))
|
|
|
|
;; TODO: rework so that it's possible to add dur-values to plain dates.
|
|
;; Perhaps rename this to "date/time-inc" or so, or use kwargs to allow
|
|
;; multiple units, or...
|
|
(defun ical:date/time-add (dt unit n &optional vtimezone)
|
|
"Add N UNITs to DT.
|
|
|
|
DT should be an `icalendar-date' or `icalendar-date-time'. UNIT should
|
|
be `:year', `:month', `:week', `:day', `:hour', `:minute', or `:second';
|
|
time units will be ignored if DT is an `icalendar-date'. N may be a
|
|
positive or negative integer."
|
|
(cl-typecase dt
|
|
(ical:date-time
|
|
(let ((delta (if (eq unit :week) (make-decoded-time :day (* 7 n))
|
|
(make-decoded-time unit n))))
|
|
(ical:date-time-add dt delta vtimezone)))
|
|
(ical:date (ical:date-add dt unit n))))
|
|
|
|
(defun ical:date/time-add-duration (start duration &optional vtimezone)
|
|
"Return the end date(-time) which is a length of DURATION after START.
|
|
|
|
START should be an `icalendar-date' or `icalendar-date-time'; the
|
|
returned value will be of the same type as START. DURATION should be an
|
|
`icalendar-dur-value'. VTIMEZONE, if specified, should be the
|
|
`icalendar-vtimezone' representing the time zone of START."
|
|
(if (integerp duration)
|
|
;; number of weeks:
|
|
(setq duration (make-decoded-time :day (* 7 duration))))
|
|
(cl-typecase start
|
|
(ical:date
|
|
(ical:date-time-to-date
|
|
(ical:date-time-add (ical:date-to-date-time start) duration)))
|
|
(ical:date-time
|
|
(ical:date-time-add start duration vtimezone))))
|
|
|
|
(defun ical:duration-between (start end)
|
|
"Return the duration between START and END.
|
|
|
|
START should be an `icalendar-date' or `icalendar-date-time'; END must
|
|
be of the same type as START. The returned value is an
|
|
`icalendar-dur-value', i.e., a time delta in the sense of
|
|
`decoded-time-add'."
|
|
(cl-typecase start
|
|
(ical:date
|
|
(make-decoded-time :day (- (calendar-absolute-from-gregorian end)
|
|
(calendar-absolute-from-gregorian start))))
|
|
(ical:date-time
|
|
(let* ((start-abs (time-convert (encode-time start) 'integer))
|
|
(end-abs (time-convert (encode-time end) 'integer))
|
|
(dur-secs (- end-abs start-abs))
|
|
(days (/ dur-secs (* 60 60 24)))
|
|
(dur-nodays (mod dur-secs (* 60 60 24)))
|
|
(hours (/ dur-nodays (* 60 60)))
|
|
(dur-nohours (mod dur-nodays (* 60 60)))
|
|
(minutes (/ dur-nohours 60))
|
|
(seconds (mod dur-nohours 60)))
|
|
(make-decoded-time :day days
|
|
:hour hours :minute minutes :second seconds)))))
|
|
|
|
(defun ical:date/time-to-local (dt)
|
|
"Reinterpret DT in Emacs local time if necessary.
|
|
If DT is an `icalendar-date-time', encode and re-decode it into Emacs
|
|
local time. If DT is an `icalendar-date', return it unchanged."
|
|
(cl-typecase dt
|
|
(ical:date dt)
|
|
(ical:date-time
|
|
(ical:date-time-variant ; ensure weekday is present too
|
|
(decode-time (encode-time dt))))))
|
|
|
|
(defun ical:dates-until (start end &optional locally)
|
|
"Return a list of `icalendar-date' values between START and END.
|
|
|
|
START and END may be either `icalendar-date' or `icalendar-date-time'
|
|
values. START is an inclusive lower bound, and END is an exclusive
|
|
upper bound. (Note, however, that if END is a date-time and its time is
|
|
after midnight, then its date will be included in the returned list.)
|
|
|
|
If LOCALLY is non-nil and START and END are date-times, these will be
|
|
interpreted into Emacs local time, so that the dates returned are valid
|
|
for the local time zone."
|
|
(require 'icalendar-recur) ; avoid circular requires
|
|
(declare-function icalendar-recur-subintervals-to-dates "icalendar-recur")
|
|
|
|
(when locally
|
|
(when (cl-typep start 'ical:date-time)
|
|
(setq start (ical:date/time-to-local start)))
|
|
(when (cl-typep end 'ical:date-time)
|
|
(setq end (ical:date/time-to-local end))))
|
|
(cl-typecase start
|
|
(ical:date
|
|
(cl-typecase end
|
|
(ical:date
|
|
(icalendar-recur-subintervals-to-dates
|
|
(list (list (ical:date-to-date-time start)
|
|
(ical:date-to-date-time end)))))
|
|
(ical:date-time
|
|
(icalendar-recur-subintervals-to-dates
|
|
(list (list (ical:date-to-date-time start) end))))))
|
|
(ical:date-time
|
|
(cl-typecase end
|
|
(ical:date
|
|
(icalendar-recur-subintervals-to-dates
|
|
(list (list start (ical:date-to-date-time end)))))
|
|
(ical:date-time
|
|
(icalendar-recur-subintervals-to-dates (list (list start end))))))))
|
|
|
|
|
|
(cl-defun ical:make-date-time (&key second minute hour day month year
|
|
(dst -1 given-dst) zone tz)
|
|
"Make an `icalendar-date-time' from the given keyword arguments.
|
|
|
|
This function is like `make-decoded-time', except that it automatically
|
|
sets the weekday slot set based on the date arguments, and it accepts an
|
|
additional keyword argument: `:tz'. If provided, its value should be an
|
|
`icalendar-vtimezone', and the `:zone' and `:dst' arguments should not
|
|
be provided. In this case, the zone and dst slots in the returned
|
|
date-time will be adjusted to the correct values in the given time zone
|
|
for the local time represented by the remaining arguments."
|
|
(when (and tz (or zone given-dst))
|
|
(error "Possibly conflicting time zone data in args"))
|
|
(apply #'ical:date-time-variant (make-decoded-time)
|
|
`(:second ,second :minute ,minute :hour ,hour
|
|
:day ,day :month ,month :year ,year
|
|
;; Don't pass these keywords unless they were given explicitly.
|
|
;; TODO: is there a cleaner way to write this?
|
|
,@(when tz (list :tz tz))
|
|
,@(when given-dst (list :dst dst))
|
|
,@(when zone (list :zone zone)))))
|
|
|
|
(cl-defun ical:date-time-variant (dt &key second minute hour
|
|
day month year
|
|
(dst -1 given-dst)
|
|
(zone nil given-zone)
|
|
tz)
|
|
"Return a variant of DT with slots modified as in the given arguments.
|
|
|
|
DT should be an `icalendar-date-time'; the keyword arguments have the
|
|
same meanings as in `make-decoded-time'. The returned variant will have
|
|
slot values as specified by the arguments or copied from DT, except that
|
|
the weekday slot will be updated if necessary, and the zone and dst
|
|
fields will not be set unless given explicitly (because varying the date
|
|
and clock time generally invalidates the time zone information in DT).
|
|
|
|
One additional keyword argument is accepted: `:tz'. If provided, its
|
|
value should be an `icalendar-vtimezone', an `icalendar-utc-offset', or
|
|
the symbol \\='preserve. If it is a time zone component, the zone and
|
|
dst slots in the returned variant will be adjusted to the correct
|
|
values in the given time zone for the local time represented by the
|
|
variant. If it is a UTC offset, the variant's zone slot will contain
|
|
this value, but its dst slot will not be adjusted. If it is the symbol
|
|
\\='preserve, then both the zone and dst fields are copied from DT into
|
|
the variant."
|
|
(require 'icalendar-recur) ; for icr:tz-set-zone; avoids circular requires
|
|
(declare-function icalendar-recur-tz-set-zone "icalendar-recur")
|
|
|
|
(let ((variant
|
|
(make-decoded-time :second (or second (decoded-time-second dt))
|
|
:minute (or minute (decoded-time-minute dt))
|
|
:hour (or hour (decoded-time-hour dt))
|
|
:day (or day (decoded-time-day dt))
|
|
:month (or month (decoded-time-month dt))
|
|
:year (or year (decoded-time-year dt))
|
|
;; For zone and dst slots, trust the value
|
|
;; if explicitly specified or explicitly
|
|
;; requested to preserve, but not otherwise
|
|
:dst (cond (given-dst dst)
|
|
((eq 'preserve tz) (decoded-time-dst dt))
|
|
(t -1))
|
|
:zone (cond (given-zone zone)
|
|
((eq 'preserve tz) (decoded-time-zone dt))
|
|
(t nil)))))
|
|
;; update weekday slot when possible, since it depends on the date
|
|
;; slots, which might have changed. (It's not always possible,
|
|
;; because pure time values are also represented as decoded-times,
|
|
;; with empty date slots.)
|
|
(unless (or (null (decoded-time-year variant))
|
|
(null (decoded-time-month variant))
|
|
(null (decoded-time-day variant)))
|
|
(setf (decoded-time-weekday variant)
|
|
(calendar-day-of-week (ical:date-time-to-date variant))))
|
|
;; if given a time zone or UTC offset, update zone and dst slots,
|
|
;; which also might have changed:
|
|
(when (and tz (not (eq 'preserve tz)))
|
|
(icalendar-recur-tz-set-zone variant tz))
|
|
variant))
|
|
|
|
(defun ical:date/time-in-period-p (dt period &optional vtimezone)
|
|
"Return non-nil if DT occurs within PERIOD.
|
|
|
|
DT can be an `icalendar-date' or `icalendar-date-time' value. PERIOD
|
|
should be an `icalendar-period' value. VTIMEZONE, if given, is passed
|
|
to `icalendar-period-end' to compute the end time of the period if it
|
|
was not specified explicitly."
|
|
(and (ical:date/time<= (ical:period-start period) dt)
|
|
(ical:date/time< dt (ical:period-end period vtimezone))))
|
|
|
|
;; TODO: surely this exists already?
|
|
(defun ical:time<= (a b)
|
|
"Compare two Lisp timestamps A and B: is A <= B?"
|
|
(or (time-equal-p a b)
|
|
(time-less-p a b)))
|
|
|
|
(defun ical:number-of-weeks (year &optional weekstart)
|
|
"Return the number of weeks in (Gregorian) YEAR.
|
|
|
|
RFC5545 defines week 1 as the first week to include at least four days
|
|
in the year. Weeks are assumed to start on Monday (= 1) unless WEEKSTART
|
|
is specified, in which case it should be an integer between 0 (= Sunday)
|
|
and 6 (= Saturday)."
|
|
;; There are 53 weeks in a year if Jan 1 is the fourth day after
|
|
;; WEEKSTART, e.g. if the week starts on Monday and Jan 1 is a
|
|
;; Thursday, or in a leap year if Jan 1 is the third day after WEEKSTART
|
|
(let* ((jan1wd (calendar-day-of-week (list 1 1 year)))
|
|
(delta (mod (- jan1wd (or weekstart 1)) 7)))
|
|
(if (or (= 4 delta)
|
|
(and (= 3 delta) (calendar-leap-year-p year)))
|
|
53
|
|
52)))
|
|
|
|
(defun ical:start-of-weekno (weekno year &optional weekstart)
|
|
"Return the start of the WEEKNOth week in the (Gregorian) YEAR.
|
|
|
|
RFC5545 defines week 1 as the first week to include at least four days
|
|
in the year. Weeks are assumed to start on Monday (= 1) unless WEEKSTART
|
|
is specified, in which case it should be an integer between 0 (= Sunday)
|
|
and 6 (= Saturday). The returned value is an `icalendar-date'.
|
|
|
|
If WEEKNO is negative, it refers to the WEEKNOth week before the end of
|
|
the year: -1 is the last week of the year, -2 second to last, etc."
|
|
(calendar-gregorian-from-absolute
|
|
(+
|
|
(* 7 (if (< 0 weekno)
|
|
(1- weekno)
|
|
(+ 1 weekno (ical:number-of-weeks year weekstart))))
|
|
(calendar-dayname-on-or-before
|
|
(or weekstart 1)
|
|
;; Three days after Jan 1. gives us the nearest occurrence;
|
|
;; see `calendar-dayname-on-or-before'
|
|
(+ 3 (calendar-absolute-from-gregorian (list 1 1 year)))))))
|
|
|
|
(defun ical:nth-weekday-in (n weekday year &optional month)
|
|
"Return the Nth WEEKDAY in YEAR or MONTH.
|
|
|
|
If MONTH is specified, it refers to MONTH in YEAR, and N acts as an
|
|
index for WEEKDAYs within the month. Otherwise, N acts as an index for
|
|
WEEKDAYs within the entire YEAR.
|
|
|
|
N should be an integer. If N<0, it counts from the end of the month or
|
|
year: if N=-1, it refers to the last WEEKDAY in the month or year, if
|
|
N=-2 the second to last, and so on."
|
|
(if month
|
|
(calendar-nth-named-day n weekday month year)
|
|
(let* ((jan1 (calendar-absolute-from-gregorian (list 1 1 year)))
|
|
(dec31 (calendar-absolute-from-gregorian (list 12 31 year))))
|
|
;; Adapted from `calendar-nth-named-absday'.
|
|
;; TODO: we could generalize that function to make month an optional
|
|
;; argument, but that would mean changing its interface.
|
|
(calendar-gregorian-from-absolute
|
|
(if (> n 0)
|
|
(+ (* 7 (1- n))
|
|
(calendar-dayname-on-or-before
|
|
weekday
|
|
(+ 6 jan1)))
|
|
(+ (* 7 (1+ n))
|
|
(calendar-dayname-on-or-before
|
|
weekday
|
|
dec31)))))))
|
|
|
|
(provide 'icalendar-utils)
|
|
;; Local Variables:
|
|
;; read-symbol-shorthands: (("ical:" . "icalendar-"))
|
|
;; End:
|
|
;;; icalendar-utils.el ends here
|