aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rwxr-xr-xmodule/main.scm2
-rw-r--r--module/vcomponent.scm68
-rw-r--r--module/vcomponent/parse.scm81
-rw-r--r--module/vcomponent/recurrence/generate.scm42
4 files changed, 95 insertions, 98 deletions
diff --git a/module/main.scm b/module/main.scm
index 93baf35d..4bf20ede 100755
--- a/module/main.scm
+++ b/module/main.scm
@@ -38,7 +38,7 @@ exec guile -e main -s $0 "$@"
;;
;; Given as a sepparate function from main to ease debugging.
(define* (init proc #:key (calendar-files (calendar-files)))
- (define calendars (map parse-calendar calendar-files))
+ (define calendars (map parse-cal-path calendar-files))
(define events (concatenate
;; TODO does this drop events?
(map (lambda (cal) (filter (lambda (o) (eq? 'VEVENT (type o)))
diff --git a/module/vcomponent.scm b/module/vcomponent.scm
index bda9d58c..0283161e 100644
--- a/module/vcomponent.scm
+++ b/module/vcomponent.scm
@@ -1,68 +1,8 @@
(define-module (vcomponent)
- #:use-module (vcomponent datetime)
- #:use-module (vcomponent recurrence)
- #:use-module (vcomponent base)
- #:use-module (vcomponent parse)
- #:use-module (srfi srfi-1)
- #:use-module (srfi srfi-19)
- #:use-module (srfi srfi-19 util)
- #:use-module (srfi srfi-19 setters)
- #:use-module (srfi srfi-26)
- #:use-module (util)
- #:export (parse-calendar)
- #:re-export (repeating? make-vcomponent))
-
-;; All VTIMEZONE's seem to be in "local" time in relation to
-;; themselves. Therefore, a simple comparison should work,
-;; and then the TZOFFSETTO attribute can be subtracted from
-;; the event DTSTART to get UTC time.
+ :use-module (vcomponent base)
+ :use-module (vcomponent parse)
+ :use-module (util)
+ :re-export (make-vcomponent parse-cal-path parse-calendar))
(re-export-modules (vcomponent base))
-(define (parse-dates! cal)
- "Parse all start times into scheme date objects."
-
- (for ev in (filter (lambda (o) (eq? 'VEVENT (type o))) (children cal))
- (let-env ((TZ (and=> (prop (attr* ev 'DTSTART) 'TZID) car)))
- (let*
- ((dptr (attr* ev 'DTSTART))
- (eptr (attr* ev 'DTEND))
-
- (date (parse-datetime (value dptr)))
- (end-date
- (cond ;; [(attr ev 'DURATION) => (lambda (d) (add-duration ...))]
- [(not eptr)
- (let ((d (set (date-hour date) = (+ 1))))
- (set! (attr ev 'DTEND) d
- eptr (attr* ev 'DTEND))
- d)]
- [(value eptr) => parse-datetime]
- [else
- (set (date-hour date) = (+ 1))])))
-
- (set! (value dptr) (date->time-utc date)
- (value eptr) (date->time-utc end-date))
-
- (when (prop (attr* ev 'DTSTART) 'TZID)
- ;; Re-align date to have correect timezone. This is since time->date gives
- ;; correct, but the code above may (?) fail to update the timezone.
- (set! (zone-offset date) (zone-offset (time-utc->date (value dptr)))
- (value dptr) (date->time-utc date)
-
- ;; The standard says that DTEND must have the same
- ;; timezone as DTSTART. Here we trust that blindly.
- (zone-offset end-date) (zone-offset date)
- (value eptr) (date->time-utc end-date)))))))
-
-
-(define* (parse-calendar path)
- (let ((component (parse-cal-path path)))
- (parse-dates! component)
-
- (unless (attr component "NAME")
- (set! (attr component "NAME")
- (or (attr component "X-WR-CALNAME")
- "[NAMELESS]")))
-
- ;; return
- component))
diff --git a/module/vcomponent/parse.scm b/module/vcomponent/parse.scm
index 29537a5e..71852adf 100644
--- a/module/vcomponent/parse.scm
+++ b/module/vcomponent/parse.scm
@@ -3,6 +3,9 @@
:use-module (rnrs bytevectors)
:use-module (srfi srfi-1)
:use-module (srfi srfi-9)
+ :use-module (srfi srfi-19)
+ :use-module (srfi srfi-19 setters)
+ :use-module (srfi srfi-19 util)
:use-module ((ice-9 rdelim) :select (read-line))
:use-module ((ice-9 textual-ports) :select (unget-char))
:use-module ((ice-9 ftw) :select (scandir ftw))
@@ -10,6 +13,7 @@
:use-module (util)
:use-module (util strbuf)
:use-module (vcomponent base)
+ :use-module (vcomponent datetime)
)
(use-modules ((rnrs base) #:select (assert)))
@@ -74,7 +78,7 @@
'end-of-line])))
-(define (parse-calendar port)
+(define-public (parse-calendar port)
(with-input-from-port port
(lambda ()
(let ((component (make-vcomponent))
@@ -203,6 +207,47 @@ row ~a column ~a ctx = ~a
+;; All VTIMEZONE's seem to be in "local" time in relation to
+;; themselves. Therefore, a simple comparison should work,
+;; and then the TZOFFSETTO attribute can be subtracted from
+;; the event DTSTART to get UTC time.
+
+(define (parse-dates! cal)
+ "Parse all start times into scheme date objects."
+
+ (for ev in (filter (lambda (o) (eq? 'VEVENT (type o))) (children cal))
+ (let-env ((TZ (and=> (prop (attr* ev 'DTSTART) 'TZID) car)))
+ (let*
+ ((dptr (attr* ev 'DTSTART))
+ (eptr (attr* ev 'DTEND))
+
+ (date (parse-datetime (value dptr)))
+ (end-date
+ (cond ;; [(attr ev 'DURATION) => (lambda (d) (add-duration ...))]
+ [(not eptr)
+ (let ((d (set (date-hour date) = (+ 1))))
+ (set! (attr ev 'DTEND) d
+ eptr (attr* ev 'DTEND))
+ d)]
+ [(value eptr) => parse-datetime]
+ [else
+ (set (date-hour date) = (+ 1))])))
+
+ (set! (value dptr) (date->time-utc date)
+ (value eptr) (date->time-utc end-date))
+
+ (when (prop (attr* ev 'DTSTART) 'TZID)
+ ;; Re-align date to have correect timezone. This is since time->date gives
+ ;; correct, but the code above may (?) fail to update the timezone.
+ (set! (zone-offset date) (zone-offset (time-utc->date (value dptr)))
+ (value dptr) (date->time-utc date)
+
+ ;; The standard says that DTEND must have the same
+ ;; timezone as DTSTART. Here we trust that blindly.
+ (zone-offset end-date) (zone-offset date)
+ (value eptr) (date->time-utc end-date)))))))
+
+
(define (parse-vdir path)
(let ((/ (lambda args (string-join args file-name-separator-string 'infix))))
(let ((color
@@ -234,17 +279,29 @@ row ~a column ~a ctx = ~a
(define-public (parse-cal-path path)
(define st (stat path))
- (case (stat:type st)
- [(regular)
- (let ((comp (call-with-input-file path parse-calendar)))
- (set! (attr comp 'X-HNH-SOURCETYPE) "file")
- comp) ]
- [(directory)
- (let ((comp (parse-vdir path)))
- (set! (attr comp 'X-HNH-SOURCETYPE) "vdir")
- comp)]
- [(block-special char-special fifo socket unknown symlink)
- => (lambda (t) (error "Can't parse file of type " t))]))
+ (define cal
+ (case (stat:type st)
+ [(regular)
+ (let ((comp (call-with-input-file path parse-calendar)))
+ (set! (attr comp 'X-HNH-SOURCETYPE) "file")
+ comp) ]
+ [(directory)
+ (let ((comp (parse-vdir path)))
+ (set! (attr comp 'X-HNH-SOURCETYPE) "vdir")
+ comp)]
+ [(block-special char-special fifo socket unknown symlink)
+ => (lambda (t) (error "Can't parse file of type " t))]))
+
+ (parse-dates! cal)
+
+ (unless (attr cal "NAME")
+ (set! (attr cal "NAME")
+ (or (attr cal "X-WR-CALNAME")
+ "[NAMELESS]")))
+
+ cal
+
+ )
diff --git a/module/vcomponent/recurrence/generate.scm b/module/vcomponent/recurrence/generate.scm
index 6e022bcc..58961f5e 100644
--- a/module/vcomponent/recurrence/generate.scm
+++ b/module/vcomponent/recurrence/generate.scm
@@ -45,27 +45,27 @@
(define (next-event ev r)
(let ((e (copy-vcomponent ev)))
- (let-env ((TZ (and=> (prop (attr* e 'DTSTART) 'TZID) car))))
-
- (let ((d (time-utc->date (attr e 'DTSTART)))
- (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! (zone-offset d)
- (zone-offset (time-utc->date (date->time-utc d))))
-
- (set! (attr e 'DTSTART) (date->time-utc d)))
-
- (when (attr e 'DTEND)
- (set! (attr e 'DTEND)
- (add-duration (attr e 'DTSTART) (attr e 'DURATION))))
+ (let-env ((TZ (and=> (prop (attr* e 'DTSTART) 'TZID) car)))
+
+ (let ((d (time-utc->date (attr e 'DTSTART)))
+ (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! (zone-offset d)
+ (zone-offset (time-utc->date (date->time-utc d))))
+
+ (set! (attr e 'DTSTART) (date->time-utc d)))
+
+ (when (attr e 'DTEND)
+ (set! (attr e 'DTEND)
+ (add-duration (attr e 'DTSTART) (attr e 'DURATION)))))
e))
generated by cgit v1.2.3 (git 2.25.1) at 2024-06-28 23:43:05 +0200