Posted to tcl by evilotto at Fri Sep 08 20:53:16 GMT 2017view raw

  1. package require rl_json
  2.  
  3. namespace eval ::jsb {
  4.  
  5. variable current {}
  6. variable ctx {}
  7.  
  8. proc build {script} {
  9. variable current
  10.  
  11. set current {}
  12. set cpath [uplevel namespace path]
  13. uplevel [list namespace path [list {*}$cpath ::jsb]]
  14. ctx val val $script
  15. uplevel [list namespace path $cpath]
  16. try {
  17. set json [rl_json::json new {*}[lindex $current 0]]
  18. } on error e {
  19. puts "$e trying to format \n\t$current"
  20. }
  21.  
  22. return $json
  23. }
  24.  
  25. proc ctx {req cur script} {
  26. variable ctx
  27. set cc [lindex $ctx end]
  28. if {$cc ne $req} {
  29. error "invalid context for $cur (is $cc, needs $req)"
  30. }
  31. if {$cur ne "-"} {
  32. lappend ctx $cur
  33. uplevel 2 $script
  34. set ctx [lrange $ctx 0 end-1]
  35. } else {
  36. uplevel 1 $script
  37. }
  38. }
  39.  
  40. proc Obj {script} {
  41. variable current
  42. set cval $current
  43. set current {}
  44. ctx val obj $script
  45. set current [list {*}$cval [list object {*}$current]]
  46. }
  47.  
  48. proc Entry {k script} {
  49. variable current
  50. set cval $current
  51. set current {}
  52. ctx obj val $script
  53. set current [list {*}$cval $k {*}$current]
  54. }
  55.  
  56. proc Array {script} {
  57. variable current
  58. set cval $current
  59. set current {}
  60. ctx val val $script
  61. set current [list {*}$cval [list array {*}$current]]
  62. }
  63.  
  64. proc Null {} {
  65. variable current
  66. ctx val - {lappend current null}
  67. }
  68. proc Number {v} {
  69. variable current
  70. ctx val - {lappend current [list number $v]}
  71. }
  72. proc String {s} {
  73. variable current
  74. ctx val - {lappend current [list string $s]}
  75. }
  76. }
  77.  
  78.  
  79.  
  80. ### usage ###
  81.  
  82. puts [jsb::build {
  83. Obj {
  84. Entry woo {String baz}
  85. Entry zoo {
  86. Array {
  87. Null
  88. Obj {
  89. Entry a {Null}
  90. for {set a 0} {$a < 10} {incr a} {
  91. Entry "a$a" {Number $a}
  92. }
  93. }
  94. }
  95. }
  96. }
  97. }]
  98.  
  99. ### results in:
  100. # {"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}]}
  101.  
  102.  
  103.