Commit | Line | Data |
458402ad |
1 | # json_write.tcl -- |
2 | # |
3 | # Commands for the generation of JSON (Java Script Object Notation). |
4 | # |
5 | # Copyright (c) 2009-2011 Andreas Kupries <andreas_kupries@sourceforge.net> |
6 | # |
7 | # See the file "license.terms" for information on usage and redistribution |
8 | # of this file, and for a DISCLAIMER OF ALL WARRANTIES. |
9 | # |
10 | # RCS: @(#) $Id: json_write.tcl,v 1.2 2011/08/24 20:09:44 andreas_kupries Exp $ |
11 | |
12 | # ### ### ### ######### ######### ######### |
13 | ## Requisites |
14 | |
15 | package require Tcl 8.5 |
16 | |
17 | namespace eval ::json::write { |
18 | namespace export \ |
19 | string array object indented aligned |
20 | |
21 | namespace ensemble create |
22 | } |
23 | |
24 | # ### ### ### ######### ######### ######### |
25 | ## API. |
26 | |
27 | proc ::json::write::indented {{bool {}}} { |
28 | variable indented |
29 | |
30 | if {[llength [info level 0]] > 2} { |
31 | return -code error {wrong # args: should be "json::write indented ?bool?"} |
32 | } elseif {[llength [info level 0]] == 2} { |
33 | if {![::string is boolean -strict $bool]} { |
34 | return -code error "Expected boolean, got \"$bool\"" |
35 | } |
36 | set indented $bool |
37 | if {!$indented} { |
38 | variable aligned 0 |
39 | } |
40 | } |
41 | |
42 | return $indented |
43 | } |
44 | |
45 | proc ::json::write::aligned {{bool {}}} { |
46 | variable aligned |
47 | |
48 | if {[llength [info level 0]] > 2} { |
49 | return -code error {wrong # args: should be "json::write aligned ?bool?"} |
50 | } elseif {[llength [info level 0]] == 2} { |
51 | if {![::string is boolean -strict $bool]} { |
52 | return -code error "Expected boolean, got \"$bool\"" |
53 | } |
54 | set aligned $bool |
55 | if {$aligned} { |
56 | variable indented 1 |
57 | } |
58 | } |
59 | |
60 | return $aligned |
61 | } |
62 | |
63 | proc ::json::write::string {s} { |
64 | variable quotes |
65 | return "\"[::string map $quotes $s]\"" |
66 | } |
67 | |
68 | proc ::json::write::array {args} { |
69 | # always compact form. |
70 | return "\[[join $args ,]\]" |
71 | } |
72 | |
73 | proc ::json::write::object {args} { |
74 | # The dict in args maps string keys to json-formatted data. I.e. |
75 | # we have to quote the keys, but not the values, as the latter are |
76 | # already in the proper format. |
77 | |
78 | variable aligned |
79 | variable indented |
80 | |
81 | if {[llength $args] %2 == 1} { |
82 | return -code error {wrong # args, expected an even number of arguments} |
83 | } |
84 | |
85 | set dict {} |
86 | foreach {k v} $args { |
87 | lappend dict [string $k] $v |
88 | } |
89 | |
90 | if {$aligned} { |
91 | set max [MaxKeyLength $dict] |
92 | } |
93 | |
94 | if {$indented} { |
95 | set content {} |
96 | foreach {k v} $dict { |
97 | if {$aligned} { |
98 | set k [AlignLeft $max $k] |
99 | } |
100 | if {[::string match *\n* $v]} { |
101 | # multi-line value |
102 | lappend content " $k : [Indent $v { } 1]" |
103 | } else { |
104 | # single line value. |
105 | lappend content " $k : $v" |
106 | } |
107 | } |
108 | if {[llength $content]} { |
109 | return "\{\n[join $content ,\n]\n\}" |
110 | } else { |
111 | return "\{\}" |
112 | } |
113 | } else { |
114 | # ultra compact form. |
115 | set tmp {} |
116 | foreach {k v} $dict { |
117 | lappend tmp "$k:$v" |
118 | } |
119 | return "\{[join $tmp ,]\}" |
120 | } |
121 | } |
122 | |
123 | # ### ### ### ######### ######### ######### |
124 | ## Internals. |
125 | |
126 | proc ::json::write::Indent {text prefix skip} { |
127 | set pfx "" |
128 | set result {} |
129 | foreach line [split $text \n] { |
130 | if {!$skip} { set pfx $prefix } else { incr skip -1 } |
131 | lappend result ${pfx}$line |
132 | } |
133 | return [join $result \n] |
134 | } |
135 | |
136 | proc ::json::write::MaxKeyLength {dict} { |
137 | # Find the max length of the keys in the dictionary. |
138 | |
139 | set lengths 0 ; # This will be the max if the dict is empty, and |
140 | # prevents the mathfunc from throwing errors for |
141 | # that case. |
142 | |
143 | foreach str [dict keys $dict] { |
144 | lappend lengths [::string length $str] |
145 | } |
146 | |
147 | return [tcl::mathfunc::max {*}$lengths] |
148 | } |
149 | |
150 | proc ::json::write::AlignLeft {fieldlen str} { |
151 | return [format %-${fieldlen}s $str] |
152 | #return $str[::string repeat { } [expr {$fieldlen - [::string length $str]}]] |
153 | } |
154 | |
155 | # ### ### ### ######### ######### ######### |
156 | |
157 | namespace eval ::json::write { |
158 | # Configuration of the layout to write. |
159 | |
160 | # indented = boolean. objects are indented. |
161 | # aligned = boolean. object keys are aligned vertically. |
162 | |
163 | # aligned => indented. |
164 | |
165 | # Combinations of the format specific entries |
166 | # I A | |
167 | # - - + --------------------- |
168 | # 0 0 | Ultracompact (no whitespace, single line) |
169 | # 1 0 | Indented |
170 | # 0 1 | Not possible, per the implications above. |
171 | # 1 1 | Indented + vertically aligned keys |
172 | # - - + --------------------- |
173 | |
174 | variable indented 1 |
175 | variable aligned 1 |
176 | |
177 | variable quotes \ |
178 | [list "\"" "\\\"" / \\/ \\ \\\\ \b \\b \f \\f \n \\n \r \\r \t \\t] |
179 | } |
180 | |
181 | # ### ### ### ######### ######### ######### |
182 | ## Ready |
183 | |
184 | package provide json::write 1.0.1 |
185 | return |