diff options
author | Hugo Hörnquist <hugo@lysator.liu.se> | 2023-12-01 21:27:41 +0100 |
---|---|---|
committer | Hugo Hörnquist <hugo@lysator.liu.se> | 2023-12-01 23:15:01 +0100 |
commit | 8795fd45974d1969db9ec155730155a7e89e5469 (patch) | |
tree | f0f5eda2a2ffb7d95fbf40d2dcf850d6cae214af /module/vcomponent/base.scm | |
parent | Add printer for tables. (diff) | |
download | calp-8795fd45974d1969db9ec155730155a7e89e5469.tar.gz calp-8795fd45974d1969db9ec155730155a7e89e5469.tar.xz |
Improve output format for vcomponents.
A stantdalone vline is now it's own constructor, and includes its
parameters.
Complete vcomponents instead serialize vlines to the vcomponent create
syntax, which sometimes hides the existance of a vline completely.
Diffstat (limited to 'module/vcomponent/base.scm')
-rw-r--r-- | module/vcomponent/base.scm | 38 |
1 files changed, 31 insertions, 7 deletions
diff --git a/module/vcomponent/base.scm b/module/vcomponent/base.scm index 39b2c810..d21f785d 100644 --- a/module/vcomponent/base.scm +++ b/module/vcomponent/base.scm @@ -8,6 +8,7 @@ :use-module (hnh util lens) :use-module (hnh util table) :use-module (hnh util uuid) + :use-module ((hnh util exceptions) :select (unreachable)) :export (vline vline? vline-value @@ -58,12 +59,17 @@ ;;; emit something which allows the serialized vcomponent to be ;;; fed back into the parser to get the object back. (define (print-vline v p) - (format p "#<<vline> key: ~s value: ~s parameters: ~s>" - (key v) - (vline-value v) - #f - ;; (hash-map->list list (get-vline-parameters v)) - )) + ((@ (ice-9 pretty-print) pretty-print) + `(vline key: ,(key v) + vline-value: ,(vline-value v) + ,@(let ((params (table->list (vline-parameters v)))) + (if (null? params) + '() + `(vline-parameters: + ,(concatenate (for (key . value) in params + `(,(symbol->keyword key) + ,value))))))) + p)) (define-type (vline printer: print-vline) ;; TODO why does vline contain its own key? @@ -72,6 +78,17 @@ (vline-parameters default: (table) type: table?) (vline-source default: "" type: string?)) +(define (serialize-vline line) + (let ((parameters + (table->list (vline-parameters line)))) + (if (null? parameters) + (vline-value line) + `(with-parameters + ,@(concatenate (for (key . value) in parameters + `(,(symbol->keyword key) + ,value))) + ,(vline-value line))))) + (define (serialize-vcomponent c) (let ((children (table->list (vcomponent-children c)))) `(vcomponent ',(type c) @@ -80,7 +97,14 @@ (list (-> key symbol->string string-downcase string->keyword) - value))) + (cond ((list? value) + `(as-list (list + ,@(map serialize-vline value)))) + ((vline? value) (serialize-vline value)) + (else (unreachable + "serialize-vcomponent" + "Expected vline or list of vline, got ~s" + value)))))) ,@(unless (null? children) `((list ,@(map (lambda (child) (serialize-vcomponent child)) (map cdr children)))))))) |