diff options
author | Hugo Hörnquist <hugo@lysator.liu.se> | 2020-08-01 20:59:27 +0200 |
---|---|---|
committer | Hugo Hörnquist <hugo@lysator.liu.se> | 2020-08-01 20:59:27 +0200 |
commit | 3239f41035319ca67205923b9a7563d8fa749c61 (patch) | |
tree | 8daf1d86d5d6d74259ffc6e9c73e96da6db985c8 | |
parent | Repair vcomponent describe. (diff) | |
download | calp-evalable.tar.gz calp-evalable.tar.xz |
Add procedures for serializing vcomponents to code for creating them.evalable
Diffstat (limited to '')
-rw-r--r-- | module/vcomponent/base.scm | 27 |
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 |