From 3f49d48ae608d5fb618453a8e2fa875b9d5420e2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Sun, 3 Nov 2019 13:36:22 +0100 Subject: Readd color parsing, fix minor bugs. --- module/vcomponent/parse.scm | 27 +++++++++++++++++++++------ 1 file changed, 21 insertions(+), 6 deletions(-) (limited to 'module/vcomponent/parse.scm') 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))])) -- cgit v1.2.3