From 3f49d48ae608d5fb618453a8e2fa875b9d5420e2 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@hornquist.se>
Date: Sun, 3 Nov 2019 13:36:22 +0100
Subject: Readd color parsing, fix minor bugs.

---
 module/vcomponent/base.scm  | 13 +++++++------
 module/vcomponent/parse.scm | 27 +++++++++++++++++++++------
 2 files changed, 28 insertions(+), 12 deletions(-)

diff --git a/module/vcomponent/base.scm b/module/vcomponent/base.scm
index f43f532e..86ea40e8 100644
--- a/module/vcomponent/base.scm
+++ b/module/vcomponent/base.scm
@@ -16,11 +16,12 @@
   (let ((parent (primitive-make-vcomponent)))
     (for-each (lambda (child) (add-child! parent child))
               (read-vcalendar path))
-    (if (null? (get-component-children parent))
-        (set-attribute! parent 'X-HNH-SOURCETYPE "vdir")
-        (set-attribute! parent 'X-HNH-SOURCETYPE
-                        (get-attribute-value (car (get-component-children parent))
-                                             'X-HNH-SOURCETYPE "vdir")))
+    (set-attribute!
+     parent 'X-HNH-SOURCETYPE
+     (if (null? (get-component-children parent))
+         "vdir"
+         (get-attribute-value (car (get-component-children parent))
+                              'X-HNH-SOURCETYPE "vdir")))
     parent))
 
 ;; vline → value
@@ -72,7 +73,7 @@
 (define-public parent get-component-parent)
 
 (define-public (attributes component)
-  (hash-map->list cons (get-component-attributes component)))
+  (map car (hash-map->list cons (get-component-attributes component))))
 
 (define*-public children get-component-children)
 
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