diff options
author | Hugo Hörnquist <hugo@hornquist.se> | 2019-11-03 13:36:22 +0100 |
---|---|---|
committer | Hugo Hörnquist <hugo@hornquist.se> | 2019-11-03 13:36:22 +0100 |
commit | 3f49d48ae608d5fb618453a8e2fa875b9d5420e2 (patch) | |
tree | 4345a25a5d14ff50711cbd9a58e8eacedc240ca4 /module/vcomponent/parse.scm | |
parent | Remove ALL c code. (diff) | |
download | calp-3f49d48ae608d5fb618453a8e2fa875b9d5420e2.tar.gz calp-3f49d48ae608d5fb618453a8e2fa875b9d5420e2.tar.xz |
Readd color parsing, fix minor bugs.
Diffstat (limited to '')
-rw-r--r-- | module/vcomponent/parse.scm | 27 |
1 files changed, 21 insertions, 6 deletions
diff --git a/module/vcomponent/parse.scm b/module/vcomponent/parse.scm index 9eabacb3..46a256a1 100644 --- a/module/vcomponent/parse.scm +++ b/module/vcomponent/parse.scm @@ -3,6 +3,7 @@ :use-module (rnrs io ports) :use-module (rnrs bytevectors) :use-module (srfi srfi-9) + :use-module ((ice-9 rdelim) :select (read-line)) :use-module ((ice-9 textual-ports) :select (unget-char)) :use-module ((ice-9 ftw) :select (scandir ftw))) @@ -289,12 +290,26 @@ row ~a column ~a ctx = ~a (set-attribute! comp 'X-HNH-SOURCETYPE "file") (list comp))] [(directory) - (map (lambda (fname) - (call-with-input-file - (string-append path file-name-separator-string fname) - parse-calendar)) - (scandir path (lambda (s) (and (not (string= "." (string-take s 1))) - (string= "ics" (string-take-right s 3))))))] + + (let ((/ (lambda args (string-join args file-name-separator-string 'infix)))) + (let ((color + (catch 'system-error + (lambda () (call-with-input-file (/ path "color") read-line)) + (const "#FFFFFF"))) + (name + (catch 'system-error + (lambda () (call-with-input-file (/ path "displayname") read-line)) + (const (basename path))))) + + (map (lambda (fname) + (let ((fullname (/ path fname))) + (let ((cal (call-with-input-file fullname + parse-calendar))) + (set-attribute! cal 'COLOR color) + (set-attribute! cal 'NAME name) + cal))) + (scandir path (lambda (s) (and (not (string= "." (string-take s 1))) + (string= "ics" (string-take-right s 3))))))))] [(block-special char-special fifo socket unknown symlink) => (lambda (t) (error "Can't parse file of type " t))])) |