Posted to tcl by evilotto at Fri Sep 08 20:53:16 GMT 2017view pretty
package require rl_json namespace eval ::jsb { variable current {} variable ctx {} proc build {script} { variable current set current {} set cpath [uplevel namespace path] uplevel [list namespace path [list {*}$cpath ::jsb]] ctx val val $script uplevel [list namespace path $cpath] try { set json [rl_json::json new {*}[lindex $current 0]] } on error e { puts "$e trying to format \n\t$current" } return $json } proc ctx {req cur script} { variable ctx set cc [lindex $ctx end] if {$cc ne $req} { error "invalid context for $cur (is $cc, needs $req)" } if {$cur ne "-"} { lappend ctx $cur uplevel 2 $script set ctx [lrange $ctx 0 end-1] } else { uplevel 1 $script } } proc Obj {script} { variable current set cval $current set current {} ctx val obj $script set current [list {*}$cval [list object {*}$current]] } proc Entry {k script} { variable current set cval $current set current {} ctx obj val $script set current [list {*}$cval $k {*}$current] } proc Array {script} { variable current set cval $current set current {} ctx val val $script set current [list {*}$cval [list array {*}$current]] } proc Null {} { variable current ctx val - {lappend current null} } proc Number {v} { variable current ctx val - {lappend current [list number $v]} } proc String {s} { variable current ctx val - {lappend current [list string $s]} } } ### usage ### puts [jsb::build { Obj { Entry woo {String baz} Entry zoo { Array { Null Obj { Entry a {Null} for {set a 0} {$a < 10} {incr a} { Entry "a$a" {Number $a} } } } } } }] ### results in: # {"woo":"baz","zoo":[null,{"a":null,"a0":0,"a1":1,"a2":2,"a3":3,"a4":4,"a5":5,"a6":6,"a7":7,"a8":8,"a9":9}]}