1# json_write.tcl -- 2# 3# Commands for the generation of JSON (Java Script Object Notation). 4# 5# Copyright (c) 2009 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.1 2009/11/25 04:41:01 andreas_kupries Exp $ 11 12# ### ### ### ######### ######### ######### 13## Requisites 14 15package require Tcl 8.5 16 17namespace eval ::json::write { 18 namespace export \ 19 string array object indented aligned 20 21 namespace ensemble create 22} 23 24# ### ### ### ######### ######### ######### 25## API. 26 27proc ::json::write::indented {{bool {}}} { 28 variable indented 29 30 if {[llength [info level]] > 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 45proc ::json::write::aligned {{bool {}}} { 46 variable aligned 47 48 if {[llength [info level]] > 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 63proc ::json::write::string {s} { 64 variable quotes 65 return "\"[::string map $quotes $s]\"" 66} 67 68proc ::json::write::array {args} { 69 # always compact form. 70 return "\[[join $args ,]\]" 71} 72 73proc ::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 126proc ::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 136proc ::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 150proc ::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 157namespace 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 184package provide json::write 1 185return 186