Slowly going through and fixing everything.

2 files changed, 75 insertions, 70 deletions

diff --git a/module/vcomponent.scm b/module/vcomponent.scm
index a106d993..93449c4b 100644
--- a/module/vcomponent.scm
+++ b/module/vcomponent.scm
@@ -82,59 +82,60 @@
 (define* (make-vcomponent #:optional path)
   (if (not path)
       (make-vcomponent)
-      (let* ((root (parse-cal-path path))
-             (component
-              (case (string->symbol (or (attr root "X-HNH-SOURCETYPE") "no-type"))
-                ;; == Single ICS file ==
-                ;; Remove the abstract ROOT component,
-                ;; returning the wanted VCALENDAR component
-                ((file)
-                 ;; TODO test this when an empty file is given.
-                 (car (children root)))
-
-                ;; == Assume vdir ==
-                ;; Also removes the abstract ROOT component, but also
-                ;; merges all VCALENDAR's children into the a newly
-                ;; created VCALENDAR component, and return that component.
-                ;;
-                ;; TODO the other VCALENDAR components might not get thrown away,
-                ;; this since I protect them from the GC in the C code.
-                ((vdir)
-                 (let ((accum (make-vcomponent))
-                       (ch (children root)))
-                   (set! (type accum) "VCALENDAR")
-
-                   (unless (null? ch)
-                    (for key in (attributes (car ch))
-                         (set! (attr accum key) (attr (car ch) key))))
-
-                   (for cal in ch
-                        (for component in (children cal)
-                             (case (type component)
-                               ((VTIMEZONE)
-                                (unless (find (lambda (z)
-                                                (string=? (attr z "TZID")
-                                                          (attr component "TZID")))
-                                              (children accum 'VTIMEZONE))
-                                  (push-child! accum component)))
-                               (else (push-child! accum component)))))
-                   ;; return
-                   accum))
-
-                ((no-type) (throw 'no-type))
-
-                (else (throw 'something)))))
-
-        (parse-dates! component)
-
-        (unless (attr component "NAME")
-          (set! (attr component "NAME")
-                (or (attr component "X-WR-CALNAME")
-                    (attr root      "NAME"))))
-
-        (unless (attr component "COLOR")
-          (set! (attr component "COLOR")
-                (attr root      "COLOR")))
-
-        ;; return
-        component)))
+      (let ((root (parse-cal-path path)))
+        (format #t "root = ~a~%" root )
+        (let* ((component
+                      (case (string->symbol (or (attr root "X-HNH-SOURCETYPE") "no-type"))
+                        ;; == Single ICS file ==
+                        ;; Remove the abstract ROOT component,
+                        ;; returning the wanted VCALENDAR component
+                        ((file)
+                         ;; TODO test this when an empty file is given.
+                         (display "Hello\n")
+                         (car (children root)))
+
+                        ;; == Assume vdir ==
+                        ;; Also removes the abstract ROOT component, but also
+                        ;; merges all VCALENDAR's children into the a newly
+                        ;; created VCALENDAR component, and return that component.
+                        ;;
+                        ;; TODO the other VCALENDAR components might not get thrown away,
+                        ;; this since I protect them from the GC in the C code.
+                        ((vdir)
+                         (let ((accum (make-vcomponent))
+                               (ch (children root)))
+                           (set! (type accum) "VCALENDAR")
+
+                           (unless (null? ch)
+                             (for key in (attributes (car ch))
+                                  (set! (attr accum key) (attr (car ch) key))))
+
+                           (for cal in ch
+                                (for component in (children cal)
+                                     (case (type component)
+                                       ((VTIMEZONE)
+                                        (unless (find (lambda (z)
+                                                        (string=? (attr z "TZID")
+                                                                  (attr component "TZID")))
+                                                      (children accum 'VTIMEZONE))
+                                          (push-child! accum component)))
+                                       (else (push-child! accum component)))))
+                           ;; return
+                           accum))
+
+                        ((no-type) (throw 'no-type)))))
+
+                (display "Here?\n")
+                (parse-dates! component)
+
+                (unless (attr component "NAME")
+                  (set! (attr component "NAME")
+                    (or (attr component "X-WR-CALNAME")
+                        (attr root      "NAME"))))
+
+                (unless (attr component "COLOR")
+                  (set! (attr component "COLOR")
+                    (attr root      "COLOR")))
+
+                ;; return
+                component))))
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)))