3 # Commands for the generation of JSON (Java Script Object Notation).
5 # Copyright (c) 2009-2011 Andreas Kupries <andreas_kupries@sourceforge.net>
7 # See the file "license.terms" for information on usage and redistribution
8 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
10 # RCS: @(#) $Id: json_write.tcl,v 1.2 2011/08/24 20:09:44 andreas_kupries Exp $
12 # ### ### ### ######### ######### #########
15 package require Tcl 8.5
17 namespace eval ::json::write {
19 string array object indented aligned
21 namespace ensemble create
24 # ### ### ### ######### ######### #########
27 proc ::json::write::indented {{bool {}}} {
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\""
45 proc ::json::write::aligned {{bool {}}} {
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\""
63 proc ::json::write::string {s} {
65 return "\"[::string map $quotes $s]\""
68 proc ::json::write::array {args} {
69 # always compact form.
70 return "\[[join $args ,]\]"
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.
81 if {[llength $args] %2 == 1} {
82 return -code error {wrong # args, expected an even number of arguments}
87 lappend dict [string $k] $v
91 set max [MaxKeyLength $dict]
98 set k [AlignLeft $max $k]
100 if {[::string match *\n* $v]} {
102 lappend content " $k : [Indent $v { } 1]"
105 lappend content " $k : $v"
108 if {[llength $content]} {
109 return "\{\n[join $content ,\n]\n\}"
114 # ultra compact form.
116 foreach {k v} $dict {
119 return "\{[join $tmp ,]\}"
123 # ### ### ### ######### ######### #########
126 proc ::json::write::Indent {text prefix skip} {
129 foreach line [split $text \n] {
130 if {!$skip} { set pfx $prefix } else { incr skip -1 }
131 lappend result ${pfx}$line
133 return [join $result \n]
136 proc ::json::write::MaxKeyLength {dict} {
137 # Find the max length of the keys in the dictionary.
139 set lengths 0 ; # This will be the max if the dict is empty, and
140 # prevents the mathfunc from throwing errors for
143 foreach str [dict keys $dict] {
144 lappend lengths [::string length $str]
147 return [tcl::mathfunc::max {*}$lengths]
150 proc ::json::write::AlignLeft {fieldlen str} {
151 return [format %-${fieldlen}s $str]
152 #return $str[::string repeat { } [expr {$fieldlen - [::string length $str]}]]
155 # ### ### ### ######### ######### #########
157 namespace eval ::json::write {
158 # Configuration of the layout to write.
160 # indented = boolean. objects are indented.
161 # aligned = boolean. object keys are aligned vertically.
163 # aligned => indented.
165 # Combinations of the format specific entries
167 # - - + ---------------------
168 # 0 0 | Ultracompact (no whitespace, single line)
170 # 0 1 | Not possible, per the implications above.
171 # 1 1 | Indented + vertically aligned keys
172 # - - + ---------------------
178 [list "\"" "\\\"" / \\/ \\ \\\\ \b \\b \f \\f \n \\n \r \\r \t \\t]
181 # ### ### ### ######### ######### #########
184 package provide json::write 1.0.1