Work on ICS output.

1 files changed, 18 insertions, 14 deletions

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)