1# json.tcl --
2#
3#	The JSON export plugin. Generation of 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: export_json.tcl,v 1.3 2009/11/15 05:50:03 andreas_kupries Exp $
11
12# This package is a plugin for the doctools::toc v2 system.  It takes
13# the list serialization of a table of contents and produces text in
14# JSON format.
15
16# ### ### ### ######### ######### #########
17## Requisites
18
19# @mdgen NODEP: doctools::toc::export::plugin
20
21package require Tcl 8.4
22package require doctools::toc::export::plugin ; # Presence of this
23						# pseudo package
24						# indicates execution
25						# inside of a properly
26						# initialized plugin
27						# interpreter.
28package require doctools::toc::structure      ; # Verification that
29						# the input is proper.
30package require textutil::adjust
31
32# ### ### ### ######### ######### #########
33## API.
34
35proc export {serial configuration} {
36
37    # Phase I. Check that we got a canonical toc serialization. That
38    #          makes the unpacking easier, as we can mix it with the
39    #          generation of the output, knowing that everything is
40    #          already sorted as it should be.
41
42    ::doctools::toc::structure verify-as-canonical $serial
43
44    # ### ### ### ######### ######### #########
45    # Configuration ...
46    # * Standard entries
47    #   - user   = person running the application doing the formatting
48    #   - format = name of this format
49    #   - file   = name of the file the toc came from. Optional.
50    #   - map    = maps symbolic references to actual file path. Optional.
51    # * json/format specific entries
52    #   - indented = boolean. objects indented per the toc structure.
53    #   - aligned  = boolean. object keys tabular aligned vertically.
54    #
55    # Notes
56    # * This format ignores 'map' even if set, as the written json
57    #   contains the symbolic references and only them.
58    # * aligned  => indented
59
60    # Combinations of the format specific entries
61    # N I A |
62    # - - - + ---------------------
63    # 0 0 0 | Ultracompact (no whitespace, single line)
64    # 1 0 0 | Compact (no whitespace, multiple lines)
65    # 1 1 0 | Indented
66    # 1 0 1 | Tabular aligned references
67    # 1 1 1 | Indented + Tabular aligned references
68    # - - - + ---------------------
69    # 0 1 0 | Not possible, per the implications above.
70    # 0 0 1 | ditto
71    # 0 1 1 | ditto
72    # - - - + ---------------------
73
74    # Import the configuration and initialize the internal state
75    array set config {
76	indented 0
77	aligned  0
78    }
79    array set config $configuration
80
81    # Force the implications mentioned in the notes above.
82    if {$config(aligned)} {
83	set config(indented) 1
84    }
85
86    # ### ### ### ######### ######### #########
87
88    # Phase II. Generate the output, taking the configuration into
89    #           account. We construct this from the inside out.
90
91    # Unpack the serialization.
92    array set toc $serial
93    array set toc $toc(doctools::toc)
94    unset     toc(doctools::toc)
95
96    return [JsonObject doctools::toc \
97		[JsonObject \
98		     items  [ProcessDivision $toc(items)] \
99		     label  [JsonString      $toc(label)] \
100		     title  [JsonString      $toc(title)]]]
101
102    # ### ### ### ######### ######### #########
103}
104
105proc ProcessDivision {items} {
106    upvar 1 config config
107    set result {}
108
109    foreach element $items {
110	foreach {etype edata} $element break
111	array set toc $edata
112	switch -exact -- $etype {
113	    reference {
114		set edata [JsonObject \
115			       desc  [JsonString $toc(desc)] \
116			       id    [JsonString $toc(id)] \
117			       label [JsonString $toc(label)]]
118	    }
119	    division {
120		set edata {}
121		if {[info exists toc(id)]} { lappend edata id [JsonString $toc(id)] }
122		lappend edata \
123		    items [ProcessDivision $toc(items)] \
124		    label [JsonString      $toc(label)]
125		set edata [JsonObjectDict $edata]
126	    }
127	}
128	unset toc
129	lappend result [JsonObject $etype $edata]
130    }
131
132    return [JsonArrayList $result]
133}
134
135# ### ### ### ######### ######### #########
136
137proc JsonQuotes {} {
138    return [list "\"" "\\\"" / \\/ \\ \\\\ \b \\b \f \\f \n \\n \r \\r \t \\t]
139}
140
141proc JsonString {s} {
142    return "\"[string map [JsonQuotes] $s]\""
143}
144
145proc JsonArray {args} {
146    upvar 1 config config
147    return [JsonArrayList $args]
148}
149
150proc JsonArrayList {list} {
151    # compact form.
152    return "\[[join $list ,]\]"
153}
154
155proc JsonObject {args} {
156    upvar 1 config config
157    return [JsonObjectDict $args]
158}
159
160proc JsonObjectDict {dict} {
161    # The dict maps string keys to json-formatted data. I.e. we have
162    # to quote the keys, but not the values, as the latter are already
163    # in the proper format.
164    upvar 1 config config
165
166    set tmp {}
167    foreach {k v} $dict { lappend tmp [JsonString $k] $v }
168    set dict $tmp
169
170    if {$config(aligned)} { Align $dict max }
171
172    if {$config(indented)} {
173	set content {}
174	foreach {k v} $dict {
175	    if {$config(aligned)} { set k [FmtR max $k] }
176	    if {[string match *\n* $v]} {
177		# multi-line value
178		lappend content "    $k : [textutil::adjust::indent $v {    } 1]"
179	    } else {
180		# single line value.
181		lappend content "    $k : $v"
182	    }
183	}
184	if {[llength $content]} {
185	    return "\{\n[join $content ,\n]\n\}"
186	} else {
187	    return "\{\}"
188	}
189    } else {
190	# ultra compact form.
191	set tmp {}
192	foreach {k v} $dict { lappend tmp "$k:$v" }
193	return "\{[join $tmp ,]\}"
194    }
195}
196
197proc Align {dict mv} {
198    upvar 1 $mv max
199    # Generate a list of references sortable by name, and also find the
200    # max length of all relevant names.
201    set max 0
202    foreach {str _} $dict { Max max $str }
203    return
204}
205
206proc Max {v str} {
207    upvar 1 $v max
208    set x [string length $str]
209    if {$x <= $max} return
210    set max $x
211    return
212}
213
214proc FmtR {v str} {
215    upvar 1 $v max
216    return $str[string repeat { } [expr {$max - [string length $str]}]]
217}
218
219# ### ### ### ######### ######### #########
220## Ready
221
222package provide doctools::toc::export::json 0.1
223return
224