snippets

Check-in [29d3bcec1f]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:add tcl2json with array
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA3-256: 29d3bcec1f4ba0b6cc65d82144b0725bba8b376d48a74ce635ae8883c7b1933f
User & Date: alex 2018-08-31 11:47:34
Context
2018-09-04
10:21
german holidays; astronomical seasons check-in: 6d05098108 user: alex tags: trunk
2018-08-31
11:47
add tcl2json with array check-in: 29d3bcec1f user: alex tags: trunk
2018-08-15
14:03
tdom nodecmd examples check-in: ea9356c3c9 user: alex tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Added json/jsonwitharray.tcl.



















































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
#!/bin/sh
#\
exec tclsh8.6 "$0" "$@"

package require json
package require json::write

proc tcl2json value {
  # Guess the type of the value; deep *UNSUPPORTED* magic!
  regexp {^value is a (.*?) with a refcount} [::tcl::unsupported::representation $value] -> type

  switch $type {
    string {
      return [json::write string $value]
    }
    dict {
      return [json::write object {*}[dict map {k v} $value {tcl2json $v}]]
    }
    list {
      return [json::write array {*}[lmap v $value {tcl2json $v}]]
    }
    int - double {
      return [expr {$value}]
    }
    booleanString {
      return [expr {$value ? "true" : "false"}]
    }
    default {
      # Some other type; do some guessing...
      if {$value eq "null"} {
        # Tcl has *no* null value at all; empty strings are semantically different and absent variables aren't values. So cheat!
        return $value
      } elseif {[string is integer -strict $value]} {
        return [expr {$value}]
      } elseif {[string is double -strict $value]} {
        return [expr {$value}]
      } elseif {[string is boolean -strict $value]} {
        return [expr {$value ? "true" : "false"}]
      }
      return [json::write string $value]
    }
  }
}

set example {
  {
    "menu": {
	"id": "file",
	"value": "File:",
	"popup": {
	    "menuitem": [
		{"value": "New", "onclick": "CreateNewDoc()"},
		{"value": "Open", "onclick": "OpenDoc()"},
		{"value": "Close", "onclick": "CloseDoc()"}
	    ]
	}
    }
  }
}

puts $example
# menu {id file value File: popup {menuitem {{value New onclick CreateNewDoc()} {value Open onclick OpenDoc()} {value Close onclick CloseDoc()}}}}

puts [set d [json::json2dict $example]]
puts [tcl2json $d]

set d [dict create]
dict set d menu id file
dict set d menu value File:

set entry [dict create]
dict set entry value New
dict set entry onclick CreateNewDoc()
lappend menuitems $entry

set entry [dict create]
dict set entry value Open
dict set entry onclick OpenDoc()
lappend menuitems $entry

set entry [dict create]
dict set entry value Close
dict set entry onclick CloseDoc()
lappend menuitems $entry

dict set d menu popup menuitem $menuitems

puts $d
puts [tcl2json $d]