aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorHugo Hörnquist <hugo@lysator.liu.se>2020-04-30 18:37:03 +0200
committerHugo Hörnquist <hugo@lysator.liu.se>2020-04-30 18:37:03 +0200
commit8b426edf1b6d4de0ec825da8a34b1df7b51212db (patch)
tree7149e0f71ab49998d65ec95adfb1715490360bf0
parentAdd tzget script. (diff)
downloadcalp-8b426edf1b6d4de0ec825da8a34b1df7b51212db.tar.gz
calp-8b426edf1b6d4de0ec825da8a34b1df7b51212db.tar.xz
Update ical parts to use app context.
-rw-r--r--module/datetime/app.scm18
-rw-r--r--module/datetime/zic.scm2
-rw-r--r--module/entry-points/ical.scm9
-rwxr-xr-xmodule/main.scm8
-rw-r--r--module/output/ical.scm19
5 files changed, 34 insertions, 22 deletions
diff --git a/module/datetime/app.scm b/module/datetime/app.scm
new file mode 100644
index 00000000..989a0847
--- /dev/null
+++ b/module/datetime/app.scm
@@ -0,0 +1,18 @@
+(define-module (datetime app)
+ :use-module (util)
+ :use-module (util app)
+ :use-module (ice-9 rdelim)
+ :use-module (datetime zic))
+
+(define-method (init-app)
+ (setf app 'zoneinfo
+ (let* ((pipe
+ (-> (@ (global) basedir)
+ dirname
+ (string-append "/tzget")
+ ((@ (ice-9 popen) open-input-pipe))))
+ (path (read-line pipe))
+ (names (string-split (read-line pipe) #\space)))
+ (read-zoneinfo
+ (map (lambda (s) (string-append path file-name-separator-string s))
+ names)))))
diff --git a/module/datetime/zic.scm b/module/datetime/zic.scm
index 1c81b706..02f3230f 100644
--- a/module/datetime/zic.scm
+++ b/module/datetime/zic.scm
@@ -19,7 +19,7 @@
:use-module (srfi srfi-9 gnu))
-(define-public (read-zoneinfo . ports-or-filenames)
+(define-public (read-zoneinfo ports-or-filenames)
(parsed-zic->zoneinfo
(concatenate
(map (lambda (port-or-filename)
diff --git a/module/entry-points/ical.scm b/module/entry-points/ical.scm
index f2f4e0b5..dc060ec6 100644
--- a/module/entry-points/ical.scm
+++ b/module/entry-points/ical.scm
@@ -22,11 +22,4 @@
;; [else (normalize-date* (set (month start) = (+ 1)))]
[(date+ start (date month: 1))]
))
-
- ;; TODO this contains repeated events multiple times
- (define-values (calendars regular repeating)
- (cond [(option-ref opts 'file #f) => (compose load-calendars* list)]
- [else (load-calendars*)]))
-
- (ical-main calendars regular repeating start end)
- )
+ (ical-main start end))
diff --git a/module/main.scm b/module/main.scm
index b2899014..96fe2da1 100755
--- a/module/main.scm
+++ b/module/main.scm
@@ -13,6 +13,7 @@
(util)
(util io)
(util time)
+ (util app)
((entry-points html) :prefix html-)
((entry-points terminal) :prefix terminal-)
@@ -31,6 +32,7 @@
)
+
(define options
'((statprof (value optional))
(repl (value optional))
@@ -56,6 +58,12 @@
(when (file-exists? config-file)
(primitive-load config-file)))
+
+ (current-app (make-app))
+
+ ((@ (vcomponent) init-app) (get-config 'calendar-files))
+ ((@ (datetime app) init-app))
+
(let ((ropt (ornull (option-ref opts '() '())
'("term"))))
((case (string->symbol (car ropt))
diff --git a/module/output/ical.scm b/module/output/ical.scm
index 822d929d..8388bfc1 100644
--- a/module/output/ical.scm
+++ b/module/output/ical.scm
@@ -2,6 +2,7 @@
:use-module (ice-9 format)
:use-module (ice-9 match)
:use-module (util)
+ :use-module (util app)
:use-module (vcomponent)
:use-module (vcomponent datetime)
:use-module (srfi srfi-1)
@@ -139,10 +140,6 @@
;; TODO place these somewhere better
(define *prodid* "-//hugo//Calparse 0.9//EN")
-(define *zoneinfo* (apply read-zoneinfo
- ;; TODO move this to config, and figure out
- ;; how to best acquire/bundle zoneinfo.
- (glob "~/down/tz/{africa,antartica,asia,australasia,europe,northamerica,southamerica,backward}")))
;; TODO tzid prop on dtstart vs tz field in datetime object
;; how do we keep these two in sync?
@@ -156,7 +153,7 @@
(add-child! cal event)
(awhen (prop (attr* event 'DTSTART) 'TZID)
- (add-child! cal (zoneinfo->vtimezone *zoneinfo* it)))
+ (add-child! cal (zoneinfo->vtimezone (getf (current-app) 'zoneinfo) it)))
(unless (attr event 'UID)
(set! (attr event 'UID)
@@ -205,7 +202,7 @@ CALSCALE:GREGORIAN\r
(let ((tz-names (get-tz-names events)))
(for-each component->ical-string
;; TODO we realy should send the earliest event from each timezone here.
- (map (lambda (name) (zoneinfo->vtimezone *zoneinfo* name (car events)))
+ (map (lambda (name) (zoneinfo->vtimezone (getf (current-app) 'zoneinfo) name (car events)))
tz-names)))
(for-each component->ical-string events)
@@ -214,15 +211,11 @@ CALSCALE:GREGORIAN\r
;; TODO add support for running without a range limiter, emiting all objects.
-;; list x list x list x time x time →
-(define-public (ical-main calendars regular-events repeating-events start end)
-
+(define-public (ical-main start end)
(print-components-with-fake-parent
- (append (filter-sorted (lambda (ev) ((in-date-range? start end)
- (as-date (attr ev 'DTSTART))))
- regular-events)
+ (append (fixed-events-in-range start end)
;; TODO RECCURENCE-ID exceptions
;; We just dump all repeating objects, since it's much cheaper to do
;; it this way than to actually figure out which are applicable for
;; the given date range.
- repeating-events)))
+ (getf (current-app) 'repeating-events))))