<?
	package require sha1

	load_response args

	proc normalize_platform {platform platform_names} {
		set platform [string tolower $platform]
		if {$platform in $platform_names} {
			return $platform
		}

		set platform [regsub {[-]x86_64$} $platform {-amd64}]
		set platform [regsub {[-]sun4[muv]$} $platform {-sparc}]
		if {$platform in $platform_names} {
			return $platform
		}
	}

	proc versionEncoded {versionString} {
		set output 0

		if {$versionString eq "trunk"} {
			return [versionEncoded "255.255.255"]
		}

		return $output
	}

	set sourcedir "/web/rkeene/devel/kitcreator/all"
	set queue "/home/rkeene/devel/kitcreator/build/web/queue"
	set secretfile "/home/rkeene/etc/kitcreator-web-secret"

	# KitCreator Versions
	foreach file [glob -tails -nocomplain -directory $sourcedir "kitcreator-*.tar.gz"] {
		regexp {^kitcreator-(.*).tar.gz$} $file -> vers
		set kitcreator_versions($vers) $vers
	}
	set kitcreator_version_selected [lindex [lsort -dictionary [array names kitcreator_versions]] end]

	set kitcreator_versions(trunk) "Fossil Trunk Tip"

	# Tcl Versions
	set tcl_versions(8.5.15) 8.5.15
	set tcl_versions(8.5.16) 8.5.16
	set tcl_versions(8.5.17) 8.5.17
	set tcl_versions(8.5.18) 8.5.18
	set tcl_versions(8.5.19) 8.5.19
	set tcl_versions(8.6.1) 8.6.1
	set tcl_versions(8.6.2) 8.6.2
	set tcl_versions(8.6.3) 8.6.3
	set tcl_versions(8.6.4) 8.6.4
	set tcl_versions(8.6.5) 8.6.5
	set tcl_versions(8.6.6) 8.6.6
	set tcl_versions(8.6.7) 8.6.7
	set tcl_versions(8.6.8) 8.6.8
	set tcl_versions(8.6.9) 8.6.9
	set tcl_versions(fossil_trunk) "Fossil Trunk Tip"

	set tcl_version_list [lsort -dictionary [array names tcl_versions]]
	set tcl_version_selected [lindex $tcl_version_list end-1]

	# Platforms
	set platforms(android-arm) "Android/ARM"
	set platforms(freebsd-amd64) "FreeBSD/amd64"
	set platforms(hpux-hppa64) "HP-UX/PA-RISC 2.0"
	set platforms(aix-ppc) "AIX/POWER"
	set platforms(linux-amd64) "Linux/amd64"
	set platforms(linux-amd64-static) "Linux/amd64 (static)"
	set platforms(linux-arm) "Linux/ARM"

	set packages(nsf) "Next Scripting Framework"
	set packages(tdom) "tDOM"
	set packages(tuapi) "Tcl UNIX API"
	set packages(lmdb) "LMDB"
	set packages(tclcurl) "cURL"
	set packages(duktape) "Duktape"

	set options_info(threaded) "Kit: Threaded"
	set options_info(kitdll) "Kit: Build Library (KitDLL)"
	set options_info(debug) "Kit: Debugging Build"
	set options_info(dynamictk) "Kit: Always link Tk dynamically (if Tk is built)"
	set options_info(minbuild) "Kit: \"Minimal\" build (remove extra packages shipped as part of Tcl and reduce encodings)"
	set options_info(staticlibssl) "TLS: Statically link to LibSSL"
	set options_info(buildlibssl) "TLS: Build LibreSSL for this platform"
	set options_info(staticpkgs) "Kit: Statically link packages in pkgs directory"
	set options_info(tclutfmax6) "Kit: TCL_UTF_MAX=6 (incompatibility with standard Tcl)"

	set disable {
		platform linux-mipsel {package_tk package_tcc4tcl package_tclx kitdll}
		platform android-arm {package_tk package_tclx}
		platform freebsd-amd64 {package_tuapi}
		platform hpux-hppa64 {package_tuapi}
		platform aix-ppc {package_tuapi kitdll}
		platform netbsd-amd64 {package_tk package_tcc4tcl package_tclx package_tuapi}

	set specific {
		platform win32 file icon {Kit Icon}
		platform win32 text description {Description}
		platform win64 file icon {Kit Icon}
		platform win64 text description {Description}
	}

	if {[info exists args(dict)] || [info exists args(json)]} {
		package require json
		package require json::write
	}

	if {[info exists args(json)]} {
		set args(dict) [::json::json2dict $args(json)]
		unset args(json)
		set apiReturnFormat json
	}

	set resultIsAPI false
	if {[info exists args(dict)]} {
		headers set "Access-Control-Allow-Origin" "*"
		if {![info exists apiReturnFormat]} {
			set apiReturnFormat dict
		}

		set apiMethod build
		catch {
			set apiMethod [dict get $args(dict) action]
		}

		switch -exact -- $apiMethod {
			build {
				# Do nothing, handled below
			}
			platforms {
				set apiResultDict [array get platforms]
			}
			tcl_versions {
				set apiResultDict [array get tcl_versions]
				dict set apiResultDict default $tcl_version_selected
			}
			kitcreator_versions {
				set apiResultDict [array get kitcreator_versions]
				dict set apiResultDict default $kitcreator_version_selected
			}
			options {
				set apiResultDict [array get options_info]
			}
			packages {
				set apiResultDict [array get packages]
			}
			help {
				set apiResultDict {
					build {Build a TclKit.  Accepts arguments: platform [mandatory, string], tcl_version [string], kitcreator_version [string], storage [string, one of mk4, cvfs, zip], options [array], packages [array]}
					platforms {Get a list of platforms to use as the "platform" argument to build}
					tcl_versions {Get a list of Tcl versions and their descriptions to use as the "tcl_version" argument to build}
					kitcreator_versions {Get a list of KitCreator versions and their descriptions to use as the "kitcreator_version" argument to build}
					options {Get a list of options and their descriptions}
					packages {Get a list of packages and their descriptions}
					examples {A few examples}
					help {This help}
				}
			}
			examples {
				set apiResultDict {
					simple {curl -d 'json={"action": "build", "platform": "linux-amd64"}' http://kitcreator.rkeene.org/kitcreator}
				}
			}
			default {
				set apiResultDict [dict create error "Invalid action \"$apiMethod\""]
			}
		}

		if {$apiMethod eq "build" && ![dict exists $args(dict) platform]} {
			set apiMethod error
			set apiResultDict [dict create error "The argument \"platform\" must be supplied when building"]
		}

		if {$apiMethod ne "build"} {
			if {[dict exists $apiResultDict error]} {
				headers numeric 500
			}

			switch -exact -- $apiReturnFormat {
				"json" {
					headers type application/json

					set apiResultDictEncoded [list]
					foreach {key value} $apiResultDict {
						lappend apiResultDictEncoded $key [json::write string $value]
					}
					set apiResultJSON [json::write object {*}$apiResultDictEncoded]
					puts $apiResultJSON
				}
				"dict" {
					headers type text/plain
					
					puts [dict create {*}$apiResultDict]
				}
			}

			rivet_flush
			abort_page
		}

		set resultIsAPI true
		set args(platform) [dict get $args(dict) platform]
		set args(tcl_version) $tcl_version_selected
		set args(kitcreator_version) $kitcreator_version_selected

		foreach arg {tcl_version kitcreator_version option_storage} {
			set dictArg $arg
			switch -exact -- $arg {
				option_storage {
					set dictArg "storage"
				}
			}

			catch {
				set args($arg) [dict get $args(dict) $dictArg]
			}
		}

		set selectedPackages [list]
		catch {
			set selectedPackages [dict get $args(dict) packages]
		}
		foreach arg $selectedPackages {
			set args(option_package_$arg) true
		}

		set selectedOptions [list]
		catch {
			set selectedOptions [dict get $args(dict) options]
		}
		foreach arg $selectedOptions {
			switch -glob -- $arg {
				"package_*" {
					continue
				}
			}

			set args(option_$arg) true
		}
	}

	if {[info exists args(platform)] && [info exists args(tcl_version)] && [info exist args(kitcreator_version)]} {
		# Read in arguments
		## Mandatory arguments
		set build_platform $args(platform)
		set build_platform [normalize_platform $args(platform) [array names platforms]]
		set build_tcl_version $args(tcl_version)
		set build_kitcreator_version $args(kitcreator_version)

		if {$build_tcl_version eq "default"} {
			set build_tcl_version $tcl_version_selected
		}

		if {$build_kitcreator_version eq "default"} {
			set build_kitcreator_version $kitcreator_version_selected
		}

		## Optional Arguments
		set build_packages [list]
		set build_options(threaded) 0
		set build_options(kitdll) 0
		set build_options(debug) 0
		set build_options(dynamictk) 0

		# Queue build up and wait for it to complete
		set fd [open $queue a+]
		puts $fd [list filename $filename key $key platform $build_platform tcl_version $build_tcl_version kitcreator_version $build_kitcreator_version packages $build_packages options [array get build_options]]
		close $fd

		set url "http://kitcreator.rkeene.org/kits/building/$key/"
		set kiturl "http://kitcreator.rkeene.org/kits/$key/$filename"

		if {!$resultIsAPI} {
		headers redirect $url
			headers redirect $url
?><html>
	<head>
		<title>KitCreator, Web Interface</title>
	</head>
	<body>
		<h1>KitCreator Web Interface</h1>
		<p>Build in progress, see <a href="<? puts -nonewline $url ?>"><? puts -nonewline $url ?></a> for build information</p>
	</body>
</html>
<?
		} else {
			switch -exact -- $apiReturnFormat {
				"json" {
					puts "{\"kit_url\": \"${kiturl}\"}"
				}
				"dict" {
					puts [dict create kit_url $kiturl]
				}
			}
		}
	} else {
?><html>
  <head>
    <title>KitCreator, Web Interface</title>
    <script>
<!--
	function enableOption(option) {

          </td>
        </tr>
        <tr>
          <td>Tcl Version:</td>
          <td>
            <select name="tcl_version" onChange="verifyOptions();">
<?
	set tcl_version_list [lsort -dictionary [array names tcl_versions]]
	set tcl_version_selected [lindex $tcl_version_list end-1]
	foreach tcl_version $tcl_version_list {
		set tcl_version_name $tcl_versions($tcl_version)

		if {$tcl_version == $tcl_version_selected} {
			set selected " selected"
		} else {
			set selected ""

# json.tcl --
#
#	JSON parser for Tcl. Management code, Tcl/C detection and selection.
#
# Copyright (c) 2013 by Andreas Kupries

# @mdgen EXCLUDE: jsonc.tcl

package require Tcl 8.4
namespace eval ::json {}

# ### ### ### ######### ######### #########
## Management of json implementations.

# ::json::LoadAccelerator --
#
#	Loads a named implementation, if possible.
#
# Arguments:
#	key	Name of the implementation to load.
#
# Results:
#	A boolean flag. True if the implementation
#	was successfully loaded; and False otherwise.

proc ::json::LoadAccelerator {key} {
    variable accel
    set r 0
    switch -exact -- $key {
	critcl {
	    # Critcl implementation of json requires Tcl 8.4.
	    if {![package vsatisfies [package provide Tcl] 8.4]} {return 0}
	    if {[catch {package require tcllibc}]} {return 0}
	    # Check for the jsonc 1.1.1 API we are fixing later.
	    set r [llength [info commands ::json::many_json2dict_critcl]]
	}
	tcl {
	    variable selfdir
	    source [file join $selfdir json_tcl.tcl]
	    set r 1
	}
        default {
            return -code error "invalid accelerator/impl. package $key:\
                must be one of [join [KnownImplementations] {, }]"
        }
    }
    set accel($key) $r
    return $r
}

# ::json::SwitchTo --
#
#	Activates a loaded named implementation.
#
# Arguments:
#	key	Name of the implementation to activate.
#
# Results:
#	None.

proc ::json::SwitchTo {key} {
    variable accel
    variable loaded
    variable apicmds

    if {[string equal $key $loaded]} {
	# No change, nothing to do.
	return
    } elseif {![string equal $key ""]} {
	# Validate the target implementation of the switch.

	if {![info exists accel($key)]} {
	    return -code error "Unable to activate unknown implementation \"$key\""
	} elseif {![info exists accel($key)] || !$accel($key)} {
	    return -code error "Unable to activate missing implementation \"$key\""
	}
    }

    # Deactivate the previous implementation, if there was any.

    if {![string equal $loaded ""]} {
	foreach c $apicmds {
	    rename ::json::${c} ::json::${c}_$loaded
	}
    }

    # Activate the new implementation, if there is any.

    if {![string equal $key ""]} {
	foreach c $apicmds {
	    rename ::json::${c}_$key ::json::${c}
	}
    }

    # Remember the active implementation, for deactivation by future
    # switches.

    set loaded $key
    return
}

# ::json::Implementations --
#
#	Determines which implementations are
#	present, i.e. loaded.
#
# Arguments:
#	None.
#
# Results:
#	A list of implementation keys.

proc ::json::Implementations {} {
    variable accel
    set res {}
    foreach n [array names accel] {
	if {!$accel($n)} continue
	lappend res $n
    }
    return $res
}

# ::json::KnownImplementations --
#
#	Determines which implementations are known
#	as possible implementations.
#
# Arguments:
#	None.
#
# Results:
#	A list of implementation keys. In the order
#	of preference, most prefered first.

proc ::json::KnownImplementations {} {
    return {critcl tcl}
}

proc ::json::Names {} {
    return {
	critcl {tcllibc based}
	tcl    {pure Tcl}
    }
}

# ### ### ### ######### ######### #########
## Initialization: Data structures.

namespace eval ::json {
    variable  selfdir [file dirname [info script]]
    variable  accel
    array set accel   {tcl 0 critcl 0}
    variable  loaded  {}

    variable apicmds {
	json2dict
	many-json2dict
    }
}

# ### ### ### ######### ######### #########
## Wrapper fix for the jsonc package to match APIs.

proc ::json::many-json2dict_critcl {args} {
    eval [linsert $args 0 ::json::many_json2dict_critcl]
}

# ### ### ### ######### ######### #########
## Initialization: Choose an implementation,
## most prefered first. Loads only one of the
## possible implementations. And activates it.

namespace eval ::json {
    variable e
    foreach e [KnownImplementations] {
	if {[LoadAccelerator $e]} {
	    SwitchTo $e
	    break
	}
    }
    unset e
}

# ### ### ### ######### ######### #########
## Tcl implementation of validation, shared for Tcl and C implementation.
##
## The regexp based validation is consistently faster than json-c.
## Suspected reasons: Tcl REs are mainly in C as well, and json-c has
## overhead in constructing its own data structures. While irrelevant
## to validation json-c still builds them, it has no mode doing pure
## syntax checking.

namespace eval ::json {
    # Regular expression for tokenizing a JSON text (cf. http://json.org/)

    # tokens consisting of a single character
    variable singleCharTokens { "{" "}" ":" "\\[" "\\]" "," }
    variable singleCharTokenRE "\[[join $singleCharTokens {}]\]"

    # quoted string tokens
    variable escapableREs { "[\\\"\\\\/bfnrt]" "u[[:xdigit:]]{4}" "." }
    variable escapedCharRE "\\\\(?:[join $escapableREs |])"
    variable unescapedCharRE {[^\\\"]}
    variable stringRE "\"(?:$escapedCharRE|$unescapedCharRE)*\""

    # as above, for validation
    variable escapableREsv { "[\\\"\\\\/bfnrt]" "u[[:xdigit:]]{4}" }
    variable escapedCharREv "\\\\(?:[join $escapableREsv |])"
    variable stringREv "\"(?:$escapedCharREv|$unescapedCharRE)*\""

    # (unquoted) words
    variable wordTokens { "true" "false" "null" }
    variable wordTokenRE [join $wordTokens "|"]

    # number tokens
    # negative lookahead (?!0)[[:digit:]]+ might be more elegant, but
    # would slow down tokenizing by a factor of up to 3!
    variable positiveRE {[1-9][[:digit:]]*}
    variable cardinalRE "-?(?:$positiveRE|0)"
    variable fractionRE {[.][[:digit:]]+}
    variable exponentialRE {[eE][+-]?[[:digit:]]+}
    variable numberRE "${cardinalRE}(?:$fractionRE)?(?:$exponentialRE)?"

    # JSON token, and validation
    variable tokenRE "$singleCharTokenRE|$stringRE|$wordTokenRE|$numberRE"
    variable tokenREv "$singleCharTokenRE|$stringREv|$wordTokenRE|$numberRE"


    # 0..n white space characters
    set whiteSpaceRE {[[:space:]]*}

    # Regular expression for validating a JSON text
    variable validJsonRE "^(?:${whiteSpaceRE}(?:$tokenREv))*${whiteSpaceRE}$"
}


# Validate JSON text
# @param jsonText JSON text
# @return 1 iff $jsonText conforms to the JSON grammar
#           (@see http://json.org/)
proc ::json::validate {jsonText} {
    variable validJsonRE

    return [regexp -- $validJsonRE $jsonText]
}

# ### ### ### ######### ######### #########
## These three procedures shared between Tcl and Critcl implementations.
## See also package "json::write".

proc ::json::dict2json {dictVal} {
    # XXX: Currently this API isn't symmetrical, as to create proper
    # XXX: JSON text requires type knowledge of the input data
    set json ""
    set prefix ""

    foreach {key val} $dictVal {
	# key must always be a string, val may be a number, string or
	# bare word (true|false|null)
	if {0 && ![string is double -strict $val]
	    && ![regexp {^(?:true|false|null)$} $val]} {
	    set val "\"$val\""
	}
    	append json "$prefix\"$key\": $val" \n
	set prefix ,
    }

    return "\{${json}\}"
}

proc ::json::list2json {listVal} {
    return "\[[join $listVal ,]\]"
}

proc ::json::string2json {str} {
    return "\"$str\""
}

# ### ### ### ######### ######### #########
## Ready

package provide json 1.3.3

#
#   JSON parser for Tcl.
#
#   See http://www.json.org/ && http://www.ietf.org/rfc/rfc4627.txt
#
#   Total rework of the code published with version number 1.0 by
#   Thomas Maeder, Glue Software Engineering AG
#
#   $Id: json.tcl,v 1.7 2011/11/10 21:05:58 andreas_kupries Exp $
#

if {![package vsatisfies [package provide Tcl] 8.5]} {
    package require dict
}

# Parse JSON text into a dict
# @param jsonText JSON text
# @return dict (or list) containing the object represented by $jsonText
proc ::json::json2dict_tcl {jsonText} {
    variable tokenRE

    set tokens [regexp -all -inline -- $tokenRE $jsonText]
    set nrTokens [llength $tokens]
    set tokenCursor 0

#puts T:\t[join $tokens \nT:\t]
    return [parseValue $tokens $nrTokens tokenCursor]
}

# Parse multiple JSON entities in a string into a list of dictionaries
# @param jsonText JSON text to parse
# @param max      Max number of entities to extract.
# @return list of (dict (or list) containing the objects) represented by $jsonText
proc ::json::many-json2dict_tcl {jsonText {max -1}} {
    variable tokenRE

    if {$max == 0} {
	return -code error -errorCode {JSON BAD-LIMIT ZERO} \
	    "Bad limit 0 of json entities to extract."
    }

    set tokens [regexp -all -inline -- $tokenRE $jsonText]
    set nrTokens [llength $tokens]
    set tokenCursor 0

    set result {}
    set found 0
    set n $max
    while {$n != 0} {
	if {$tokenCursor >= $nrTokens} break
	lappend result [parseValue $tokens $nrTokens tokenCursor]
	incr found
	if {$n > 0} {incr n -1}
    }

    if {$n > 0} {
	return -code error -errorCode {JSON BAD-LIMIT TOO LARGE} \
	    "Bad limit $max of json entities to extract, found only $found."
    }

    return $result
}

# Throw an exception signaling an unexpected token
proc ::json::unexpected {tokenCursor token expected} {
    return -code error -errorcode [list JSON UNEXPECTED $tokenCursor $expected] \
	"unexpected token \"$token\" at position $tokenCursor; expecting $expected"
}

# Get rid of the quotes surrounding a string token and substitute the
# real characters for escape sequences within it
# @param token
# @return unquoted unescaped value of the string contained in $token
proc ::json::unquoteUnescapeString {tokenCursor token} {
    variable stringREv
    set unquoted [string range $token 1 end-1]

    if {![regexp $stringREv $token]} {
	unexpected $tokenCursor $token STRING
    }

    set res [subst -nocommands -novariables $unquoted]
    return $res
}

# Parse an object member
# @param tokens list of tokens
# @param nrTokens length of $tokens
# @param tokenCursorName name (in caller's context) of variable
#                        holding current position in $tokens
# @param objectDictName name (in caller's context) of dict
#                       representing the JSON object of which to
#                       parse the next member
proc ::json::parseObjectMember {tokens nrTokens tokenCursorName objectDictName} {
    upvar $tokenCursorName tokenCursor
    upvar $objectDictName objectDict

    set token [lindex $tokens $tokenCursor]
    set tc $tokenCursor
    incr tokenCursor

    set leadingChar [string index $token 0]
    if {$leadingChar eq "\""} {
        set memberName [unquoteUnescapeString $tc $token]

        if {$tokenCursor == $nrTokens} {
            unexpected $tokenCursor "END" "\":\""
        } else {
            set token [lindex $tokens $tokenCursor]
            incr tokenCursor

            if {$token eq ":"} {
                set memberValue [parseValue $tokens $nrTokens tokenCursor]
                dict set objectDict $memberName $memberValue
            } else {
                unexpected $tokenCursor $token "\":\""
            }
        }
    } else {
        unexpected $tokenCursor $token "STRING"
    }
}

# Parse the members of an object
# @param tokens list of tokens
# @param nrTokens length of $tokens
# @param tokenCursorName name (in caller's context) of variable
#                        holding current position in $tokens
# @param objectDictName name (in caller's context) of dict
#                       representing the JSON object of which to
#                       parse the next member
proc ::json::parseObjectMembers {tokens nrTokens tokenCursorName objectDictName} {
    upvar $tokenCursorName tokenCursor
    upvar $objectDictName objectDict

    while true {
        parseObjectMember $tokens $nrTokens tokenCursor objectDict

        set token [lindex $tokens $tokenCursor]
        incr tokenCursor

        switch -exact $token {
            "," {
                # continue
            }
            "\}" {
                break
            }
            default {
                unexpected $tokenCursor $token "\",\"|\"\}\""
            }
        }
    }
}

# Parse an object
# @param tokens list of tokens
# @param nrTokens length of $tokens
# @param tokenCursorName name (in caller's context) of variable
#                        holding current position in $tokens
# @return parsed object (Tcl dict)
proc ::json::parseObject {tokens nrTokens tokenCursorName} {
    upvar $tokenCursorName tokenCursor

    if {$tokenCursor == $nrTokens} {
        unexpected $tokenCursor "END" "OBJECT"
    } else {
        set result [dict create]

        set token [lindex $tokens $tokenCursor]

        if {$token eq "\}"} {
            # empty object
            incr tokenCursor
        } else {
            parseObjectMembers $tokens $nrTokens tokenCursor result
        }

        return $result
    }
}

# Parse the elements of an array
# @param tokens list of tokens
# @param nrTokens length of $tokens
# @param tokenCursorName name (in caller's context) of variable
#                        holding current position in $tokens
# @param resultName name (in caller's context) of the list
#                   representing the JSON array
proc ::json::parseArrayElements {tokens nrTokens tokenCursorName resultName} {
    upvar $tokenCursorName tokenCursor
    upvar $resultName result

    while true {
        lappend result [parseValue $tokens $nrTokens tokenCursor]

        if {$tokenCursor == $nrTokens} {
            unexpected $tokenCursor "END" "\",\"|\"\]\""
        } else {
            set token [lindex $tokens $tokenCursor]
            incr tokenCursor

            switch -exact $token {
                "," {
                    # continue
                }
                "\]" {
                    break
                }
                default {
                    unexpected $tokenCursor $token "\",\"|\"\]\""
                }
            }
        }
    }
}

# Parse an array
# @param tokens list of tokens
# @param nrTokens length of $tokens
# @param tokenCursorName name (in caller's context) of variable
#                        holding current position in $tokens
# @return parsed array (Tcl list)
proc ::json::parseArray {tokens nrTokens tokenCursorName} {
    upvar $tokenCursorName tokenCursor

    if {$tokenCursor == $nrTokens} {
        unexpected $tokenCursor "END" "ARRAY"
    } else {
        set result {}

        set token [lindex $tokens $tokenCursor]

        set leadingChar [string index $token 0]
        if {$leadingChar eq "\]"} {
            # empty array
            incr tokenCursor
        } else {
            parseArrayElements $tokens $nrTokens tokenCursor result
        }

        return $result
    }
}

# Parse a value
# @param tokens list of tokens
# @param nrTokens length of $tokens
# @param tokenCursorName name (in caller's context) of variable
#                        holding current position in $tokens
# @return parsed value (dict, list, string, number)
proc ::json::parseValue {tokens nrTokens tokenCursorName} {
    upvar $tokenCursorName tokenCursor

    if {$tokenCursor == $nrTokens} {
        unexpected $tokenCursor "END" "VALUE"
    } else {
        set token [lindex $tokens $tokenCursor]
	set tc $tokenCursor
        incr tokenCursor

        set leadingChar [string index $token 0]
        switch -exact -- $leadingChar {
            "\{" {
                return [parseObject $tokens $nrTokens tokenCursor]
            }
            "\[" {
                return [parseArray $tokens $nrTokens tokenCursor]
            }
            "\"" {
                # quoted string
                return [unquoteUnescapeString $tc $token]
            }
            "t" -
            "f" -
            "n" {
                # bare word: true, false, null (return as is)
                return $token
            }
            default {
                # number?
                if {[string is double -strict $token]} {
                    return $token
                } else {
                    unexpected $tokenCursor $token "VALUE"
                }
            }
        }
    }
}

# json_write.tcl --
#
#	Commands for the generation of JSON (Java Script Object Notation).
#
# Copyright (c) 2009-2011 Andreas Kupries <andreas_kupries@sourceforge.net>
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
# 
# RCS: @(#) $Id: json_write.tcl,v 1.2 2011/08/24 20:09:44 andreas_kupries Exp $

# ### ### ### ######### ######### #########
## Requisites

package require Tcl 8.5

namespace eval ::json::write {
    namespace export \
	string array object indented aligned

    namespace ensemble create
}

# ### ### ### ######### ######### #########
## API.

proc ::json::write::indented {{bool {}}} {
    variable indented

    if {[llength [info level 0]] > 2} {
	return -code error {wrong # args: should be "json::write indented ?bool?"}
    } elseif {[llength [info level 0]] == 2} {
	if {![::string is boolean -strict $bool]} {
	    return -code error "Expected boolean, got \"$bool\""
	}
	set indented $bool
	if {!$indented} {
	    variable aligned 0
	}
    }

    return $indented
}

proc ::json::write::aligned {{bool {}}} {
    variable aligned

    if {[llength [info level 0]] > 2} {
	return -code error {wrong # args: should be "json::write aligned ?bool?"}
    } elseif {[llength [info level 0]] == 2} {
	if {![::string is boolean -strict $bool]} {
	    return -code error "Expected boolean, got \"$bool\""
	}
	set aligned $bool
	if {$aligned} {
	    variable indented 1
	}
    }

    return $aligned
}

proc ::json::write::string {s} {
    variable quotes
    return "\"[::string map $quotes $s]\""
}

proc ::json::write::array {args} {
    # always compact form.
    return "\[[join $args ,]\]"
}

proc ::json::write::object {args} {
    # The dict in args maps string keys to json-formatted data. I.e.
    # we have to quote the keys, but not the values, as the latter are
    # already in the proper format.

    variable aligned
    variable indented

    if {[llength $args] %2 == 1} {
	return -code error {wrong # args, expected an even number of arguments}
    }

    set dict {}
    foreach {k v} $args {
	lappend dict [string $k] $v
    }

    if {$aligned} {
	set max [MaxKeyLength $dict]
    }

    if {$indented} {
	set content {}
	foreach {k v} $dict {
	    if {$aligned} {
		set k [AlignLeft $max $k]
	    }
	    if {[::string match *\n* $v]} {
		# multi-line value
		lappend content "    $k : [Indent $v {    } 1]"
	    } else {
		# single line value.
		lappend content "    $k : $v"
	    }
	}
	if {[llength $content]} {
	    return "\{\n[join $content ,\n]\n\}"
	} else {
	    return "\{\}"
	}
    } else {
	# ultra compact form.
	set tmp {}
	foreach {k v} $dict {
	    lappend tmp "$k:$v"
	}
	return "\{[join $tmp ,]\}"
    }
}

# ### ### ### ######### ######### #########
## Internals.

proc ::json::write::Indent {text prefix skip} {
    set pfx ""
    set result {}
    foreach line [split $text \n] {
	if {!$skip} { set pfx $prefix } else { incr skip -1 }
	lappend result ${pfx}$line
    }
    return [join $result \n]
}

proc ::json::write::MaxKeyLength {dict} {
    # Find the max length of the keys in the dictionary.

    set lengths 0 ; # This will be the max if the dict is empty, and
		    # prevents the mathfunc from throwing errors for
		    # that case.

    foreach str [dict keys $dict] {
	lappend lengths [::string length $str]
    }

    return [tcl::mathfunc::max {*}$lengths]
}

proc ::json::write::AlignLeft {fieldlen str} {
    return [format %-${fieldlen}s $str]
    #return $str[::string repeat { } [expr {$fieldlen - [::string length $str]}]]
}

# ### ### ### ######### ######### #########

namespace eval ::json::write {
    # Configuration of the layout to write.

    # indented = boolean. objects are indented.
    # aligned  = boolean. object keys are aligned vertically.

    # aligned  => indented.

    # Combinations of the format specific entries
    # I A |
    # - - + ---------------------
    # 0 0 | Ultracompact (no whitespace, single line)
    # 1 0 | Indented
    # 0 1 | Not possible, per the implications above.
    # 1 1 | Indented + vertically aligned keys
    # - - + ---------------------

    variable indented 1
    variable aligned  1

    variable quotes \
	[list "\"" "\\\"" \\ \\\\ \b \\b \f \\f \n \\n \r \\r \t \\t \
	     \x00 \\u0000 \x01 \\u0001 \x02 \\u0002 \x03 \\u0003 \
	     \x04 \\u0004 \x05 \\u0005 \x06 \\u0006 \x07 \\u0007 \
	     \x0b \\u000b \x0e \\u000e \x0f \\u000f \x10 \\u0010 \
	     \x11 \\u0011 \x12 \\u0012 \x13 \\u0013 \x14 \\u0014 \
	     \x15 \\u0015 \x16 \\u0016 \x17 \\u0017 \x18 \\u0018 \
	     \x19 \\u0019 \x1a \\u001a \x1b \\u001b \x1c \\u001c \
	     \x1d \\u001d \x1e \\u001e \x1f \\u001f \x7f \\u007f \
	     \x80 \\u0080 \x81 \\u0081 \x82 \\u0082 \x83 \\u0083 \
	     \x84 \\u0084 \x85 \\u0085 \x86 \\u0086 \x87 \\u0087 \
	     \x88 \\u0088 \x89 \\u0089 \x8a \\u008a \x8b \\u008b \
	     \x8c \\u008c \x8d \\u008d \x8e \\u008e \x8f \\u008f \
	     \x90 \\u0090 \x91 \\u0091 \x92 \\u0092 \x93 \\u0093 \
	     \x94 \\u0094 \x95 \\u0095 \x96 \\u0096 \x97 \\u0097 \
	     \x98 \\u0098 \x99 \\u0099 \x9a \\u009a \x9b \\u009b \
	     \x9c \\u009c \x9d \\u009d \x9e \\u009e \x9f \\u009f ]
}

# ### ### ### ######### ######### #########
## Ready

package provide json::write 1.0.3
return

# jsonc.tcl --
#
#       Implementation of a JSON parser in C.
#	Binding to a yacc/bison parser by Mikhail.
#
# Copyright (c) 2013 - critcl wrapper - Andreas Kupries <andreas_kupries@users.sourceforge.net>
# Copyright (c) 2013 - C binding      - mi+tcl.tk-2013@aldan.algebra.com

package require critcl
# @sak notprovided jsonc
package provide jsonc 1.1.1
package require Tcl 8.4

#critcl::cheaders -g
#critcl::debug memory symbols
critcl::cheaders -Ic c/*.h
critcl::csources c/*.c

# # ## ### Import base declarations, forwards ### ## # #

critcl::ccode {
    #include <json_y.h>
}

# # ## ### Main Conversion ### ## # #

namespace eval ::json {
    critcl::ccommand json2dict_critcl {dummy I objc objv} {
	struct context context = { NULL };

	if (objc != 2) {
	    Tcl_WrongNumArgs(I, 1, objv, "json");
	    return TCL_ERROR;
	}

	context.text   = Tcl_GetStringFromObj(objv[1], &context.remaining);
	context.I      = I;
	context.has_error = 0;
	context.result = TCL_ERROR;

	jsonparse (&context);
	return context.result;
    }

    # Issue with critcl 2 used here. Cannot use '-', incomplete distinction of C and Tcl names.
    # The json.tcl file making use of this code has a wrapper fixing the issue.
    critcl::ccommand many_json2dict_critcl {dummy I objc objv} {
	struct context context = { NULL };

	int                      max;
	int                      found;

	Tcl_Obj* result = Tcl_NewListObj (0, NULL);

	if ((objc < 2) || (objc > 3)) {
	    Tcl_WrongNumArgs(I, 1, objv, "jsonText ?max?");
	    return TCL_ERROR;
	}

	if (objc == 3) {
	    if (Tcl_GetIntFromObj(I, objv[2], &max) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (max <= 0) {
		Tcl_AppendResult (I, "Bad limit ",
				  Tcl_GetString (objv[2]),
				  " of json entities to extract.",
				  NULL);
		Tcl_SetErrorCode (I, "JSON", "BAD-LIMIT", NULL);
		return TCL_ERROR;
	    }

	} else {
	    max = -1;
	}

	context.text   = Tcl_GetStringFromObj(objv[1], &context.remaining);
	context.I      = I;
	context.has_error = 0;
	found  = 0;

	/* Iterate over the input until
	 * - we have gotten all requested values.
	 * - we have run out of input
	 * - we have run into an error
	 */

	while ((max < 0) || max) {
	    context.result = TCL_ERROR;
	    jsonparse (&context);

	    /* parse error, abort */
	    if (context.result != TCL_OK) {
		Tcl_DecrRefCount (result);
		return TCL_ERROR;
	    }

	    /* Proper value extracted, extend result */
	    found ++;
	    Tcl_ListObjAppendElement(I, result,
				     Tcl_GetObjResult (I));

	    /* Count down on the number of still missing
	     * values, if not asking for all (-1)
	     */
	    if (max > 0) max --;

	    /* Jump over trailing whitespace for proper end-detection */
	    jsonskip (&context);

	    /* Abort if we have consumed all input */
	    if (!context.remaining) break;

	    /* Clear scratch pad before continuing */
	    context.obj = NULL;
	}

	/* While all parses were ok we reached end of
	 * input without getting all requested values,
	 * this is an error
	 */
	if (max > 0) {
	    char buf [30];
	    sprintf (buf, "%d", found);
            Tcl_ResetResult (I);
	    Tcl_AppendResult (I, "Bad limit ",
			      Tcl_GetString (objv[2]),
			      " of json entities to extract, found only ",
			      buf,
			      ".",
			      NULL);
	    Tcl_SetErrorCode (I, "JSON", "BAD-LIMIT", "TOO", "LARGE", NULL);
	    Tcl_DecrRefCount (result);
	    return TCL_ERROR;
	}

	/* We are good and done */
	Tcl_SetObjResult(I, result);
	return TCL_OK;
    }

    if 0 {critcl::ccommand validate_critcl {dummy I objc objv} {
	struct context context = { NULL };

	if (objc != 2) {
	    Tcl_WrongNumArgs(I, 1, objv, "jsonText");
	    return TCL_ERROR;
	}

	context.text   = Tcl_GetStringFromObj(objv[1], &context.remaining);
	context.I      = I;
	context.result = TCL_ERROR;

	/* Iterate over the input until we have run
	 * out of text, or encountered an error. We
	 * use only the lexer here, and told it to not
	* create superfluous token values.
	 */

	while (context.remaining) {
	    if (jsonlex (&context) == -1) {
		Tcl_SetObjResult(I, Tcl_NewBooleanObj (0));
		return TCL_OK;
	    }
	}

	/* We are good and done */
	Tcl_SetObjResult(I, Tcl_NewBooleanObj (1));
	return TCL_OK;
    }}
}

# Tcl package index file, version 1.1

if {![package vsatisfies [package provide Tcl] 8.4]} {return}
package ifneeded json 1.3.3 [list source [file join $dir json.tcl]]

if {![package vsatisfies [package provide Tcl] 8.5]} {return}
package ifneeded json::write 1.0.3 [list source [file join $dir json_write.tcl]]