moreSCM

5 files changed, 24 insertions, 11 deletions

diff --git a/module/vcomponent.scm b/module/vcomponent.scm
index d1a0abff..1bb5c264 100644
--- a/module/vcomponent.scm
+++ b/module/vcomponent.scm
@@ -40,6 +40,7 @@
        (set! (attr ev "DTSTART") (date->time-utc date)
              (attr ev "DTEND")   (date->time-utc end-date))
 
+       #;
        (when (prop (attr* ev 'DTSTART) 'TZID)
          (set! (zone-offset date) (get-tz-offset ev)
                (attr ev 'DTSTART) (date->time-utc date)
@@ -65,9 +66,9 @@
    component
    (as-symb attr)))
 
-(define (set-attr! component attr value)
-  (set! (car (get-attr component (as-string attr)))
-        value))
+;; (define (set-attr! component attr value)
+;;   (set! (car (get-attr component (as-string attr)))
+;;         value))
 
 (define-public value caar)
 (define-public next cdr)
@@ -87,11 +88,14 @@
 (define-public attr* get-attr)
 
 (define (get-first c a)
-  (and=> (car (get-attr c a)) car))
+  (and=> (get-attr c a) caar))
 
 (define (set-first! c a v)
-  (and=> (car (get-attr c a))
-         (lambda (f) (set! (car f) v))))
+  (let ((g (get-attr c a)))
+    (if g
+        (set! (caar g) v)
+        (hashq-set! (%vcomponent-get-hash-table c)
+                    a (list (cons v (make-hash-table)))))))
 
 (define-public attr
   (make-procedure-with-setter
diff --git a/module/vcomponent/primitive.scm b/module/vcomponent/primitive.scm
index 53d73652..433e31ed 100644
--- a/module/vcomponent/primitive.scm
+++ b/module/vcomponent/primitive.scm
@@ -13,6 +13,8 @@
 
             %vcomponent-get-attribute
             %vcomponent-attribute-list
+            %vcomponent-get-hash-table
+
 
             %vcomponent-shallow-copy))
 
diff --git a/module/vcomponent/timezone.scm b/module/vcomponent/timezone.scm
index 5b262f1c..1498639c 100644
--- a/module/vcomponent/timezone.scm
+++ b/module/vcomponent/timezone.scm
@@ -81,7 +81,7 @@
                   (and (time<=? start (attr ev 'DTSTART))
                        (time<? (attr ev 'DTSTART) end))))
               (attr (find-tz (parent ev)
-                             (car (prop (attr* ev 'DTSTART) 'TZID)))
+                             (prop (attr* ev 'DTSTART) 'TZID))
                     'X-HNH-TZSET))))
     (if (not ret)
         0 (parse-offset (attr (car ret) 'TZOFFSETTO)))))
diff --git a/src/parse.c b/src/parse.c
index cd64e192..71272998 100644
--- a/src/parse.c
+++ b/src/parse.c
@@ -160,7 +160,7 @@ int handle_kv (
 		/* key \in { VCALENDAR, VEVENT, VALARM, VTODO, VTIMEZONE, ...  } */
 
 		NEW(vcomponent, e,
-				ctx->str.mem,
+				val->mem,
 				ctx->filename);
 
 		SCM_PUSH_X(ctx->key_stack, scm_string_to_symbol(scm_from_utf8_stringn(ctx->str.mem, ctx->str.len)));
diff --git a/src/vcal.c b/src/vcal.c
index 208a47a9..1df528f4 100644
--- a/src/vcal.c
+++ b/src/vcal.c
@@ -142,9 +142,6 @@ int DEEP_COPY(vcomponent)(vcomponent* a, vcomponent* b) {
 
 // TODO
 int vcomponent_copy(vcomponent* dest, vcomponent* src) {
-	ERR("Deep copy not implemented for vcomponent");
-	(void) dest;
-	(void) src;
 
 #if 0
 	DEEP_COPY(TRIE(content_line))(&dest->clines, &src->clines);
@@ -156,6 +153,16 @@ int vcomponent_copy(vcomponent* dest, vcomponent* src) {
 
 	PUSH(vcomponent)(src->parent, dest);
 #endif
+	SCM proc = scm_c_eval_string("(lambda (dest) (lambda (k v) (hashq-set! dest k v)))");
+	SCM iproc = scm_call_1 (proc, dest->clines);
+	scm_hash_for_each (iproc, src->clines);
+
+	SCM lst = src->components;
+	while (! scm_is_null (lst)) {
+		PUSH(vcomponent)(dest, scm_to_vcomponent(SCM_CAR(lst)));
+	}
+
+	PUSH(vcomponent)(src->parent, dest);
 
 	return 0;
 }