Add procedures for serializing vcomponents to code for creating them.evalable

1 files changed, 27 insertions, 0 deletions

diff --git a/module/vcomponent/base.scm b/module/vcomponent/base.scm
index 3e75e566..8e81ec54 100644
--- a/module/vcomponent/base.scm
+++ b/module/vcomponent/base.scm
@@ -41,6 +41,12 @@
            (get-vline-value v)
            (hash-map->list list (get-vline-parameters v)))))
 
+(define (vline->code v)
+  `(make-vline (quote ,(vline-key v))
+               (quote ,(get-vline-value v))
+               (alist->hashq-table
+                (quote ,(parameters v)))))
+
 (define-public vline-source
   (make-procedure-with-setter
    get-source set-source!))
@@ -65,6 +71,27 @@
            (length (children c))
            (and=> (get-component-parent c) type))))
 
+(define-public (vcomponent->code c)
+  `(let ((component
+          ((@@ (vcomponent base) make-vcomponent%)
+           (quote ,(type c))
+           '()
+           ;; (list ,@(children c))
+           #f
+           (alist->hashq-table
+            (list
+             ,@(map (lambda (p)
+                      `(cons (quote ,(car p))
+                             ,(if (list? (cdr p))
+                                  `(list ,@(map vline->code (cdr p)))
+                                  (vline->code (cdr p)))))
+                    (properties c)))))))
+     ,@(map (lambda (child)
+             `(add-child! component ,(vcomponent->code child)))
+            (children c))
+     component))
+
+
 ;; TODO should this also update the parent
 (define-public parent
   (make-procedure-with-setter