aboutsummaryrefslogtreecommitdiff
path: root/module/vcalendar
diff options
context:
space:
mode:
authorHugo Hörnquist <hugo@hornquist.se>2019-04-23 18:03:49 +0200
committerHugo Hörnquist <hugo@hornquist.se>2019-04-23 18:03:49 +0200
commit8f4fbcd493e28c86c598efcecdb6dc79d8fe0bfe (patch)
tree37e49d78df0916efcb0d547e0b28b63247cfec3d /module/vcalendar
parentChange event-length => event-length/day. (diff)
downloadcalp-8f4fbcd493e28c86c598efcecdb6dc79d8fe0bfe.tar.gz
calp-8f4fbcd493e28c86c598efcecdb6dc79d8fe0bfe.tar.xz
Rename module vcalendar => vcomponent.
Diffstat (limited to 'module/vcalendar')
-rw-r--r--module/vcalendar/control.scm39
-rw-r--r--module/vcalendar/datetime.scm58
-rw-r--r--module/vcalendar/output.scm96
-rw-r--r--module/vcalendar/primitive.scm22
-rw-r--r--module/vcalendar/recurrence.scm12
-rw-r--r--module/vcalendar/recurrence/generate.scm137
-rw-r--r--module/vcalendar/recurrence/internal.scm45
-rw-r--r--module/vcalendar/recurrence/parse.scm131
-rw-r--r--module/vcalendar/timezone.scm88
9 files changed, 0 insertions, 628 deletions
diff --git a/module/vcalendar/control.scm b/module/vcalendar/control.scm
deleted file mode 100644
index a38d678f..00000000
--- a/module/vcalendar/control.scm
+++ /dev/null
@@ -1,39 +0,0 @@
-(define-module (vcalendar control)
- #:use-module (util)
- #:use-module (vcalendar)
- #:export (with-replaced-attrs))
-
-
-(eval-when (expand load) ; No idea why I must have load here.
- (define href (make-procedure-with-setter hashq-ref hashq-set!))
-
- (define (set-temp-values! table component kvs)
- (for-each (lambda (kv)
- (let* (((key val) kv))
- (when (attr component key)
- (set! (href table key) (attr component key))
- (set! (attr component key) val))))
- kvs))
-
- (define (restore-values! table component keys)
- (for-each (lambda (key)
- (and=> (href table key)
- (lambda (val)
- (set! (attr component key) val))))
- keys)))
-
-;;; TODO with-added-attributes
-
-(define-syntax with-replaced-attrs
- (syntax-rules ()
- [(_ (component (key val) ...)
- body ...)
-
- (let ((htable (make-hash-table 10)))
- (dynamic-wind
- (lambda () (set-temp-values! htable component (quote ((key val) ...)))) ; In guard
- (lambda () body ...)
- (lambda () (restore-values! htable component (quote (key ...))))))])) ; Out guard
-
-;;; TODO test that restore works, at all
-;;; Test that non-local exit and return works
diff --git a/module/vcalendar/datetime.scm b/module/vcalendar/datetime.scm
deleted file mode 100644
index 1e5b5853..00000000
--- a/module/vcalendar/datetime.scm
+++ /dev/null
@@ -1,58 +0,0 @@
-(define-module (vcalendar datetime)
- #:use-module (vcalendar)
- #:use-module (srfi srfi-19)
- #:use-module (srfi srfi-19 util)
- #:use-module (util)
-
- #:export (parse-datetime
- event-overlaps?
- overlapping?
- event-in?
- ev-time<?)
- )
-
-;;; date time pointer
-(define (parse-datetime dtime)
- "Parse the given date[time] string into a date object."
- (string->date
- dtime (case (string-length dtime)
- ((8) "~Y~m~d") ; All day
- ((15) "~Y~m~dT~H~M~S") ; "local" or TZID-param
- ((16) "~Y~m~dT~H~M~S~z")))) ; UTC-time
-
-(define (event-overlaps? event begin end)
- "Returns if the event overlaps the timespan.
-Event must have the DTSTART and DTEND attribute set."
- (timespan-overlaps? (attr event 'DTSTART)
- (attr event 'DTEND)
- begin end))
-
-(define (overlapping? event-a event-b)
- (timespan-overlaps? (attr event-a 'DTSTART)
- (attr event-a 'DTEND)
- (attr event-b 'DTSTART)
- (attr event-b 'DTEND)))
-
-(define (event-in? ev time)
- "Does event overlap the date that contains time."
- (let* ((date (time-utc->date time))
- (start (date->time-utc (drop-time date)))
- (end (add-day start)))
- (event-overlaps? ev start end)))
-
-(define (ev-time<? a b)
- (time<? (attr a 'DTSTART)
- (attr b 'DTSTART)))
-
-;; Returns length of the event @var{e}, as a time-duration object.
-(define-public (event-length e)
- (time-difference
- (attr e 'DTEND)
- (attr e 'DTSTART)))
-
-;; Returns the length of the part of @var{e} which is within the day
-;; starting at the time @var{start-of-day}.
-(define-public (event-length/day e start-of-day)
- (time-difference
- (time-min (add-day start-of-day) (attr e 'DTEND))
- (time-max start-of-day (attr e 'DTSTART))))
diff --git a/module/vcalendar/output.scm b/module/vcalendar/output.scm
deleted file mode 100644
index 2abc1e08..00000000
--- a/module/vcalendar/output.scm
+++ /dev/null
@@ -1,96 +0,0 @@
-(define-module (vcalendar output)
- #:use-module (vcalendar)
- #:use-module (vcalendar control)
- #:use-module (util)
- #:use-module (srfi srfi-19 util)
- #:use-module (srfi srfi-26)
- #:use-module (ice-9 format)
- #:export (print-vcomponent
- serialize-vcomponent
- color-if
- STR-YELLOW STR-RESET))
-
-(define STR-YELLOW "\x1b[0;33m")
-(define STR-RESET "\x1b[m")
-
-(define-syntax-rule (color-if pred color body ...)
- (let ((pred-value pred))
- (format #f "~a~a~a"
- (if pred-value color "")
- (begin body ...)
- (if pred-value STR-RESET ""))))
-
-(define* (print-vcomponent comp #:optional (port #t) #:key (depth 0))
- (let ((kvs (map (lambda (key) (cons key (attr* comp key)))
- (attributes comp))))
- (format port "~a <~a> :: ~:a~%"
- (make-string depth #\:)
- (type comp) comp)
- (for-each-in kvs
- (lambda (kv)
- (let* (((key . at) kv))
- (format port "~a ~15@a~{;~a=~{~a~^,~}~}: ~a~%"
- (make-string depth #\:)
- key
- (concat (hash-map->list list (cdr at)))
- (v at)))))
- (for-each-in (children comp)
- (lambda (e) (print-vcomponent e port #:depth (1+ depth))))))
-
-
-
-;;; TODO
-;; Error in CREATED /home/hugo/.calendars/b85ba2e9-18aa-4451-91bb-b52da930e977/a1a25238-d63d-46a1-87fd-d0c9334a7a30CalSync.ics:
-;; Wrong type argument in position 1 (expecting string): ("20180118T124015Z" "VALARM")
-
-(define (string->ics-safe-string str)
- "TODO wrap at 75(?) columns."
- (define (escape char)
- (string #\\ char))
-
- (string-concatenate
- (map (lambda (c)
- (case c
- ((#\newline) "\\n")
- ((#\, #\; #\\) => escape)
- (else => string)))
- (string->list str))))
-
-;;; TODO parameters ( ;KEY=val: )
-(define* (serialize-vcomponent comp #:optional (port (current-output-port)))
- "Recursively write a component back to its ICS form.
-Removes the X-HNH-FILENAME attribute, and sets PRODID to
-\"HugoNikanor-calparse\" in the output."
- (with-replaced-attrs
- (comp (prodid "HugoNikanor-calparse"))
-
- (format port "BEGIN:~a~%" (type comp))
- (let ((kvs (map (lambda (key) (list key (attr comp key)))
- (filter (negate (cut key=? <> 'X-HNH-FILENAME))
- (attributes comp)))))
- (for-each-in
- kvs (lambda (kv)
- (let* (((key value) kv))
- (catch 'wrong-type-arg
- (lambda ()
- (format port "~a:~a~%" key
- (string->ics-safe-string
- (or (case key
- ((DTSTART DTEND)
- (if (string? value)
- value
- (time->string value "~Y~m~dT~H~M~S")))
-
- ((DURATION) "Just forget it")
-
- (else value))
- ""))))
-
- ;; Catch
- (lambda (type proc fmt . args)
- (apply format (current-error-port) "[ERR] ~a in ~a (~a) ~a:~%~?~%"
- type key proc (attr comp 'X-HNH-FILENAME)
- fmt args))))))
-
- (for-each (cut serialize-vcomponent <> port) (children comp)))
- (format port "END:~a~%" (type comp))))
diff --git a/module/vcalendar/primitive.scm b/module/vcalendar/primitive.scm
deleted file mode 100644
index 27ae6e17..00000000
--- a/module/vcalendar/primitive.scm
+++ /dev/null
@@ -1,22 +0,0 @@
-;;; Primitive export of symbols linked from C binary.
-
-(define-module (vcalendar primitive)
- #:export (%vcomponent-children
- %vcomponent-push-child!
- %vcomponent-filter-children!
-
- %vcomponent-parent
-
- %vcomponent-make
- %vcomponent-get-type
- %vcomponent-set-type!
-
- %vcomponent-get-attribute
- %vcomponent-attribute-list
-
- %vcomponent-shallow-copy))
-
-(setenv "LD_LIBRARY_PATH"
- (string-append (dirname (dirname (dirname (current-filename))))
- "/lib"))
-(load-extension "libguile-calendar" "init_lib")
diff --git a/module/vcalendar/recurrence.scm b/module/vcalendar/recurrence.scm
deleted file mode 100644
index ae08feb6..00000000
--- a/module/vcalendar/recurrence.scm
+++ /dev/null
@@ -1,12 +0,0 @@
-(define-module (vcalendar recurrence)
- #:use-module (vcalendar)
- #:use-module (vcalendar recurrence generate)
- #:re-export (generate-recurrence-set)
- #:export (repeating?))
-
-;; EXDATE is also a property linked to recurense rules
-;; but that property alone don't create a recuring event.
-(define (repeating? ev)
- "Does this event repeat?"
- (or (attr ev 'RRULE)
- (attr ev 'RDATE)))
diff --git a/module/vcalendar/recurrence/generate.scm b/module/vcalendar/recurrence/generate.scm
deleted file mode 100644
index 3baaa6eb..00000000
--- a/module/vcalendar/recurrence/generate.scm
+++ /dev/null
@@ -1,137 +0,0 @@
-(define-module (vcalendar recurrence generate)
- #:use-module (srfi srfi-19) ; Datetime
- #:use-module (srfi srfi-19 util)
- #:use-module (srfi srfi-19 setters)
- #:use-module (srfi srfi-26) ; Cut
- #:use-module (srfi srfi-41) ; Streams
- #:use-module (ice-9 match)
-
- #:use-module (util)
- #:use-module (vcalendar)
- #:use-module (vcalendar timezone)
- #:use-module (vcalendar recurrence internal)
- #:use-module (vcalendar recurrence parse)
-
- #:export (generate-recurrence-set)
- )
-
-;;; TODO implement
-;;; EXDATE and RDATE
-
-;;; EXDATE (3.8.5.1)
-;;; comma sepparated list of dates or datetimes.
-;;; Can have TZID parameter
-;;; Specifies list of dates that the event should not happen on, even
-;;; if the RRULE say so.
-;;; Can have VALUE field specifiying "DATE-TIME" or "DATE".
-
-;;; RDATE (3.8.5.2)
-;;; Comma sepparated list of dates the event should happen on.
-;;; Can have TZID parameter.
-;;; Can have VALUE parameter, specyfying "DATE-TIME", "DATE" or "PREIOD".
-;;; PERIOD (see 3.3.9)
-
-(define (seconds-in freq)
- (case freq
- ((SECONDLY) 1)
- ((MINUTELY) 60)
- ((HOURLY) (* 60 60))
- ((DAILY) (* 60 60 24))
- ((WEEKLY) (* 60 60 24 7))))
-
-;; Event x Rule → Event
-;; TODO My current naïve aproach to simple adding a constant time to an event
-;; breaks with time-zones. betwen 12:00 two adjacent days might NOT be 24h.
-;; Specifically, 23h or 25h when going between summer and "normal" time.
-(define (next-event ev r)
- (let* ((e (copy-vcomponent ev))
- (d (time-utc->date
- (attr e 'DTSTART)
- (if (prop (attr* ev 'DTSTART) 'TZID)
- (get-tz-offset e)
- 0))))
-
- (let ((i (interval r)))
- (case (freq r)
- ((SECONDLY) (mod! (second d) = (+ i)))
- ((MINUTELY) (mod! (minute d) = (+ i)))
- ((HOURLY) (mod! (hour d) = (+ i)))
- ((DAILY) (mod! (day d) = (+ i)))
- ((WEEKLY) (mod! (day d) = (+ (* i 7))))
- ((MONTHLY) (mod! (month d) = (+ i)))
- ((YEARLY) (mod! (year d) = (+ i)))))
-
- (set! (attr e 'DTSTART)
- (date->time-utc d))
-
- (when (prop (attr* e 'DTSTART) 'TZID)
- (let ((of (get-tz-offset e)))
- ;; This addition works, but we still get lunch at 13
- (set! (zone-offset d) of)))
-
- (set! (attr e 'DTSTART)
- (date->time-utc d))
-
- (when (attr e 'DTEND)
- (set! (attr e 'DTEND)
- (add-duration (attr e 'DTSTART) (attr e 'DURATION))))
-
- ;; Return
- e))
-
-;; BYDAY and the like depend on the freq?
-;; Line 7100
-;; Table @@ 2430
-;;
-;; Event x Rule → Bool (continue?)
-;; Alternative, monadic solution using <optional>.
-;; @example
-;; (optional->bool
-;; (do (<$> (cut time<=? (attr last 'DTSTART)) (until r))
-;; (<$> (negate zero?) (count r))
-;; (just #t)))
-;; @end example
-(define-stream (recur-event-stream event rule-obj)
- (stream-unfold
-
- ;; Event x Rule → Event
- car
-
- ;; Event x Rule → Bool (continue?)
- (match-lambda
- ((e r)
- (or (and (not (until r)) (not (count r))) ; Never ending
- (and=> (count r) (negate zero?)) ; COUNT
- (and=> (until r) (cut time<=? (attr e 'DTSTART) <>))))) ; UNTIL
-
- ;; Event x Rule → next (Event, Rule)
- (match-lambda
- ((e r)
- (list (next-event e r)
- (if (count r)
- ;; Note that this doesn't modify, since r is immutable.
- (mod! (count r) 1-)
- r ))))
-
- ;; Seed
- (list event rule-obj)))
-
-
-(define (generate-recurrence-set event)
- ;; TODO DURATION might be used for something else, check applicable types
- ;; TODO Far from all events have DTEND
- ;; VTIMEZONE's always lack it.
- (if (not (attr event 'RRULE))
- (stream event)
- (begin
- (when (and (attr event 'DTEND)
- (not (attr event 'DURATION)))
- (set! (attr event "DURATION")
- (time-difference
- (attr event "DTEND")
- (attr event "DTSTART"))))
- (if (attr event "RRULE")
- (recur-event-stream event (parse-recurrence-rule (attr event "RRULE")))
- ;; TODO some events STANDARD and DAYLIGT doesn't have RRULE's, but rather
- ;; just mention the current part. Handle this
- stream-null))))
diff --git a/module/vcalendar/recurrence/internal.scm b/module/vcalendar/recurrence/internal.scm
deleted file mode 100644
index 7a81b2db..00000000
--- a/module/vcalendar/recurrence/internal.scm
+++ /dev/null
@@ -1,45 +0,0 @@
-(define-module (vcalendar recurrence internal)
- #:use-module (util)
- #:use-module ((ice-9 optargs) #:select (define*-public))
- #:use-module (srfi srfi-88)
- #:export (make-recur-rule
- weekdays intervals))
-
-;; Immutable, since I easily want to be able to generate the recurence set for
-;; the same event multiple times.
-(define-quick-record recur-rule
- (public: freq until count interval bysecond byminute byhour
- byday bymonthday byyearday byweekno bymonth bysetpos
- wkst))
-
-(define (make-recur-rule interval wkst)
- ((record-constructor <recur-rule> '(interval wkst)) interval wkst))
-
-;; TODO make this part of define-quick-record.
-;; Only "hard" part would be to provide type hints for fields for
-;; string conversions.
-(define-public (format-recur-rule r)
- (define (a f)
- ((record-accessor <recur-rule> f) r))
- (with-output-to-string
- (lambda ()
- (format #t "#<recur-rule>~%")
- (for-each
- (lambda (field)
- (when (a field)
- (format #t " ~8@a: ~a~%"
- field
- ((case field
- ((until) (@ (srfi srfi-19 util) time->string))
- (else identity))
- (a field)))))
- (record-type-fields <recur-rule>)))))
-
-(define*-public (print-recur-rule r #:optional (port (current-output-port)))
- (display (format-recur-rule r) port))
-
-(define weekdays
- '(SU MO TU WE TH FR SA))
-
-(define intervals
- '(SECONDLY MINUTELY HOURLY DAILY WEEKLY MONTHLY YEARLY))
diff --git a/module/vcalendar/recurrence/parse.scm b/module/vcalendar/recurrence/parse.scm
deleted file mode 100644
index 50d0e0a8..00000000
--- a/module/vcalendar/recurrence/parse.scm
+++ /dev/null
@@ -1,131 +0,0 @@
-(define-module (vcalendar recurrence parse)
- #:use-module (srfi srfi-1)
- #:use-module (srfi srfi-19) ; Datetime
- #:use-module (srfi srfi-19 util)
- #:use-module (srfi srfi-26)
- #:use-module ((vcalendar datetime) #:select (parse-datetime))
- #:duplicates (last) ; Replace @var{count}
- #:use-module (vcalendar recurrence internal)
- #:use-module (util)
- #:use-module (exceptions)
- #:use-module (ice-9 curried-definitions)
- #:export (parse-recurrence-rule))
-
-
-(define (printerr fmt . args)
- (apply format (current-error-port)
- fmt args))
-
-(define (parse-recurrence-rule str)
- (catch-multiple
- (lambda () (%build-recur-rules str))
-
- [unfulfilled-constraint
- (cont obj key val . rest)
- (printerr "ERR ~a [~a] doesn't fulfill constraint of type [~a], ignoring~%"
- err val key)
- (cont #f)]
-
- [invalid-value
- (cont obj key val . rest)
- (printerr "ERR ~a [~a] for key [~a], ignoring.~%"
- err val key)
- (cont #f)]))
-
-(eval-when (expand)
- (define ((handle-case stx obj) key val proc)
- (with-syntax ((skey (datum->syntax
- stx (symbol-downcase (syntax->datum key)))))
- #`((#,key)
- (let ((v #,val))
- (cond ((not v) (throw-returnable 'invalid-value #,obj (quote #,key) v))
- ((#,proc #,val) (set! (skey #,obj) v))
- (else (set! (skey #,obj)
- (throw-returnable 'unfulfilled-constraint
- #,obj (quote #,key) v)))))))))
-
-
-;; A special form of case only useful in parse-recurrence-rules above.
-;; Each case is on the form (KEY val check-proc) where:
-;; `key` is what should be matched against, and what is used for the setter
-;; `val` is the value to bind to the loop object and
-;; `check` is something the object must conform to
-(define-syntax quick-case
- (lambda (stx)
- (syntax-case stx ()
- ((_ var-key obj (key val proc) ...)
- #`(case var-key
- #,@(map (handle-case stx #'obj)
- #'(key ...)
- #'(val ...)
- #'(proc ...))
- (else obj))))))
-
-(define-syntax all-in
- (syntax-rules ()
- ((_ var rules ...)
- (cut every (lambda (var) (and rules ...)) <>))))
-
-(define (string->number-list val delim)
- (map string->number (string-split val delim)))
-
-(define (string->symbols val delim)
- (map string->symbol (string-split val delim)))
-
-;; @example
-;; <weekday> ∈ weekdays
-;; <weekdaynum> ::= [[±] <num>] <weekday> ;; +3MO
-;; (<weekadynum>, ...)
-;; @end example
-
-;; Returns a pair, where the @code{car} is the offset
-;; and @code{cdr} is the day symbol.
-;; The @code{car} may be @code{#f}.
-(define (parse-day-spec str)
- (let* ((numchars (append '(#\+ #\-) (map integer->char (iota 10 #x30))))
- (num symb (span (cut memv <> numchars)
- (string->list str))))
- (cons (string->number (list->string num))
- (apply symbol symb))))
-
-(define (%build-recur-rules str)
- (fold
- (lambda (kv obj)
- (let* (((key val) kv)
- ;; Lazy fields for the poor man.
- (symb (lambda () (string->symbol val)))
- (date (lambda () (date->time-utc (parse-datetime val))))
- (days (lambda () (map parse-day-spec (string-split val #\,))))
- (num (lambda () (string->number val)))
- (nums (lambda () (string->number-list val #\,))))
- (quick-case (string->symbol key) obj
- (FREQ (symb) (cut memv <> intervals)) ; Required
- (UNTIL (date) identity)
- (COUNT (num) (cut <= 0 <>))
- (INTERVAL (num) (cut <= 0 <>))
- (BYSECOND (nums) (all-in n (<= 0 n 60)))
- (BYMINUTE (nums) (all-in n (<= 0 n 59)))
- (BYHOUR (nums) (all-in n (<= 0 n 23)))
-
- (BYDAY (days)
- (lambda (p*)
- (map (lambda (p)
- (let* (((num . symb) p))
- (memv symb weekdays)))
- p*)))
-
- (BYMONTHDAY (nums) (all-in n (<= -31 n 31) (!= n 0)))
- (BYYEARDAY (nums) (all-in n (<= -366 n 366) (!= n 0)))
- (BYWEEKNO (nums) (all-in n (<= -53 n 53) (!= n 0)))
- (BYMONTH (nums) (all-in n (<= 1 n 12)))
- (BYSETPOS (nums) (all-in n (<= -366 n 366) (!= n 0)))
-
- (WKST (symb) (cut memv <> weekdays))
- )))
-
- ;; obj
- (make-recur-rule 1 'MO)
-
- ;; ((key val) ...)
- (map (cut string-split <> #\=)
- (string-split str #\;))))
diff --git a/module/vcalendar/timezone.scm b/module/vcalendar/timezone.scm
deleted file mode 100644
index 560289d4..00000000
--- a/module/vcalendar/timezone.scm
+++ /dev/null
@@ -1,88 +0,0 @@
-(define-module (vcalendar timezone)
- :use-module (vcalendar)
- :use-module ((srfi srfi-1) :select (find))
- :use-module (srfi srfi-19)
- :use-module (srfi srfi-19 util)
- :use-module (srfi srfi-41)
- :use-module (srfi srfi-41 util)
- :use-module (util)
- :use-module ((vcalendar recurrence generate) :select (generate-recurrence-set))
- :use-module ((vcalendar datetime) :select (ev-time<?))
- )
-
-;;@begin exampe
-;; <VTIMEZONE> :: "#<vcomponent 558c5da80fc0>"
-;; TZID: Europe/Stockholm
-;; X-LIC-LOCATION: Europe/Stockholm
-;; : <DAYLIGHT> :: "#<vcomponent 558c5e11e7c0>"
-;; : RRULE: FREQ=YEARLY;BYMONTH=3;BYDAY=-1SU
-;; : DTSTART: 19700329T020000
-;; : TZNAME: CEST
-;; : TZOFFSETTO: +0200
-;; : TZOFFSETFROM: +0100
-;; : <STANDARD> :: "#<vcomponent 558c5e11e7e0>"
-;; : RRULE: FREQ=YEARLY;BYMONTH=10;BYDAY=-1SU
-;; : DTSTART: 19701025T030000
-;; : TZNAME: CET
-;; : TZOFFSETTO: +0100
-;; : TZOFFSETFROM: +0200
-;; @end example
-
-;; Given a tz stream of length 2, takes the time difference between the DTSTART
-;; of those two. And creates a new VTIMEZONE with that end time.
-;; TODO set remaining properties, and type of the newly created component.
-(define (extrapolate-tz-stream strm)
- (let ((nevent (copy-vcomponent (stream-ref strm 1))))
- (mod! (attr nevent 'DTSTART)
- = (add-duration (time-difference
- (attr (stream-ref strm 1) 'DTSTART)
- (attr (stream-ref strm 0) 'DTSTART))))
- (stream-append strm (stream nevent))))
-
-;; The RFC requires that at least one DAYLIGHT or STANDARD component is present.
-;; Any number of both can be present. This should handle all these cases well,
-;; as long as noone has multiple overlapping timezones, which depend on some
-;; further condition. That feels like something that should be impossible, but
-;; this is (human) time we are talking about.
-(define-public (make-tz-set tz)
- (let ((strm (interleave-streams
- ev-time<?
- ;; { DAYLIGHT, STANDARD }
- (map generate-recurrence-set (children tz)))))
-
- (cond [(stream-null? strm) stream-null]
-
- [(stream-null? (stream-drop 2 strm))
- (let ((strm (extrapolate-tz-stream strm)))
- (stream-zip strm (stream-cdr strm)))]
-
- [else (stream-zip strm (stream-cdr strm))])))
-
-(define (parse-offset str)
- (let* (((pm h1 h0 m1 m0) (string->list str)))
- ((primitive-eval (symbol pm))
- (+ (* 60 (string->number (list->string (list m1 m0))))
- (* 60 60 (string->number (list->string (list h1 h0))))))))
-
-;; Finds the VTIMEZONE with id @var{tzid} in calendar.
-;; Crashes on error.
-(define (find-tz cal tzid)
- (let ((ret (find (lambda (tz) (string=? tzid (attr tz 'TZID)))
- (children cal 'VTIMEZONE))))
- ret))
-
-;; Takes a VEVENT.
-;; Assumes that DTSTART has a TZID property, and that that TZID is available as
-;; a direct child of the parent of @var{ev}.
-(define-public (get-tz-offset ev)
- (let ((ret (stream-find
- (lambda (z)
- (let* (((start end) (map (extract 'DTSTART) z)))
- (and (time<=? start (attr ev 'DTSTART))
- (time<? (attr ev 'DTSTART) end))))
- (attr (find-tz (parent ev)
- (car (prop (attr* ev 'DTSTART) 'TZID)))
- 'X-HNH-TZSET))))
- (if (not ret)
- 0 (parse-offset (attr (car ret) 'TZOFFSETTO)))))
-