blob: 6d34623058a7ffd0cbf8b84fc0dda9975fd40c53 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
|
(define-module (vcomponent output)
#:use-module (vcomponent)
#:use-module (vcomponent control)
#:use-module (util)
#:use-module (srfi srfi-1)
#: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 kv in kvs
(let* (((key . at) kv))
(format port "~a ~15@a~{;~a=~{~a~^,~}~}: ~a~%"
(make-string depth #\:)
key
(concatenate (hash-map->list list (cdr at)))
(v at))))
(for-each (lambda (e) (print-vcomponent e port #:depth (1+ depth)))
(children comp))))
;;; 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 kv in kvs
(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))))
|
