From 4d347e797dfd87b22fa3ff7a644e6a9bcbd93e7a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Mon, 11 Nov 2019 11:07:50 +0100 Subject: Work on ICS output. --- module/output/ical.scm | 32 ++++++++++++++++++-------------- 1 file changed, 18 insertions(+), 14 deletions(-) (limited to 'module/output/ical.scm') diff --git a/module/output/ical.scm b/module/output/ical.scm index 5eff7915..11633e52 100644 --- a/module/output/ical.scm +++ b/module/output/ical.scm @@ -1,6 +1,7 @@ (define-module (output ical) :use-module (ice-9 getopt-long) :use-module (ice-9 format) + :use-module (util) :use-module (vcomponent) :use-module (srfi srfi-19) :use-module (srfi srfi-19 util) @@ -14,7 +15,7 @@ (define (value-format key value) ;; TODO remove once key's are normalized to symbols. - (case (string->symbol key) + (case key ((DTSTART DTEND) (time->string value "~Y~m~dT~H~M~SZ")) ((DURATION) @@ -32,20 +33,19 @@ (lambda () (string-for-each (lambda (ch) (case ch - ((#\, #\\) => (lambda (c) (display "\\") (display c))) + ((#\, #\; #\\) => (lambda (c) (display "\\") (display c))) + ((#\newline) (display "\\n")) (else (display ch))) ) str)))) (define (component->ical-string component) (format #t "BEGIN:~a~%" (type component)) - (for-each (lambda (kv) - (let ((key (car kv)) - (vline (cdr kv))) - ;; key;p1=v;p3=10:value - (format #t "~a~:{;~a=~@{~a~^,~}~}:~a~%" - key (properties vline) - (escape-chars (value-format key (value vline))) - ))) + (hash-for-each (lambda (key vline) + ;; key;p1=v;p3=10:value + (format #t "~a~:{;~a=~@{~a~^,~}~}:~a~%" + key (properties vline) + ;; TODO wrap lines + (escape-chars (value-format key (value vline))))) (attributes component)) (for-each component->ical-string (children component)) (format #t "END:~a~%" (type component)) @@ -55,11 +55,10 @@ (define (print-header) (format #t "BEGIN:VCALENDAR -PRODID:~a +PRODID:-//hugo//Calparse 0.5//EN VERSION:2.0 CALSCALE:GREGORIAN " -"Hugo" )) @@ -67,9 +66,14 @@ CALSCALE:GREGORIAN (format #t "END:VCALENDAR~%")) (define-public (ical-main calendars events args) + + (define opts (getopt-long args opt-spec)) - (define start (parse-freeform-date (option-ref opts 'from "2019-04-15"))) - (define end (parse-freeform-date (option-ref opts 'to "2019-05-10"))) + + (define start (cond [(option-ref opts 'from #f) => parse-freeform-date] + [else (start-of-month (current-date))])) + (define end (cond [(option-ref opts 'to #f) => parse-freeform-date] + [else (normalize-date* (set (date-month start) = (+ 1)))])) (print-header) -- cgit v1.2.3