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