From 7539f8c8804849294e100c5442e0397f4f4d2c40 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@hornquist.se>
Date: Tue, 1 Oct 2019 23:39:00 +0200
Subject: Disabled bunch of old stuff, new stuff kinda builds.

---
 module/vcomponent/base.scm      | 24 ++++++++++++++++--------
 module/vcomponent/primitive.scm | 30 +++++++++++++++++-------------
 2 files changed, 33 insertions(+), 21 deletions(-)

(limited to 'module/vcomponent')

diff --git a/module/vcomponent/base.scm b/module/vcomponent/base.scm
index fd8628f9..4b49ba66 100644
--- a/module/vcomponent/base.scm
+++ b/module/vcomponent/base.scm
@@ -6,11 +6,16 @@
   :use-module ((ice-9 optargs) :select (define*-public)))
 
 (define (get-attr component attr)
+  (hash-ref (struct-ref component 3)
+            (as-string attr))
+  #;
   (%vcomponent-get-attribute
    component
    (as-string attr)))
 
 (define (set-attr! component attr value)
+  'noop
+  #;
   (set! (car (get-attr component (as-string attr)))
         value))
 
@@ -49,21 +54,24 @@
   (hash-map->list cons (cdar attrptr)))
 
 (define-public type (make-procedure-with-setter
-                     %vcomponent-get-type
-                     %vcomponent-set-type!))
-(define-public parent %vcomponent-parent)
-(define-public push-child! %vcomponent-push-child!)
-(define-public (attributes component) (map string->symbol (%vcomponent-attribute-list component)))
+                     (lambda (c) (struct-ref c 0))
+                     (lambda (c v) struct-set! c 0 v)
+                    ))
+(define-public (parent c) (struct-ref c 2))
+(define-public push-child! add-child!)
+(define-public (attributes component) '("noop")
+  #; (map string->symbol (%vcomponent-attribute-list component))
+  )
 
 (define*-public (children component #:optional only-type)
-  (let ((childs (%vcomponent-children component)))
+  (let ((childs (slot-ref component 1)))
     (if only-type
         (filter (lambda (e) (eq? only-type (type e))) childs)
         childs)))
 
-(define-public copy-vcomponent %vcomponent-shallow-copy)
+;; (define-public copy-vcomponent %vcomponent-shallow-copy)
 
-(define-public filter-children! %vcomponent-filter-children!)
+;; (define-public filter-children! %vcomponent-filter-children!)
 
 (define-public (extract field)
   (lambda (e) (attr e field)))
diff --git a/module/vcomponent/primitive.scm b/module/vcomponent/primitive.scm
index ad33a3be..e103feae 100644
--- a/module/vcomponent/primitive.scm
+++ b/module/vcomponent/primitive.scm
@@ -1,19 +1,23 @@
 ;;; Primitive export of symbols linked from C binary.
 
 (define-module (vcomponent primitive)
-  #:export (%vcomponent-children
-            %vcomponent-push-child!
-            %vcomponent-filter-children!
+  #:export #; 
+  (%vcomponent-children                 ;
+  %vcomponent-push-child!               ;
+  %vcomponent-filter-children!          ;
+                                        ;
+  %vcomponent-parent                    ;
+                                        ;
+  %vcomponent-make                      ;
+  %vcomponent-get-type                  ;
+  %vcomponent-set-type!                 ;
+                                        ;
+  %vcomponent-get-attribute             ;
+  %vcomponent-attribute-list            ;
+                                        ;
+  %vcomponent-shallow-copy)
 
-            %vcomponent-parent
-
-            %vcomponent-make
-            %vcomponent-get-type
-            %vcomponent-set-type!
-
-            %vcomponent-get-attribute
-            %vcomponent-attribute-list
-
-            %vcomponent-shallow-copy))
+  (make-vcomponent add-line! add-child! make-vline add-attribute! parse-path)
+  )
 
 (load-extension "libguile-calendar" "init_lib")
-- 
cgit v1.2.3


From 1c3bd94c328df0c8b4293bc42a25b2d7c851fd0c Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@hornquist.se>
Date: Wed, 2 Oct 2019 23:05:01 +0200
Subject: Made parser work again (for single files).

---
 module/vcomponent/primitive.scm | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

(limited to 'module/vcomponent')

diff --git a/module/vcomponent/primitive.scm b/module/vcomponent/primitive.scm
index e103feae..2cf12508 100644
--- a/module/vcomponent/primitive.scm
+++ b/module/vcomponent/primitive.scm
@@ -17,7 +17,7 @@
                                         ;
   %vcomponent-shallow-copy)
 
-  (make-vcomponent add-line! add-child! make-vline add-attribute! parse-path)
+  (make-vcomponent add-line! add-child! make-vline add-attribute! parse-cal-path)
   )
 
 (load-extension "libguile-calendar" "init_lib")
-- 
cgit v1.2.3


From e13f6bb201dff690208b9cc951b5c098b0d63356 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@hornquist.se>
Date: Thu, 3 Oct 2019 00:46:01 +0200
Subject: Slowly going through and fixing everything.

---
 module/vcomponent/base.scm | 32 ++++++++++++++++++--------------
 1 file changed, 18 insertions(+), 14 deletions(-)

(limited to 'module/vcomponent')

