aboutsummaryrefslogtreecommitdiff
path: root/module/vcalendar/output.scm
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/output.scm
parentChange event-length => event-length/day. (diff)
downloadcalp-8f4fbcd493e28c86c598efcecdb6dc79d8fe0bfe.tar.gz
calp-8f4fbcd493e28c86c598efcecdb6dc79d8fe0bfe.tar.xz
Rename module vcalendar => vcomponent.
Diffstat (limited to 'module/vcalendar/output.scm')
-rw-r--r--module/vcalendar/output.scm96
1 files changed, 0 insertions, 96 deletions
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))))