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 2010/03/26 05:07:24 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 if {![::string is boolean -strict $bool]} { 29 return -code error "Expected boolean, got \"$bool\"" 30 } 31 variable indented $bool 32 return 33} 34 35proc ::json::write::aligned {bool} { 36 if {![::string is boolean -strict $bool]} { 37 return -code error "Expected boolean, got \"$bool\"" 38 } 39 variable aligned $bool 40 41 if {$aligned} { 42 variable indented 1 43 } 44 return 45} 46 47proc ::json::write::string {s} { 48 variable quotes 49 return "\"[::string map $quotes $s]\"" 50} 51 52proc ::json::write::array {args} { 53 # always compact form. 54 return "\[[join $args ,]\]" 55} 56 57proc ::json::write::object {args} { 58 # The dict in args maps string keys to json-formatted data. I.e. 59 # we have to quote the keys, but not the values, as the latter are 60 # already in the proper format. 61 62 variable aligned 63 variable indented 64 65 set dict {} 66 foreach {k v} $args { 67 lappend dict [string $k] $v 68 } 69 70 if {$aligned} { 71 set max [MaxKeyLength $dict] 72 } 73 74 if {$indented} { 75 set content {} 76 foreach {k v} $dict { 77 if {$aligned} { 78 set k [AlignLeft $max $k] 79 } 80 if {[::string match *\n* $v]} { 81 # multi-line value 82 lappend content " $k : [Indent $v { } 1]" 83 } else { 84 # single line value. 85 lappend content " $k : $v" 86 } 87 } 88 if {[llength $content]} { 89 return "\{\n[join $content ,\n]\n\}" 90 } else { 91 return "\{\}" 92 } 93 } else { 94 # ultra compact form. 95 set tmp {} 96 foreach {k v} $dict { 97 lappend tmp "$k:$v" 98 } 99 return "\{[join $tmp ,]\}" 100 } 101} 102 103# ### ### ### ######### ######### ######### 104## Internals. 105 106proc ::json::write::Indent {text prefix skip} { 107 set pfx "" 108 set result {} 109 foreach line [split $text \n] { 110 if {!$skip} { set pfx $prefix } else { incr skip -1 } 111 lappend result ${pfx}$line 112 } 113 return [join $result \n] 114} 115 116proc ::json::write::MaxKeyLength {dict} { 117 # Find the max length of the keys in the dictionary. 118 119 set lengths 0 ; # This will be the max if the dict is empty, and 120 # prevents the mathfunc from throwing errors for 121 # that case. 122 123 foreach str [dict keys $dict] { 124 lappend lengths [::string length $str] 125 } 126 127 return [tcl::mathfunc::max {*}$lengths] 128} 129 130proc ::json::write::AlignLeft {fieldlen str} { 131 return [format %-${fieldlen}s $str] 132 #return $str[::string repeat { } [expr {$fieldlen - [::string length $str]}]] 133} 134 135# ### ### ### ######### ######### ######### 136 137namespace eval ::json::write { 138 # Configuration of the layout to write. 139 140 # indented = boolean. objects are indented. 141 # aligned = boolean. object keys are aligned vertically. 142 143 # aligned => indented. 144 145 # Combinations of the format specific entries 146 # I A | 147 # - - + --------------------- 148 # 0 0 | Ultracompact (no whitespace, single line) 149 # 1 0 | Indented 150 # 0 1 | Not possible, per the implications above. 151 # 1 1 | Indented + vertically aligned keys 152 # - - + --------------------- 153 154 variable indented 1 155 variable aligned 1 156 157 variable quotes \ 158 [list "\"" "\\\"" / \\/ \\ \\\\ \b \\b \f \\f \n \\n \r \\r \t \\t] 159} 160 161# ### ### ### ######### ######### ######### 162## Ready 163 164package provide json::write 1 165return 166