diff --git a/module/vcomponent/base.scm b/module/vcomponent/base.scm
index 4b49ba66..395c2d9c 100644
--- a/module/vcomponent/base.scm
+++ b/module/vcomponent/base.scm
@@ -6,8 +6,9 @@
   :use-module ((ice-9 optargs) :select (define*-public)))
 
 (define (get-attr component attr)
-  (hash-ref (struct-ref component 3)
-            (as-string attr))
+  (and=> (hash-ref (struct-ref component 3)
+                   (as-string attr))
+         (lambda (l) (struct-ref l 0)))
   #;
   (%vcomponent-get-attribute
    component
@@ -19,26 +20,29 @@
   (set! (car (get-attr component (as-string attr)))
         value))
 
-(define-public value caar)
+;; (define-public value caar)
 
-(define-public (values-left-count attr-list)
-  (length (take-while identity attr-list)))
+;; (define-public (values-left-count attr-list)
+;;   (length (take-while identity attr-list)))
 
-(define-public (value-count attr-list)
-  (length (take-while identity (cdr (drop-while identity attr-list)))))
+;; (define-public (value-count attr-list)
+;;   (length (take-while identity (cdr (drop-while identity attr-list)))))
 
 (define-public attr* get-attr)
 
-(define (get-first c a)
-  (and=> (car (get-attr c a)) car))
+;; (define (get-first c a)
+;;   (and=> (car (get-attr c a)) car))
 
-(define (set-first! c a v)
-  (and=> (car (get-attr c a))
-         (lambda (f) (set! (car f) v))))
+;; (define (set-first! c a v)
+;;   (and=> (car (get-attr c a))
+;;          (lambda (f) (set! (car f) v))))
 
 (define-public attr
   (make-procedure-with-setter
-   get-first set-first!))
+;    get-first set-first!
+   get-attr
+   set-attr!
+   ))
 
 
 (define-public prop
@@ -64,7 +68,7 @@
   )
 
 (define*-public (children component #:optional only-type)
-  (let ((childs (slot-ref component 1)))
+  (let ((childs (struct-ref component 1)))
     (if only-type
         (filter (lambda (e) (eq? only-type (type e))) childs)
         childs)))
-- 
cgit v1.2.3


From 785f70a3d16e549e36b8ef17f081829fe492a193 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@hornquist.se>
Date: Thu, 3 Oct 2019 22:02:03 +0200
Subject: Locate bug with DTEND.

---
 module/vcomponent/base.scm | 77 +++++++++++++++++++++++++++++++---------------
 1 file changed, 53 insertions(+), 24 deletions(-)

(limited to 'module/vcomponent')

diff --git a/module/vcomponent/base.scm b/module/vcomponent/base.scm
index 395c2d9c..986037f5 100644
--- a/module/vcomponent/base.scm
+++ b/module/vcomponent/base.scm
@@ -5,22 +5,49 @@
   :use-module (vcomponent primitive)
   :use-module ((ice-9 optargs) :select (define*-public)))
 
+;; (define og-struct-ref struct-ref)
+;; (define (struct-ref struct field)
+;;   (format #t "struct = ~a, field = ~a~%" struct field)
+;;   (og-struct-ref struct field))
+
+(use-modules (system vm trap-state))
+
+(install-trap-handler! (lambda args (format #t "args = ~a~%" args)))
+
+(add-trace-at-procedure-call! struct-ref)
+(add-trap-at-procedure-call! struct-ref)
+
+;; vline → value
+(define-public value
+  (make-procedure-with-setter
+   (lambda (vline) (struct-ref vline 0))
+   (lambda (vline value) (struct-set! vline 0 value))))
+
+;; vcomponent x (or str symb) → vline
+(define-public (attr* component attr)
+  (hash-ref (struct-ref component 3)
+            (as-string attr)))
+
+;; vcomponent x (or str symb) → value
 (define (get-attr component attr)
-  (and=> (hash-ref (struct-ref component 3)
-                   (as-string attr))
-         (lambda (l) (struct-ref l 0)))
-  #;
-  (%vcomponent-get-attribute
-   component
-   (as-string attr)))
+  (and=> (attr* component attr)
+         value))
 
 (define (set-attr! component attr value)
-  'noop
-  #;
-  (set! (car (get-attr component (as-string attr)))
-        value))
+  (format #t "attr = ~a~%" attr)
+  (aif (attr* component attr)
+       (begin (format #t "Existed~%") (struct-set! it 0 value))
+       (begin (format #t "Creating, component = ~a, attr = ~a, value = ~a~%" component attr value)
+              (format #t "map = ~a~%" (struct-ref component 3))
+              (let ((return (hash-set! (struct-ref component 3)
+                                (as-string attr)
+                                value)))
+
+                (format #t "Return = ~a~%" return)
+                return
+                )
 
-;; (define-public value caar)
+              )))
 
 ;; (define-public (values-left-count attr-list)
 ;;   (length (take-while identity attr-list)))
@@ -28,8 +55,6 @@
 ;; (define-public (value-count attr-list)
 ;;   (length (take-while identity (cdr (drop-while identity attr-list)))))
 
-(define-public attr* get-attr)
-
 ;; (define (get-first c a)
 ;;   (and=> (car (get-attr c a)) car))
 
@@ -48,32 +73,36 @@
 (define-public prop
   (make-procedure-with-setter
    (lambda (attr-obj prop-key)
-     (hashq-ref (cdar attr-obj) prop-key))
+     (hashq-ref (struct-ref attr-obj 1) prop-key))
    (lambda (attr-obj prop-key val)
-     (hashq-set! (cdar attr-obj) prop-key val))))
+     (hashq-set! (struct-ref attr-obj 1) prop-key val))))
 
 ;; Returns the properties of attribute as an assoc list.
 ;; @code{(map car <>)} leads to available properties.
 (define-public (properties attrptr)
-  (hash-map->list cons (cdar attrptr)))
+  (hash-map->list cons (struct-ref attrptr 1)))
 
 (define-public type (make-procedure-with-setter
                      (lambda (c) (struct-ref c 0))
                      (lambda (c v) struct-set! c 0 v)
                     ))
+
 (define-public (parent c) (struct-ref c 2))
 (define-public push-child! add-child!)
-(define-public (attributes component) '("noop")
+(define-public (attributes component)
+  (hash-map->list cons (struct-ref component 3))
   #; (map string->symbol (%vcomponent-attribute-list component))
   )
 
-(define*-public (children component #:optional only-type)
-  (let ((childs (struct-ref component 1)))
-    (if only-type
-        (filter (lambda (e) (eq? only-type (type e))) childs)
-        childs)))
+(define*-public (children component)
+  (struct-ref component 1))
 
-;; (define-public copy-vcomponent %vcomponent-shallow-copy)
+(define-public (copy-vcomponent component)
+  (make-struct/no-tail (struct-vtable component)
+                       (struct-ref component 0)
+                       (struct-ref component 1)
+                       (struct-ref component 2)
+                       (struct-ref component 3)))
 
 ;; (define-public filter-children! %vcomponent-filter-children!)
 
-- 
cgit v1.2.3


From 60d51e5700a55bc3ae17e34f9f3da1d4653a3026 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@hornquist.se>
Date: Thu, 3 Oct 2019 23:56:59 +0200
Subject: Everything seems to parse now.

---
 module/vcomponent/base.scm                |  2 +-
 module/vcomponent/recurrence/generate.scm | 19 +++++++++++++++----
 2 files changed, 16 insertions(+), 5 deletions(-)

(limited to 'module/vcomponent')

diff --git a/module/vcomponent/base.scm b/module/vcomponent/base.scm
index 986037f5..38034a81 100644
--- a/module/vcomponent/base.scm
+++ b/module/vcomponent/base.scm
@@ -41,7 +41,7 @@
               (format #t "map = ~a~%" (struct-ref component 3))
               (let ((return (hash-set! (struct-ref component 3)
                                 (as-string attr)
-                                value)))
+                                (make-vline value))))
 
                 (format #t "Return = ~a~%" return)
                 return
diff --git a/module/vcomponent/recurrence/generate.scm b/module/vcomponent/recurrence/generate.scm
index 435d3009..a274ecfa 100644
--- a/module/vcomponent/recurrence/generate.scm
+++ b/module/vcomponent/recurrence/generate.scm
@@ -73,6 +73,8 @@
           (date->time-utc d))
 
     (when (attr e 'DTEND)
+      (format #t "file = ~a~%dtstart = ~a~%duration = ~a~%"
+              (attr e 'X-HNH-FILENAME) (attr e 'DTSTART) (attr e 'DURATION))
      (set! (attr e 'DTEND)
            (add-duration (attr e 'DTSTART) (attr e 'DURATION))))
 
@@ -124,12 +126,21 @@
   (if (not (attr event 'RRULE))
       (stream event)
       (begin
+        (format #t "!!! DURATION = ~a~%" (attr event 'DURATION))
         (when (and (attr event 'DTEND)
                    (not (attr event 'DURATION)))
-          (set! (attr event "DURATION")
-                (time-difference
-                 (attr event "DTEND")
-                 (attr event "DTSTART"))))
+          (let ((dt (time-difference  (attr event "DTEND") (attr event "DTSTART") )))
+           (format #t "duration = ~a~%start = ~a, end = ~a~%diff = ~a~%"
+                   (attr event "DURATION")
+                   (attr event "DTSTART") (attr event "DTEND")
+                   dt)
+           (set! (attr event "DURATION")
+             dt
+             #;
+             (time-difference
+             (attr event "DTEND")
+             (attr event "DTSTART")))))
+        (format #t "||| DURATION = ~a~%" (attr* event "DURATION"))
         (if (attr event "RRULE")
             (recur-event-stream event (parse-recurrence-rule (attr event "RRULE")))
             ;; TODO some events STANDARD and DAYLIGT doesn't have RRULE's, but rather
-- 
cgit v1.2.3


From 3521ad64ef664f8303fa93ac237212b97dd0f69c Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@hornquist.se>
Date: Fri, 4 Oct 2019 00:01:27 +0200
Subject: Remove debug prints..

---
 module/vcomponent/base.scm                | 29 ++++-------------------------
 module/vcomponent/recurrence/generate.scm | 21 +++++----------------
 2 files changed, 9 insertions(+), 41 deletions(-)

(limited to 'module/vcomponent')

diff --git a/module/vcomponent/base.scm b/module/vcomponent/base.scm
index 38034a81..399f7af9 100644
--- a/module/vcomponent/base.scm
+++ b/module/vcomponent/base.scm
@@ -5,18 +5,6 @@
   :use-module (vcomponent primitive)
   :use-module ((ice-9 optargs) :select (define*-public)))
 
-;; (define og-struct-ref struct-ref)
-;; (define (struct-ref struct field)
-;;   (format #t "struct = ~a, field = ~a~%" struct field)
-;;   (og-struct-ref struct field))
-
-(use-modules (system vm trap-state))
-
-(install-trap-handler! (lambda args (format #t "args = ~a~%" args)))
-
-(add-trace-at-procedure-call! struct-ref)
-(add-trap-at-procedure-call! struct-ref)
-
 ;; vline → value
 (define-public value
   (make-procedure-with-setter
@@ -34,20 +22,11 @@
          value))
 
 (define (set-attr! component attr value)
-  (format #t "attr = ~a~%" attr)
   (aif (attr* component attr)
-       (begin (format #t "Existed~%") (struct-set! it 0 value))
-       (begin (format #t "Creating, component = ~a, attr = ~a, value = ~a~%" component attr value)
-              (format #t "map = ~a~%" (struct-ref component 3))
-              (let ((return (hash-set! (struct-ref component 3)
-                                (as-string attr)
-                                (make-vline value))))
-
-                (format #t "Return = ~a~%" return)
-                return
-                )
-
-              )))
+       (struct-set! it 0 value)
+       (hash-set! (struct-ref component 3)
+                  (as-string attr)
+                  (make-vline value))))
 
 ;; (define-public (values-left-count attr-list)
 ;;   (length (take-while identity attr-list)))
diff --git a/module/vcomponent/recurrence/generate.scm b/module/vcomponent/recurrence/generate.scm
index a274ecfa..c2863954 100644
--- a/module/vcomponent/recurrence/generate.scm
+++ b/module/vcomponent/recurrence/generate.scm
@@ -73,10 +73,8 @@
           (date->time-utc d))
 
     (when (attr e 'DTEND)
-      (format #t "file = ~a~%dtstart = ~a~%duration = ~a~%"
-              (attr e 'X-HNH-FILENAME) (attr e 'DTSTART) (attr e 'DURATION))
-     (set! (attr e 'DTEND)
-           (add-duration (attr e 'DTSTART) (attr e 'DURATION))))
+      (set! (attr e 'DTEND)
+        (add-duration (attr e 'DTSTART) (attr e 'DURATION))))
 
     ;; Return
     e))
@@ -126,21 +124,12 @@
   (if (not (attr event 'RRULE))
       (stream event)
       (begin
-        (format #t "!!! DURATION = ~a~%" (attr event 'DURATION))
         (when (and (attr event 'DTEND)
                    (not (attr event 'DURATION)))
-          (let ((dt (time-difference  (attr event "DTEND") (attr event "DTSTART") )))
-           (format #t "duration = ~a~%start = ~a, end = ~a~%diff = ~a~%"
-                   (attr event "DURATION")
-                   (attr event "DTSTART") (attr event "DTEND")
-                   dt)
-           (set! (attr event "DURATION")
-             dt
-             #;
-             (time-difference
+          (set! (attr event "DURATION")
+            (time-difference
              (attr event "DTEND")
-             (attr event "DTSTART")))))
-        (format #t "||| DURATION = ~a~%" (attr* event "DURATION"))
+             (attr event "DTSTART"))))
         (if (attr event "RRULE")
             (recur-event-stream event (parse-recurrence-rule (attr event "RRULE")))
             ;; TODO some events STANDARD and DAYLIGT doesn't have RRULE's, but rather
-- 
cgit v1.2.3


From 533b1994a73b6ae5003ad73109a600c0d05b4a92 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@hornquist.se>
Date: Fri, 4 Oct 2019 00:15:19 +0200
Subject: Actually fix NAME.

---
 module/vcomponent/base.scm    | 4 ++--
 module/vcomponent/control.scm | 2 +-
 2 files changed, 3 insertions(+), 3 deletions(-)

(limited to 'module/vcomponent')

diff --git a/module/vcomponent/base.scm b/module/vcomponent/base.scm
index 399f7af9..3bd58c21 100644
--- a/module/vcomponent/base.scm
+++ b/module/vcomponent/base.scm
@@ -52,9 +52,9 @@
 (define-public prop
   (make-procedure-with-setter
    (lambda (attr-obj prop-key)
-     (hashq-ref (struct-ref attr-obj 1) prop-key))
+     (hash-ref (struct-ref attr-obj 1) prop-key))
    (lambda (attr-obj prop-key val)
-     (hashq-set! (struct-ref attr-obj 1) prop-key val))))
+     (hash-set! (struct-ref attr-obj 1) prop-key val))))
 
 ;; Returns the properties of attribute as an assoc list.
 ;; @code{(map car <>)} leads to available properties.
diff --git a/module/vcomponent/control.scm b/module/vcomponent/control.scm
index 38199161..3bdecc5a 100644
--- a/module/vcomponent/control.scm
+++ b/module/vcomponent/control.scm
@@ -5,7 +5,7 @@
 
 
 (eval-when (expand load)                ; No idea why I must have load here.
-  (define href (make-procedure-with-setter hashq-ref hashq-set!))
+  (define href (make-procedure-with-setter hash-ref hash-set!))
 
   (define (set-temp-values! table component kvs)
     (for-each (lambda (kv)
-- 
cgit v1.2.3


From 77791305d6e1483fa5ae46f26616242c00f99989 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@hornquist.se>
Date: Fri, 4 Oct 2019 21:02:17 +0200
Subject: HTML output seems to work in full now.

---
 module/vcomponent/base.scm                | 11 ++++++++++-
 module/vcomponent/group.scm               |  1 +
 module/vcomponent/recurrence/generate.scm |  3 +++
 3 files changed, 14 insertions(+), 1 deletion(-)

(limited to 'module/vcomponent')

diff --git a/module/vcomponent/base.scm b/module/vcomponent/base.scm
index 3bd58c21..246566ee 100644
--- a/module/vcomponent/base.scm
+++ b/module/vcomponent/base.scm
@@ -3,6 +3,7 @@
   :use-module (srfi srfi-1)
   :use-module (srfi srfi-17)
   :use-module (vcomponent primitive)
+  :use-module (ice-9 hash-table)
   :use-module ((ice-9 optargs) :select (define*-public)))
 
 ;; vline → value
@@ -76,12 +77,20 @@
 (define*-public (children component)
   (struct-ref component 1))
 
+(define (copy-vline vline)
+  (make-struct/no-tail (struct-vtable vline)
+                       (struct-ref vline 0)
+                       ;; TODO deep-copy on properties?
+                       (struct-ref vline 1)))
+
 (define-public (copy-vcomponent component)
   (make-struct/no-tail (struct-vtable component)
                        (struct-ref component 0)
                        (struct-ref component 1)
                        (struct-ref component 2)
-                       (struct-ref component 3)))
+                       (alist->hash-table
+                        (hash-map->list (lambda (key value) (cons key (copy-vline value)))
+                                        (struct-ref component 3)))))
 
 ;; (define-public filter-children! %vcomponent-filter-children!)
 
diff --git a/module/vcomponent/group.scm b/module/vcomponent/group.scm
index c5b6948e..41123126 100644
--- a/module/vcomponent/group.scm
+++ b/module/vcomponent/group.scm
@@ -7,6 +7,7 @@
   #:use-module (srfi srfi-41 util)
   #:export (group-stream))
 
+;; TODO templetize this
 (define-stream (group-stream in-stream)
   (define (ein? day) (lambda (e) (event-contains? e (date->time-utc day))))
 
diff --git a/module/vcomponent/recurrence/generate.scm b/module/vcomponent/recurrence/generate.scm
index c2863954..3f4cb869 100644
--- a/module/vcomponent/recurrence/generate.scm
+++ b/module/vcomponent/recurrence/generate.scm
@@ -51,6 +51,9 @@
                  (get-tz-offset e)
                  0))))
 
+    (set! (attr ev 'DTSTART)
+      (copy-time (attr ev 'DTSTART)))
+
     (let ((i (interval r)))
      (case (freq r)
        ((SECONDLY) (mod! (second d) = (+ i)))
-- 
cgit v1.2.3


From 1bc8f0c31fd94b3936fc13ed325ecd8308d73f87 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@hornquist.se>
Date: Sat, 5 Oct 2019 23:51:50 +0200
Subject: Fix day-stream, and in effect terminal output.

---
 module/vcomponent/group.scm | 8 +++++---
 1 file changed, 5 insertions(+), 3 deletions(-)

(limited to 'module/vcomponent')

diff --git a/module/vcomponent/group.scm b/module/vcomponent/group.scm
index 41123126..7733d981 100644
--- a/module/vcomponent/group.scm
+++ b/module/vcomponent/group.scm
@@ -5,7 +5,7 @@
   #:use-module (srfi srfi-19 util)
   #:use-module (srfi srfi-41)
   #:use-module (srfi srfi-41 util)
-  #:export (group-stream))
+  #:export (group-stream get-groups-between))
 
 ;; TODO templetize this
 (define-stream (group-stream in-stream)
@@ -16,7 +16,8 @@
     (if (stream-null? stream)
         stream-null
         (let* ((day (stream-car days))
-               (tomorow (add-day (date->time-utc (drop-time day)))))
+               (tomorow (date->time-utc (stream-car (stream-cdr days)))))
+
           (let ((head (stream-take-while (ein? day) stream))
                 (tail
                  (filter-sorted-stream*
@@ -24,11 +25,12 @@
                   (lambda (e) (time<=? tomorow (attr e 'DTSTART)))
                   stream)))
 
+
             (stream-cons (cons day head)
                          (loop (stream-cdr days)
                                tail)))))))
 
-(define-public (get-groups-between groups start-date end-date)
+(define (get-groups-between groups start-date end-date)
   (filter-sorted-stream
    ;; TODO in-date-range? drops the first date
    (compose (in-date-range? start-date end-date)
-- 
cgit v1.2.3


From 68dfd8bb5abcc449500614c46566ffa4a83177a4 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@hornquist.se>
Date: Sat, 5 Oct 2019 23:58:03 +0200
Subject: Documentation of stream behavior.

---
 module/vcomponent/group.scm | 5 +++++
 1 file changed, 5 insertions(+)

(limited to 'module/vcomponent')

diff --git a/module/vcomponent/group.scm b/module/vcomponent/group.scm
index 7733d981..46160a3a 100644
--- a/module/vcomponent/group.scm
+++ b/module/vcomponent/group.scm
@@ -20,6 +20,11 @@
 
           (let ((head (stream-take-while (ein? day) stream))
                 (tail
+                 ;; This is a filter, instead of a stream-span together with head,
+                 ;; since events can span multiple days.
+                 ;; This starts with taking everything which end after the beginning
+                 ;; of tommorow, and finishes with the rest when it finds the first
+                 ;; object which begins tomorow (after midnight, exclusize).
                  (filter-sorted-stream*
                   (lambda (e) (time<? tomorow (attr e 'DTEND)))
                   (lambda (e) (time<=? tomorow (attr e 'DTSTART)))
-- 
cgit v1.2.3


From feefb97cf9118c8e5d7018e33887a371dadc5eab Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@hornquist.se>
Date: Sun, 6 Oct 2019 13:35:20 +0200
Subject: Minor cleanup in scheme code.

---
 module/vcomponent/base.scm      | 27 +++++----------------------
 module/vcomponent/primitive.scm | 22 ++++------------------
 module/vcomponent/timezone.scm  |  3 ++-
 3 files changed, 11 insertions(+), 41 deletions(-)

(limited to 'module/vcomponent')

diff --git a/module/vcomponent/base.scm b/module/vcomponent/base.scm
index 246566ee..69fab656 100644
--- a/module/vcomponent/base.scm
+++ b/module/vcomponent/base.scm
@@ -6,6 +6,8 @@
   :use-module (ice-9 hash-table)
   :use-module ((ice-9 optargs) :select (define*-public)))
 
+(export add-child!)
+
 ;; vline → value
 (define-public value
   (make-procedure-with-setter
@@ -29,25 +31,10 @@
                   (as-string attr)
                   (make-vline value))))
 
-;; (define-public (values-left-count attr-list)
-;;   (length (take-while identity attr-list)))
-
-;; (define-public (value-count attr-list)
-;;   (length (take-while identity (cdr (drop-while identity attr-list)))))
-
-;; (define (get-first c a)
-;;   (and=> (car (get-attr c a)) car))
-
-;; (define (set-first! c a v)
-;;   (and=> (car (get-attr c a))
-;;          (lambda (f) (set! (car f) v))))
-
 (define-public attr
   (make-procedure-with-setter
-;    get-first set-first!
    get-attr
-   set-attr!
-   ))
+   set-attr!))
 
 
 (define-public prop
@@ -68,11 +55,9 @@
                     ))
 
 (define-public (parent c) (struct-ref c 2))
-(define-public push-child! add-child!)
+
 (define-public (attributes component)
-  (hash-map->list cons (struct-ref component 3))
-  #; (map string->symbol (%vcomponent-attribute-list component))
-  )
+  (hash-map->list cons (struct-ref component 3)))
 
 (define*-public (children component)
   (struct-ref component 1))
@@ -92,8 +77,6 @@
                         (hash-map->list (lambda (key value) (cons key (copy-vline value)))
                                         (struct-ref component 3)))))
 
-;; (define-public filter-children! %vcomponent-filter-children!)
-
 (define-public (extract field)
   (lambda (e) (attr e field)))
 
diff --git a/module/vcomponent/primitive.scm b/module/vcomponent/primitive.scm
index 2cf12508..5fef08cc 100644
--- a/module/vcomponent/primitive.scm
+++ b/module/vcomponent/primitive.scm
@@ -1,23 +1,9 @@
 ;;; Primitive export of symbols linked from C binary.
 
 (define-module (vcomponent primitive)
-  #:export #; 
-  (%vcomponent-children                 ;
-  %vcomponent-push-child!               ;
-  %vcomponent-filter-children!          ;
-                                        ;
-  %vcomponent-parent                    ;
-                                        ;
-  %vcomponent-make                      ;
-  %vcomponent-get-type                  ;
-  %vcomponent-set-type!                 ;
-                                        ;
-  %vcomponent-get-attribute             ;
-  %vcomponent-attribute-list            ;
-                                        ;
-  %vcomponent-shallow-copy)
-
-  (make-vcomponent add-line! add-child! make-vline add-attribute! parse-cal-path)
-  )
+  #:export (make-vcomponent
+            add-line! add-child!
+            make-vline add-attribute!
+            parse-cal-path))
 
 (load-extension "libguile-calendar" "init_lib")
diff --git a/module/vcomponent/timezone.scm b/module/vcomponent/timezone.scm
index 4a312288..dde32cc2 100644
--- a/module/vcomponent/timezone.scm
+++ b/module/vcomponent/timezone.scm
@@ -68,7 +68,8 @@
 ;; Crashes on error.
 (define (find-tz cal tzid)
   (let ((ret (find (lambda (tz) (string=? tzid (attr tz 'TZID)))
-                   (children cal 'VTIMEZONE))))
+                   (filter (lambda (o) (eq? 'VTIMEZONE (type o)))
+                           (children cal)))))
     ret))
 
 ;; Takes a VEVENT.
-- 
cgit v1.2.3


From de97337a13ffd480355148da252859a205e10b74 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@hornquist.se>
Date: Sun, 6 Oct 2019 19:53:27 +0200
Subject: Fix re-export of add-child!

---
 module/vcomponent/base.scm | 5 ++---
 1 file changed, 2 insertions(+), 3 deletions(-)

(limited to 'module/vcomponent')

diff --git a/module/vcomponent/base.scm b/module/vcomponent/base.scm
index 69fab656..3072c0a5 100644
--- a/module/vcomponent/base.scm
+++ b/module/vcomponent/base.scm
@@ -4,9 +4,8 @@
   :use-module (srfi srfi-17)
   :use-module (vcomponent primitive)
   :use-module (ice-9 hash-table)
-  :use-module ((ice-9 optargs) :select (define*-public)))
-
-(export add-child!)
+  :use-module ((ice-9 optargs) :select (define*-public))
+  :re-export (add-child!))
 
 ;; vline → value
 (define-public value
-- 
cgit v1.2.3


From 7578a9c3375a364e5fd2bf629811394208c4cf5e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@hornquist.se>
Date: Sun, 6 Oct 2019 22:48:56 +0200
Subject: Fix property access.

---
 module/vcomponent/base.scm | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

(limited to 'module/vcomponent')

diff --git a/module/vcomponent/base.scm b/module/vcomponent/base.scm
index 3072c0a5..98b2aa89 100644
--- a/module/vcomponent/base.scm
+++ b/module/vcomponent/base.scm
@@ -39,9 +39,9 @@
 (define-public prop
   (make-procedure-with-setter
    (lambda (attr-obj prop-key)
-     (hash-ref (struct-ref attr-obj 1) prop-key))
+     (hash-ref (struct-ref attr-obj 1) (as-string prop-key)))
    (lambda (attr-obj prop-key val)
-     (hash-set! (struct-ref attr-obj 1) prop-key val))))
+     (hash-set! (struct-ref attr-obj 1) (as-string prop-key) val))))
 
 ;; Returns the properties of attribute as an assoc list.
 ;; @code{(map car <>)} leads to available properties.
-- 
cgit v1.2.3


From 86ae614050a1aba19a2d14e12ff7b62cc47b778c Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@hornquist.se>
Date: Sun, 6 Oct 2019 22:56:35 +0200
Subject: Slight impromevents to parse-offset.

---
 module/vcomponent/timezone.scm | 10 ++++++----
 1 file changed, 6 insertions(+), 4 deletions(-)

(limited to 'module/vcomponent')

diff --git a/module/vcomponent/timezone.scm b/module/vcomponent/timezone.scm
index dde32cc2..f6112ebc 100644
--- a/module/vcomponent/timezone.scm
+++ b/module/vcomponent/timezone.scm
@@ -58,11 +58,13 @@
 
           [else (stream-zip strm (stream-cdr strm))])))
 
+;; str ::= ±[0-9]{4}
+;; str → int seconds
 (define (parse-offset str)
-  (let* (((pm h1 h0 m1 m0) (string->list str)))
-    ((primitive-eval (symbol pm))
-     (+ (* 60 (string->number (list->string (list m1 m0))))
-        (* 60 60 (string->number (list->string (list h1 h0))))))))
+  (let* (((± h1 h0 m1 m0) (string->list str)))
+    ((primitive-eval (symbol ±))
+     (+ (* 60    (string->number (string m1 m0)))
+        (* 60 60 (string->number (string h1 h0)))))))
 
 ;; Finds the VTIMEZONE with id @var{tzid} in calendar.
 ;; Crashes on error.
-- 
cgit v1.2.3


From 69d36e6e02fa2ded0c036446c18c80f4d16740f9 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@hornquist.se>
Date: Tue, 15 Oct 2019 23:43:29 +0200
Subject: Made extrapolate-tz-stream slightly less worse.

---
 module/vcomponent/timezone.scm | 21 +++++++++++++--------
 1 file changed, 13 insertions(+), 8 deletions(-)

(limited to 'module/vcomponent')

diff --git a/module/vcomponent/timezone.scm b/module/vcomponent/timezone.scm
index f6112ebc..ed3bef6b 100644
--- a/module/vcomponent/timezone.scm
+++ b/module/vcomponent/timezone.scm
@@ -28,15 +28,20 @@
 ;; :         TZOFFSETFROM: +0200
 ;; @end example
 
-;; Given a tz stream of length 2, takes the time difference between the DTSTART
-;; of those two. And creates a new VTIMEZONE with that end time.
-;; TODO set remaining properties, and type of the newly created component.
+;; Given a tz stream of length 2, extrapolates when the next timezone
+;; change aught to be.
+;; Currently it does so by taking the first time zone, and adding one
+;; year. This kind of works.
+;; Previously it took the difference between element 2 and 1, and added
+;; that to the start of the secound time zone. This was even more wrong.
+;; TODO? set remaining properties, and type of the newly created component.
 (define (extrapolate-tz-stream strm)
-  (let ((nevent (copy-vcomponent (stream-ref strm 1))))
-    (mod! (attr nevent 'DTSTART)
-          = (add-duration (time-difference
-                           (attr (stream-ref strm 1) 'DTSTART)
-                           (attr (stream-ref strm 0) 'DTSTART))))
+  (let ((nevent (copy-vcomponent (stream-car strm))))
+    (set! (attr nevent 'DTSTART)
+      (date->time-utc
+       (set (date-year
+             (time-utc->date (attr nevent 'DTSTART)))
+            = (+ 1))))
     (stream-append strm (stream nevent))))
 
 ;; The RFC requires that at least one DAYLIGHT or STANDARD component is present.
-- 
cgit v1.2.3


From 4cfb8ec5e6dad161dfefb683a64490d468caad7e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@hornquist.se>
Date: Sat, 2 Nov 2019 22:26:18 +0100
Subject: Move parser into module subtree.

---
 module/vcomponent/base.scm      |  86 ++++++-----
 module/vcomponent/parse.scm     | 322 ++++++++++++++++++++++++++++++++++++++++
 module/vcomponent/primitive.scm |   9 --
 3 files changed, 372 insertions(+), 45 deletions(-)
 create mode 100644 module/vcomponent/parse.scm
 delete mode 100644 module/vcomponent/primitive.scm

(limited to 'module/vcomponent')

diff --git a/module/vcomponent/base.scm b/module/vcomponent/base.scm
index 98b2aa89..f43f532e 100644
--- a/module/vcomponent/base.scm
+++ b/module/vcomponent/base.scm
@@ -2,33 +2,43 @@
   :use-module (util)
   :use-module (srfi srfi-1)
   :use-module (srfi srfi-17)
-  :use-module (vcomponent primitive)
+  :use-module ((vcomponent parse)
+               :renamer (lambda (symb)
+                          (case symb
+                            ;; [(set-attribute!) 'get-attribute]
+                            [(make-vcomponent) 'primitive-make-vcomponent]
+                            [else symb])))
   :use-module (ice-9 hash-table)
   :use-module ((ice-9 optargs) :select (define*-public))
-  :re-export (add-child!))
+  :re-export (add-child! primitive-make-vcomponent))
+
+(define-public (parse-cal-path path)
+  (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")))
+    parent))
 
 ;; vline → value
 (define-public value
   (make-procedure-with-setter
-   (lambda (vline) (struct-ref vline 0))
-   (lambda (vline value) (struct-set! vline 0 value))))
+   get-vline-value set-vline-value!))
 
 ;; vcomponent x (or str symb) → vline
 (define-public (attr* component attr)
-  (hash-ref (struct-ref component 3)
-            (as-string attr)))
+  (hashq-ref (get-component-attributes component)
+             (as-symb attr)))
 
 ;; vcomponent x (or str symb) → value
-(define (get-attr component attr)
-  (and=> (attr* component attr)
-         value))
+(define (get-attr component key)
+  (get-attribute-value component (as-symb key) #f))
 
-(define (set-attr! component attr value)
-  (aif (attr* component attr)
-       (struct-set! it 0 value)
-       (hash-set! (struct-ref component 3)
-                  (as-string attr)
-                  (make-vline value))))
+(define (set-attr! component key value)
+  (set-attribute! component (as-symb key) value))
 
 (define-public attr
   (make-procedure-with-setter
@@ -39,42 +49,46 @@
 (define-public prop
   (make-procedure-with-setter
    (lambda (attr-obj prop-key)
-     (hash-ref (struct-ref attr-obj 1) (as-string prop-key)))
+     ;; TODO `list' is a hack since a bit to much code depends
+     ;; on prop always returning a list of values.
+     (and=> (hashq-ref (get-vline-parameters attr-obj)
+                       (as-symb prop-key))
+            list))
    (lambda (attr-obj prop-key val)
-     (hash-set! (struct-ref attr-obj 1) (as-string prop-key) val))))
+     (hashq-set! (get-vline-parameters attr-obj)
+                 (as-symb prop-key) val))))
 
 ;; Returns the properties of attribute as an assoc list.
 ;; @code{(map car <>)} leads to available properties.
 (define-public (properties attrptr)
-  (hash-map->list cons (struct-ref attrptr 1)))
+  (hash-map->list cons (get-attribute-parameters attrptr)))
 
 (define-public type (make-procedure-with-setter
-                     (lambda (c) (struct-ref c 0))
-                     (lambda (c v) struct-set! c 0 v)
-                    ))
+                     (lambda (c) (component-type c))
+                     (lambda (c v) ; struct-set! c 0 v
+                       (format (current-error-port)
+                               "This method is a deprecated NOOP"))))
 
-(define-public (parent c) (struct-ref c 2))
+(define-public parent get-component-parent)
 
 (define-public (attributes component)
-  (hash-map->list cons (struct-ref component 3)))
+  (hash-map->list cons (get-component-attributes component)))
 
-(define*-public (children component)
-  (struct-ref component 1))
+(define*-public children get-component-children)
 
 (define (copy-vline vline)
-  (make-struct/no-tail (struct-vtable vline)
-                       (struct-ref vline 0)
-                       ;; TODO deep-copy on properties?
-                       (struct-ref vline 1)))
+  (make-vline (get-vline-value vline)
+              ;; TODO deep-copy on properties?
+              (get-vline-parameters vline)))
 
 (define-public (copy-vcomponent component)
-  (make-struct/no-tail (struct-vtable component)
-                       (struct-ref component 0)
-                       (struct-ref component 1)
-                       (struct-ref component 2)
-                       (alist->hash-table
-                        (hash-map->list (lambda (key value) (cons key (copy-vline value)))
-                                        (struct-ref component 3)))))
+  (make-vcomponent% (component-type component)
+                    (get-component-children component)
+                    (get-component-parent component)
+                    ;; attributes
+                    (alist->hashq-table
+                     (hash-map->list (lambda (key value) (cons key (copy-vline value)))
+                                     (get-component-attributes component)))))
 
 (define-public (extract field)
   (lambda (e) (attr e field)))
diff --git a/module/vcomponent/parse.scm b/module/vcomponent/parse.scm
new file mode 100644
index 00000000..9eabacb3
--- /dev/null
+++ b/module/vcomponent/parse.scm
@@ -0,0 +1,322 @@
+
+(define-module (vcomponent parse)
+  :use-module (rnrs io ports)
+  :use-module (rnrs bytevectors)
+  :use-module (srfi srfi-9)
+  :use-module ((ice-9 textual-ports) :select (unget-char))
+  :use-module ((ice-9 ftw) :select (scandir ftw)))
+
+
+
+(define-record-type <vline>
+  (make-vline% value parameters)
+  vline?
+  (value get-vline-value set-vline-value!)
+  (parameters get-vline-parameters))
+
+(define* (make-vline value #:optional ht)
+  (make-vline% value (or ht (make-hash-table))))
+
+(define-record-type <vcomponent>
+  (make-vcomponent% type children parent attributes)
+  vcomponent?
+  (type component-type)
+  (children get-component-children set-component-children!)
+  (parent get-component-parent set-component-parent!)
+  (attributes get-component-attributes))
+
+(define* (make-vcomponent #:optional (type 'VIRTUAL))
+  (make-vcomponent% type '() #f (make-hash-table #x10)))
+
+(define (add-child! parent child)
+  (set-component-children! parent (cons child (get-component-children parent)))
+  (set-component-parent! child parent))
+
+(define* (get-attribute-value component key #:optional default)
+  (cond [(hashq-ref (get-component-attributes component)
+                    key #f)
+         => get-vline-value]
+        [else default]))
+
+(define (get-attribute component key)
+  (hashq-ref (get-component-attributes component)
+             key))
+
+(define (set-attribute! component key value)
+  (let ((ht (get-component-attributes component)))
+   (cond [(hashq-ref ht key #f)
+          => (lambda (vline) (set-vline-value! vline value))]
+         [else (hashq-set! ht key (make-vline value))])))
+
+(define (set-vline! component key vline)
+  (hashq-set! (get-component-attributes component)
+              key vline))
+
+
+
+(define-record-type <parse-ctx>
+  (make-parse-ctx% filename row col ctx line-key param-key param-table)
+  parse-ctx?
+  (filename get-filename)               ; string
+  (row get-row set-row!)                ; [0, ]
+  (col get-col set-col!)                ; [1, )
+  (ctx get-ctx set-ctx!)                ; '(key value param-name param-value escape)
+  (line-key get-line-key set-line-key!) ; string
+  (param-key get-param-key set-param-key!)       ; string
+  (param-table get-param-table set-param-table!) ; hash-map
+  )
+
+(define (make-parse-ctx filename)
+  (make-parse-ctx% filename 1 0 'key
+                   #f #f (make-hash-table)))
+
+(define (increment-column! ctx)
+  (set-col! ctx (1+ (get-col ctx))))
+
+(define (increment-row! ctx)
+  (set-col! ctx 0)
+  (set-row! ctx (1+ (get-row ctx))))
+
+
+
+(define-record-type <strbuf>
+  (make-strbuf% len bytes)
+  strbuf?
+  (len get-length set-length!)
+  (bytes get-bytes set-bytes!))
+
+(define (make-strbuf)
+  (make-strbuf% 0 (make-u8vector #x1000)))
+
+(define (strbuf-realloc! strbuf)
+  (let* ((len (u8vector-length (get-bytes strbuf)))
+         (nv (make-u8vector (ash len 1))))
+    (bytevector-copy! (get-bytes strbuf) 0
+                      nv 0 len)
+    (set-bytes! strbuf nv)))
+
+(define (strbuf->string strbuf)
+  (let ((bv (make-u8vector (get-length strbuf))))
+    (bytevector-copy! (get-bytes strbuf) 0
+                      bv 0
+                      (get-length strbuf))
+    (bytevector->string bv (native-transcoder))))  ; TODO charset
+
+(define (strbuf-reset! strbuf)
+  (set-length! strbuf 0))
+
+(define (strbuf-append! strbuf u8)
+  (catch 'out-of-range
+    (lambda ()
+     (u8vector-set! (get-bytes strbuf)
+                    (get-length strbuf)
+                    u8))
+    (lambda (err . args)
+      (strbuf-realloc! strbuf)
+      (strbuf-append! strbuf u8)))
+  (set-length! strbuf (1+ (get-length strbuf))))
+
+
+
+(define (fold-proc ctx c)
+  ;; First extra character optionall read is to get the \n if our line
+  ;; ended with \r\n. Secound read is to get the first character of the
+  ;; next line. The initial \r which might recide in @var{c} is discarded.
+  (let ((pair (cons (if (char=? #\newline (integer->char c))
+                         c (get-u8 (current-input-port)))
+                        (get-u8 (current-input-port)))))
+    (increment-row! ctx)
+    (cond [(not (char=? #\newline (integer->char (car pair))))
+           (error "Expected newline after CR")]
+
+          ;; The standard (3.4, l. 2675) says that each icalobject must
+          ;; end with CRLF. My files however does not. This means that
+          ;; an EOF can immideately follow a \n\r pair. But this case is the
+          ;; same as that we are at the end of line, so we spoof it and let
+          ;; the regular parser loop handle it.
+          [(eof-object? (cdr pair))
+           'end-of-line]
+
+          ;; Following line begins with a whitespace character,
+          ;; meaning that we don't break the logical line here.
+          [(memv (integer->char (cdr pair)) '(#\space #\tab))
+           (increment-column! ctx)      ; since we just read the space
+           'fold]
+
+          [else
+           ;; TODO check if this failed, and signal a writeback error
+           (unget-char (current-input-port)
+                       (integer->char (cdr pair)))
+
+           'end-of-line])))
+
+(define (parse-calendar port)
+  (with-input-from-port port
+    (lambda ()
+      (let ((component (make-vcomponent))
+            (ctx (make-parse-ctx (port-filename port)))
+            (strbuf (make-strbuf)))
+        (with-throw-handler #t
+          (lambda ()
+
+            (set-attribute! component 'X-HNH-FILENAME
+                            (get-filename ctx))
+
+            (while #t
+              (let ((c (get-u8 (current-input-port))))
+                (cond
+
+                 ;; End of file
+                 [(eof-object? c)
+                  ;; == NOTE ==
+                  ;; We never check the final line here. But since it
+                  ;; ALWAYS should be "END:VCOMPONENT", and we do all
+                  ;; the setup at creation this shouldn't be a problem.
+                  (break (case (get-ctx ctx)
+                           [(key)             ; line ended
+                            (let ((root-component
+                                   (car (get-component-children component))))
+                              (set-component-parent! root-component #f)
+                              root-component)]
+                           [(value)           ; still ending line
+                            (set-component-parent! component #f)
+                            component]
+                           [else => (lambda (a)
+                                      (scm-error 'wrong-type-arg "parse-break"
+                                                 (string-append
+                                                  "Bad context at end of file. "
+                                                  "Expected `key' or `value', got ~a")
+                                                 (list a) #f))]))]
+
+                 ;; End of line
+                 [(memv (integer->char c) '(#\return #\newline))
+                  (case (fold-proc ctx c)
+                    [(end-of-line)
+                     (let ((str (strbuf->string strbuf)))
+                       (cond [(eq? (get-line-key ctx) 'BEGIN)
+                              (let ((child (make-vcomponent (string->symbol str))))
+                                ;; TOOD remove this copying of attributes!!!
+                                (for-each (lambda (pair)
+                                            (set-attribute! child
+                                                            (car pair)
+                                                            (cdr pair)))
+                                          (hash-map->list
+                                           cons (get-component-attributes component)))
+                                (add-child! component child)
+                                (set! component child))]
+
+                             [(eq? (get-line-key ctx) 'END)
+                              (set! component (get-component-parent component))]
+
+                             [else
+                              ;; TODO repeated keys
+                              (set-vline! component (get-line-key ctx)
+                                          (make-vline str (get-param-table ctx)))
+                              (set-param-table! ctx (make-hash-table))])
+
+                       (strbuf-reset! strbuf)
+                       (set-ctx! ctx 'key))]
+                    [(fold) 'noop] ; Good case, here to catch errors in else
+                    [else => (lambda (a) (error "Bad return from fold, unexpected" a))])]
+
+                 ;; Escaped characters
+                 [(char=? #\\ (integer->char c))
+                  (case (integer->char (get-u8 (current-input-port)))
+                    ;; Escape character '\' and escaped token sepparated by a newline
+                    ;; (since the standard for some reason allows that (!!!))
+                    ;; We are at least guaranteed that it's a folded line, so just
+                    ;; unfold it and continue trying to find a token to escape.
+                    [(#\return #\newline)
+                     => (lambda (c)
+                          (case (fold-proc ctx (char->integer c))
+                            [(end-of-line)
+                             (throw 'escape-error "ESC before not folded line")]
+                            [(fold)
+                             (increment-column! ctx)
+                             (strbuf-append! strbuf (get-u8 (current-input-port)))]))]
+
+                    [(#\n #\N) (strbuf-append! strbuf (char->integer #\newline))]
+                    [(#\; #\, #\\) => (lambda (c) (strbuf-append! strbuf (char->integer c)))]
+                    [else => (lambda (c) (throw 'escape-error "Non-escapable character" c))])
+                  (increment-column! ctx)]
+
+                 ;; Delimiter between param key and param value
+                 [(and (eq? (get-ctx ctx) 'param-name)
+                       (char=? #\= (integer->char c)))
+                  (set-param-key! ctx (string->symbol (strbuf->string strbuf)))
+                  (strbuf-reset! strbuf)
+                  (set-ctx! ctx 'param-value)]
+
+                 ;; Delimiter between parameters (;), or between
+                 ;; "something" and attribute value (:)
+                 [(and (memv (integer->char c) '(#\: #\;))
+                       (memv (get-ctx ctx) '(param-value key)))
+                  (case (get-ctx ctx)
+                    [(param-value)
+                     (hashq-set! (get-param-table ctx)
+                                 (get-param-key ctx)
+                                 (strbuf->string strbuf))
+                     (strbuf-reset! strbuf)]
+                    [(key)
+                     (set-line-key! ctx (string->symbol (strbuf->string strbuf)))
+                     (strbuf-reset! strbuf)])
+
+                  (set-ctx! ctx (case (integer->char c)
+                                  [(#\:) 'value]
+                                  [(#\;) 'param-name]))]
+
+                 ;; Regular character
+                 [else
+                  (strbuf-append! strbuf c)
+                  (increment-column! ctx)]))))
+
+          (lambda _
+            (format (current-error-port)
+                    "== PARSE ERROR ==
+filename = ~a
+row ~a	column ~a	ctx = ~a
+~a ; ~a = ... : ...~%~%"
+                    (get-filename ctx)
+                    (get-row ctx) (get-col ctx) (get-ctx ctx)
+                    (get-line-key ctx) (get-param-key ctx))))))))
+
+
+
+(define-public (read-vcalendar path)
+  (define st (stat path))
+  (case (stat:type st)
+    [(regular) (let ((comp (call-with-input-file path parse-calendar)))
+                 (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))))))]
+    [(block-special char-special fifo socket unknown symlink)
+     => (lambda (t) (error "Can't parse file of type " t))]))
+
+
+(define-public (read-tree path)
+  (define list '())
+  (ftw path
+       (lambda (filename statinfo flag)
+         (case flag
+           [(regular)
+            (case (stat:type statinfo)
+              [(regular)
+               (when (and (not (string= "." (string-take filename 1)))
+                          (string= "ics" (string-take-right filename 3)))
+                 (set! list (cons filename list)))
+               #t]
+              [else #t])]
+           [(directory) #t]
+           [else #f])))
+  ((@ (ice-9 threads) n-par-map) 12
+   (lambda (fname) (call-with-input-file fname parse-calendar))
+   list))
+
+
+(export add-child! make-vcomponent get-vline-value set-vline-value! get-component-parent get-component-children get-attribute-value set-attribute! get-component-attributes component-type make-vcomponent% make-vline get-vline-parameters)
diff --git a/module/vcomponent/primitive.scm b/module/vcomponent/primitive.scm
deleted file mode 100644
index 5fef08cc..00000000
--- a/module/vcomponent/primitive.scm
+++ /dev/null
@@ -1,9 +0,0 @@
-;;; Primitive export of symbols linked from C binary.
-
-(define-module (vcomponent primitive)
-  #:export (make-vcomponent
-            add-line! add-child!
-            make-vline add-attribute!
-            parse-cal-path))
-
-(load-extension "libguile-calendar" "init_lib")
-- 
cgit v1.2.3


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(-)

(limited to 'module/vcomponent')

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


From 275dfc4b4fc7bd8ad3244dbd6c9053fe1ceb7f5b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@hornquist.se>
Date: Sun, 3 Nov 2019 13:39:57 +0100
Subject: Remove make-vcomponent.

---
 module/vcomponent/base.scm | 11 +++--------
 1 file changed, 3 insertions(+), 8 deletions(-)

(limited to 'module/vcomponent')

diff --git a/module/vcomponent/base.scm b/module/vcomponent/base.scm
index 86ea40e8..60a27f94 100644
--- a/module/vcomponent/base.scm
+++ b/module/vcomponent/base.scm
@@ -2,18 +2,13 @@
   :use-module (util)
   :use-module (srfi srfi-1)
   :use-module (srfi srfi-17)
-  :use-module ((vcomponent parse)
-               :renamer (lambda (symb)
-                          (case symb
-                            ;; [(set-attribute!) 'get-attribute]
-                            [(make-vcomponent) 'primitive-make-vcomponent]
-                            [else symb])))
+  :use-module (vcomponent parse)
   :use-module (ice-9 hash-table)
   :use-module ((ice-9 optargs) :select (define*-public))
-  :re-export (add-child! primitive-make-vcomponent))
+  :re-export (add-child! make-vcomponent))
 
 (define-public (parse-cal-path path)
-  (let ((parent (primitive-make-vcomponent)))
+  (let ((parent (make-vcomponent)))
     (for-each (lambda (child) (add-child! parent child))
               (read-vcalendar path))
     (set-attribute!
-- 
cgit v1.2.3


From cecffe9ebdd0bb1efb628da320039fec9e6cba39 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@hornquist.se>
Date: Sun, 3 Nov 2019 13:57:46 +0100
Subject: Move stuff between vcomponent/{base,parse}.

---
 module/vcomponent/base.scm  |  89 ++++++++++++++++++---------
 module/vcomponent/parse.scm | 142 +++++++++++++++++---------------------------
 2 files changed, 116 insertions(+), 115 deletions(-)

(limited to 'module/vcomponent')

diff --git a/module/vcomponent/base.scm b/module/vcomponent/base.scm
index 60a27f94..52bbe0c3 100644
--- a/module/vcomponent/base.scm
+++ b/module/vcomponent/base.scm
@@ -1,23 +1,66 @@
 (define-module (vcomponent base)
   :use-module (util)
   :use-module (srfi srfi-1)
+  :use-module (srfi srfi-9)
   :use-module (srfi srfi-17)
-  :use-module (vcomponent parse)
   :use-module (ice-9 hash-table)
   :use-module ((ice-9 optargs) :select (define*-public))
-  :re-export (add-child! make-vcomponent))
-
-(define-public (parse-cal-path path)
-  (let ((parent (make-vcomponent)))
-    (for-each (lambda (child) (add-child! parent child))
-              (read-vcalendar path))
-    (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))
+  )
+
+
+
+;; The <vline> type is a bit to many times refered to as a attr ptr.
+(define-record-type <vline>
+  (make-vline% value parameters)
+  vline?
+  (value get-vline-value set-vline-value!)
+  (parameters get-vline-parameters))
+
+(define*-public (make-vline value #:optional ht)
+  (make-vline% value (or ht (make-hash-table))))
+
+(define-record-type <vcomponent>
+  (make-vcomponent% type children parent attributes)
+  vcomponent?
+  (type type)
+  (children children set-component-children!)
+  (parent get-component-parent set-component-parent!)
+  (attributes get-component-attributes))
+(export children type)
+
+;; TODO should this also update the parent
+(define-public parent
+  (make-procedure-with-setter
+   get-component-parent set-component-parent!))
+
+(define*-public (make-vcomponent #:optional (type 'VIRTUAL))
+  (make-vcomponent% type '() #f (make-hash-table)))
+
+(define-public (add-child! parent child)
+  (set-component-children! parent (cons child (children parent)))
+  (set-component-parent! child parent))
+
+(define* (get-attribute-value component key #:optional default)
+  (cond [(hashq-ref (get-component-attributes component)
+                    key #f)
+         => get-vline-value]
+        [else default]))
+
+(define (get-attribute component key)
+  (hashq-ref (get-component-attributes component)
+             key))
+
+(define (set-attribute! component key value)
+  (let ((ht (get-component-attributes component)))
+   (cond [(hashq-ref ht key #f)
+          => (lambda (vline) (set-vline-value! vline value))]
+         [else (hashq-set! ht key (make-vline value))])))
+
+(define-public (set-vline! component key vline)
+  (hashq-set! (get-component-attributes component)
+              key vline))
+
+
 
 ;; vline → value
 (define-public value
@@ -57,30 +100,20 @@
 ;; Returns the properties of attribute as an assoc list.
 ;; @code{(map car <>)} leads to available properties.
 (define-public (properties attrptr)
-  (hash-map->list cons (get-attribute-parameters attrptr)))
-
-(define-public type (make-procedure-with-setter
-                     (lambda (c) (component-type c))
-                     (lambda (c v) ; struct-set! c 0 v
-                       (format (current-error-port)
-                               "This method is a deprecated NOOP"))))
-
-(define-public parent get-component-parent)
+  (hash-map->list cons (get-vline-parameters attrptr)))
 
 (define-public (attributes component)
   (map car (hash-map->list cons (get-component-attributes component))))
 
-(define*-public children get-component-children)
-
 (define (copy-vline vline)
   (make-vline (get-vline-value vline)
               ;; TODO deep-copy on properties?
               (get-vline-parameters vline)))
 
 (define-public (copy-vcomponent component)
-  (make-vcomponent% (component-type component)
-                    (get-component-children component)
-                    (get-component-parent component)
+  (make-vcomponent% (type component)
+                    (children component)
+                    (parent component)
                     ;; attributes
                     (alist->hashq-table
                      (hash-map->list (lambda (key value) (cons key (copy-vline value)))
diff --git a/module/vcomponent/parse.scm b/module/vcomponent/parse.scm
index 46a256a1..40e5a141 100644
--- a/module/vcomponent/parse.scm
+++ b/module/vcomponent/parse.scm
@@ -1,83 +1,16 @@
-
 (define-module (vcomponent parse)
   :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)))
-
-
+  :use-module ((ice-9 ftw) :select (scandir ftw))
 
-(define-record-type <vline>
-  (make-vline% value parameters)
-  vline?
-  (value get-vline-value set-vline-value!)
-  (parameters get-vline-parameters))
-
-(define* (make-vline value #:optional ht)
-  (make-vline% value (or ht (make-hash-table))))
-
-(define-record-type <vcomponent>
-  (make-vcomponent% type children parent attributes)
-  vcomponent?
-  (type component-type)
-  (children get-component-children set-component-children!)
-  (parent get-component-parent set-component-parent!)
-  (attributes get-component-attributes))
-
-(define* (make-vcomponent #:optional (type 'VIRTUAL))
-  (make-vcomponent% type '() #f (make-hash-table #x10)))
-
-(define (add-child! parent child)
-  (set-component-children! parent (cons child (get-component-children parent)))
-  (set-component-parent! child parent))
-
-(define* (get-attribute-value component key #:optional default)
-  (cond [(hashq-ref (get-component-attributes component)
-                    key #f)
-         => get-vline-value]
-        [else default]))
-
-(define (get-attribute component key)
-  (hashq-ref (get-component-attributes component)
-             key))
-
-(define (set-attribute! component key value)
-  (let ((ht (get-component-attributes component)))
-   (cond [(hashq-ref ht key #f)
-          => (lambda (vline) (set-vline-value! vline value))]
-         [else (hashq-set! ht key (make-vline value))])))
-
-(define (set-vline! component key vline)
-  (hashq-set! (get-component-attributes component)
-              key vline))
+  :use-module (util)
+  :use-module (vcomponent base)
 
-
-
-(define-record-type <parse-ctx>
-  (make-parse-ctx% filename row col ctx line-key param-key param-table)
-  parse-ctx?
-  (filename get-filename)               ; string
-  (row get-row set-row!)                ; [0, ]
-  (col get-col set-col!)                ; [1, )
-  (ctx get-ctx set-ctx!)                ; '(key value param-name param-value escape)
-  (line-key get-line-key set-line-key!) ; string
-  (param-key get-param-key set-param-key!)       ; string
-  (param-table get-param-table set-param-table!) ; hash-map
   )
 
-(define (make-parse-ctx filename)
-  (make-parse-ctx% filename 1 0 'key
-                   #f #f (make-hash-table)))
-
-(define (increment-column! ctx)
-  (set-col! ctx (1+ (get-col ctx))))
-
-(define (increment-row! ctx)
-  (set-col! ctx 0)
-  (set-row! ctx (1+ (get-row ctx))))
-
 
 
 (define-record-type <strbuf>
@@ -119,6 +52,31 @@
 
 
 
+(define-record-type <parse-ctx>
+  (make-parse-ctx% filename row col ctx line-key param-key param-table)
+  parse-ctx?
+  (filename get-filename)               ; string
+  (row get-row set-row!)                ; [0, ]
+  (col get-col set-col!)                ; [1, )
+  (ctx get-ctx set-ctx!)                ; '(key value param-name param-value escape)
+  (line-key get-line-key set-line-key!) ; string
+  (param-key get-param-key set-param-key!)       ; string
+  (param-table get-param-table set-param-table!) ; hash-map
+  )
+
+(define (make-parse-ctx filename)
+  (make-parse-ctx% filename 1 0 'key
+                   #f #f (make-hash-table)))
+
+(define (increment-column! ctx)
+  (set-col! ctx (1+ (get-col ctx))))
+
+(define (increment-row! ctx)
+  (set-col! ctx 0)
+  (set-row! ctx (1+ (get-row ctx))))
+
+
+
 (define (fold-proc ctx c)
   ;; First extra character optionall read is to get the \n if our line
   ;; ended with \r\n. Secound read is to get the first character of the
@@ -160,8 +118,8 @@
         (with-throw-handler #t
           (lambda ()
 
-            (set-attribute! component 'X-HNH-FILENAME
-                            (get-filename ctx))
+            (set! (attr component 'X-HNH-FILENAME)
+              (get-filename ctx))
 
             (while #t
               (let ((c (get-u8 (current-input-port))))
@@ -175,12 +133,11 @@
                   ;; the setup at creation this shouldn't be a problem.
                   (break (case (get-ctx ctx)
                            [(key)             ; line ended
-                            (let ((root-component
-                                   (car (get-component-children component))))
-                              (set-component-parent! root-component #f)
+                            (let ((root-component (car (children component))))
+                              (set! (parent root-component) #f)
                               root-component)]
                            [(value)           ; still ending line
-                            (set-component-parent! component #f)
+                            (set! (parent component) #f)
                             component]
                            [else => (lambda (a)
                                       (scm-error 'wrong-type-arg "parse-break"
@@ -198,16 +155,17 @@
                               (let ((child (make-vcomponent (string->symbol str))))
                                 ;; TOOD remove this copying of attributes!!!
                                 (for-each (lambda (pair)
-                                            (set-attribute! child
-                                                            (car pair)
-                                                            (cdr pair)))
+                                            (set! (attr child (car pair))
+                                              (cdr pair)))
                                           (hash-map->list
-                                           cons (get-component-attributes component)))
+                                           cons ((@@ (vcomponent base)
+                                                     get-component-attributes)
+                                                 component)))
                                 (add-child! component child)
                                 (set! component child))]
 
                              [(eq? (get-line-key ctx) 'END)
-                              (set! component (get-component-parent component))]
+                              (set! component (parent component))]
 
                              [else
                               ;; TODO repeated keys
@@ -287,7 +245,7 @@ row ~a	column ~a	ctx = ~a
   (define st (stat path))
   (case (stat:type st)
     [(regular) (let ((comp (call-with-input-file path parse-calendar)))
-                 (set-attribute! comp 'X-HNH-SOURCETYPE "file")
+                 (set! (attribute comp 'X-HNH-SOURCETYPE) "file")
                  (list comp))]
     [(directory)
 
@@ -305,8 +263,8 @@ row ~a	column ~a	ctx = ~a
                 (let ((fullname (/ path fname)))
                   (let ((cal (call-with-input-file fullname
                                parse-calendar)))
-                    (set-attribute! cal 'COLOR color)
-                    (set-attribute! cal 'NAME name)
+                    (set! (attr cal 'COLOR) color
+                          (attr cal 'NAME) name)
                     cal)))
               (scandir path (lambda (s) (and (not (string= "." (string-take s 1)))
                                         (string= "ics" (string-take-right s 3))))))))]
@@ -314,6 +272,19 @@ row ~a	column ~a	ctx = ~a
      => (lambda (t) (error "Can't parse file of type " t))]))
 
 
+(define-public (parse-cal-path path)
+  (let ((parent (make-vcomponent)))
+    (for-each (lambda (child) (add-child! parent child))
+              (read-vcalendar path))
+    (set! (attr parent 'X-HNH-SOURCETYPE)
+      (if (null? (children parent))
+          "vdir"
+          (or (attr (car (children parent))
+                    'X-HNH-SOURCETYPE)
+              "vdir")))
+    parent))
+
+
 (define-public (read-tree path)
   (define list '())
   (ftw path
@@ -332,6 +303,3 @@ row ~a	column ~a	ctx = ~a
   ((@ (ice-9 threads) n-par-map) 12
    (lambda (fname) (call-with-input-file fname parse-calendar))
    list))
-
-
-(export add-child! make-vcomponent get-vline-value set-vline-value! get-component-parent get-component-children get-attribute-value set-attribute! get-component-attributes component-type make-vcomponent% make-vline get-vline-parameters)
-- 
cgit v1.2.3


From 63cb5445d481c2857c7ebb96434be6f7bc6cf20d Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@hornquist.se>
Date: Sun, 3 Nov 2019 14:28:56 +0100
Subject: Cleanup in parse.

---
 module/vcomponent/parse.scm | 53 +++++++++++++++++++++------------------------
 1 file changed, 25 insertions(+), 28 deletions(-)

(limited to 'module/vcomponent')

diff --git a/module/vcomponent/parse.scm b/module/vcomponent/parse.scm
index 40e5a141..78217368 100644
--- a/module/vcomponent/parse.scm
+++ b/module/vcomponent/parse.scm
@@ -117,10 +117,6 @@
             (strbuf (make-strbuf)))
         (with-throw-handler #t
           (lambda ()
-
-            (set! (attr component 'X-HNH-FILENAME)
-              (get-filename ctx))
-
             (while #t
               (let ((c (get-u8 (current-input-port))))
                 (cond
@@ -131,36 +127,37 @@
                   ;; We never check the final line here. But since it
                   ;; ALWAYS should be "END:VCOMPONENT", and we do all
                   ;; the setup at creation this shouldn't be a problem.
-                  (break (case (get-ctx ctx)
-                           [(key)             ; line ended
-                            (let ((root-component (car (children component))))
-                              (set! (parent root-component) #f)
-                              root-component)]
-                           [(value)           ; still ending line
-                            (set! (parent component) #f)
-                            component]
-                           [else => (lambda (a)
-                                      (scm-error 'wrong-type-arg "parse-break"
-                                                 (string-append
-                                                  "Bad context at end of file. "
-                                                  "Expected `key' or `value', got ~a")
-                                                 (list a) #f))]))]
+                  (let ((component
+                         (case (get-ctx ctx)
+                           ;; Line ended before we came here, get the actual root
+                           ;; component (instead of our virtual one:
+                           [(key) (car (children component))]
+                           ;; Line wasn't ended before we get here, so our current
+                           ;; component is our "actual" root.
+                           [(value) component]
+                           [else
+                            => (lambda (a)
+                                 (scm-error
+                                  'wrong-type-arg "parse-break"
+                                  (string-append
+                                   "Bad context at end of file. "
+                                   "Expected `key' or `value', got ~a")
+                                  (list a) #f))])))
+                    ;; == NOTE ==
+                    ;; This sets to the VCALENDAR, which is correct,
+                    ;; but the program later squashes together everything
+                    ;; and drops this information.
+                    (set! (attr component 'X-HNH-FILENAME) (get-filename ctx)
+                          (parent component) #f)
+                    (break component))]
 
                  ;; End of line
                  [(memv (integer->char c) '(#\return #\newline))
                   (case (fold-proc ctx c)
                     [(end-of-line)
                      (let ((str (strbuf->string strbuf)))
-                       (cond [(eq? (get-line-key ctx) 'BEGIN)
+                       (cond [(eq? 'BEGIN (get-line-key ctx))
                               (let ((child (make-vcomponent (string->symbol str))))
-                                ;; TOOD remove this copying of attributes!!!
-                                (for-each (lambda (pair)
-                                            (set! (attr child (car pair))
-                                              (cdr pair)))
-                                          (hash-map->list
-                                           cons ((@@ (vcomponent base)
-                                                     get-component-attributes)
-                                                 component)))
                                 (add-child! component child)
                                 (set! component child))]
 
@@ -245,7 +242,7 @@ row ~a	column ~a	ctx = ~a
   (define st (stat path))
   (case (stat:type st)
     [(regular) (let ((comp (call-with-input-file path parse-calendar)))
-                 (set! (attribute comp 'X-HNH-SOURCETYPE) "file")
+                 (set! (attr comp 'X-HNH-SOURCETYPE) "file")
                  (list comp))]
     [(directory)
 
-- 
cgit v1.2.3


From a7af480101881af9e007453c0003328fde89f3b1 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@hornquist.se>
Date: Sun, 3 Nov 2019 14:44:27 +0100
Subject: Move strbuf to own file.

---
 module/vcomponent/parse.scm | 42 ++----------------------------------------
 1 file changed, 2 insertions(+), 40 deletions(-)

(limited to 'module/vcomponent')

diff --git a/module/vcomponent/parse.scm b/module/vcomponent/parse.scm
index 78217368..04a06d54 100644
--- a/module/vcomponent/parse.scm
+++ b/module/vcomponent/parse.scm
@@ -1,5 +1,5 @@
 (define-module (vcomponent parse)
-  :use-module (rnrs io ports)
+  :use-module ((rnrs io ports) :select (get-u8))
   :use-module (rnrs bytevectors)
   :use-module (srfi srfi-9)
   :use-module ((ice-9 rdelim) :select (read-line))
@@ -7,50 +7,12 @@
   :use-module ((ice-9 ftw) :select (scandir ftw))
 
   :use-module (util)
+  :use-module (util strbuf)
   :use-module (vcomponent base)
-
   )
 
 
 
-(define-record-type <strbuf>
-  (make-strbuf% len bytes)
-  strbuf?
-  (len get-length set-length!)
-  (bytes get-bytes set-bytes!))
-
-(define (make-strbuf)
-  (make-strbuf% 0 (make-u8vector #x1000)))
-
-(define (strbuf-realloc! strbuf)
-  (let* ((len (u8vector-length (get-bytes strbuf)))
-         (nv (make-u8vector (ash len 1))))
-    (bytevector-copy! (get-bytes strbuf) 0
-                      nv 0 len)
-    (set-bytes! strbuf nv)))
-
-(define (strbuf->string strbuf)
-  (let ((bv (make-u8vector (get-length strbuf))))
-    (bytevector-copy! (get-bytes strbuf) 0
-                      bv 0
-                      (get-length strbuf))
-    (bytevector->string bv (native-transcoder))))  ; TODO charset
-
-(define (strbuf-reset! strbuf)
-  (set-length! strbuf 0))
-
-(define (strbuf-append! strbuf u8)
-  (catch 'out-of-range
-    (lambda ()
-     (u8vector-set! (get-bytes strbuf)
-                    (get-length strbuf)
-                    u8))
-    (lambda (err . args)
-      (strbuf-realloc! strbuf)
-      (strbuf-append! strbuf u8)))
-  (set-length! strbuf (1+ (get-length strbuf))))
-
-
 
 (define-record-type <parse-ctx>
   (make-parse-ctx% filename row col ctx line-key param-key param-table)
-- 
cgit v1.2.3