From 124f8b42c01a440c6998a13ef13996ac1d312092 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@lysator.liu.se>
Date: Wed, 10 Apr 2019 00:51:35 +0200
Subject: Rework how attributes and properties are accessed.

Made the fact that properties belong to an attribute shine through to
scheme. This by setting the SCM field in the strbuf:ers in my
vcomponents to a pair of their old SCM value, and a hash table
representing the properties.

This also meant that the primitive set-attribute! could be replaced by a
set-car! on the pair returned by the primitive get-attribute. And that
both set- and get-property now simple works on the hash table returned
by get-attribute.

The major problem with this release was that I for a while missed that
DEEP_COPY(strbuf) now also needed to deep copy the SCM values. Without
that attributes in a copied vcomponent would be shared with the
original. This mainly lead to repeating events all being the same.
---
 module/vcalendar.scm | 56 +++++++++++++++++++++++++---------------------------
 1 file changed, 27 insertions(+), 29 deletions(-)

(limited to 'module/vcalendar.scm')

diff --git a/module/vcalendar.scm b/module/vcalendar.scm
index 12e2d9a5..a4da1527 100644
--- a/module/vcalendar.scm
+++ b/module/vcalendar.scm
@@ -28,41 +28,36 @@
         childs)))
 (export children)
 
-(define (set-attr! component attr value)
-  (%vcomponent-set-attribute!
-   component
-   (as-string attr)
-   value))
-
 (define (get-attr component attr)
   (%vcomponent-get-attribute
    component
    (as-string attr)))
 
-(define (get-property component attr prop)
-  (%vcomponent-get-property
-   component
-   (as-string attr)
-   (as-string prop)))
+(define (set-attr! component attr value)
+  (set-car! (get-attr component (as-string attr))
+            value))
 
-(define (set-property! component attr prop val)
-  (%vcomponent-set-property!
-   component
-   (as-string attr)
-   (as-string prop)
-   val))
+(define-public attr*
+  (make-procedure-with-setter
+   get-attr set-attr!))
 
-(define-public prop
+(define-public attr
   (make-procedure-with-setter
-   get-property
-   set-property!))
+   (compose car get-attr) set-attr!))
 
-(define-public (properties component attr)
-  (%vcomponent-property-list component (as-string attr)))
+;; value
+(define-public v
+  (make-procedure-with-setter car set-car!))
 
-;; Enables symmetric get and set:
-;; (set! (attr ev "KEY") 10)
-(define-public attr (make-procedure-with-setter get-attr set-attr!))
+(define-public prop
+  (make-procedure-with-setter
+   (lambda (attr-obj prop-key)
+     (hashq-ref (cdr attr-obj) prop-key))
+   (lambda (attr-obj prop-key val)
+     (hashq-set! (cdr attr-obj) prop-key val))))
+
+(define-public (properties component attr-key)
+  (hash-map->list cons (cdr (attr component (as-string attr-key)))))
 
 ;; (define-public type %vcomponent-get-type)
 (define-public type (make-procedure-with-setter
@@ -76,17 +71,20 @@
 
 (define-public filter-children! %vcomponent-filter-children!)
 
+(define-public (extract field)
+  (lambda (e) (attr e field)))
+
+(define-public (extract* field)
+  (lambda (e) (attr* e field)))
+
 (define-public (search cal term)
   (cdr (let ((events (filter (lambda (ev) (eq? 'VEVENT (type ev)))
                              (children cal))))
          (find (lambda (ev) (string-contains-ci (car ev) term))
-               (map cons (map (cut get-attr <> "SUMMARY")
+               (map cons (map (extract "SUMMARY")
                               events)
                     events)))))
 
-(define-public (extract field)
-  (cut get-attr <> field))
-
 (define-public (key=? k1 k2)
   (eq? (as-symb k1)
        (as-symb k2)))
-- 
cgit v1.2.3