Check-in [06c059eb4a]
Overview
Comment:Improve web interface
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:06c059eb4a216b516567a4b0139919105c66c836
User & Date: rkeene on 2019-02-28 06:47:32
Other Links: manifest | tags
Context
2019-02-28
07:41
Better handling to the kit_url check-in: 01ff48e506 user: rkeene tags: trunk
06:47
Improve web interface check-in: 06c059eb4a user: rkeene tags: trunk
2019-02-04
15:04
Web interface fix: TclCurl is not in 0.11.0 check-in: 6352ceb861 user: rkeene tags: trunk
Changes

Modified build/web/kitcreator.vfs/index.rvt from [f3437e4a72] to [ff68791fbb].

     1      1   <?
     2      2   	package require sha1
     3      3   
     4      4   	load_response args
            5  +
            6  +	proc normalize_platform {platform platform_names} {
            7  +		set platform [string tolower $platform]
            8  +		if {$platform in $platform_names} {
            9  +			return $platform
           10  +		}
           11  +
           12  +		set platform [regsub {[-]x86_64$} $platform {-amd64}]
           13  +		set platform [regsub {[-]sun4[muv]$} $platform {-sparc}]
           14  +		if {$platform in $platform_names} {
           15  +			return $platform
           16  +		}
           17  +	}
     5     18   
     6     19   	proc versionEncoded {versionString} {
     7     20   		set output 0
     8     21   
     9     22   		if {$versionString eq "trunk"} {
    10     23   			return [versionEncoded "255.255.255"]
    11     24   		}
................................................................................
    21     34   		return $output
    22     35   	}
    23     36   
    24     37   	set sourcedir "/web/rkeene/devel/kitcreator/all"
    25     38   	set queue "/home/rkeene/devel/kitcreator/build/web/queue"
    26     39   	set secretfile "/home/rkeene/etc/kitcreator-web-secret"
    27     40   
           41  +	# KitCreator Versions
    28     42   	foreach file [glob -tails -nocomplain -directory $sourcedir "kitcreator-*.tar.gz"] {
    29     43   		regexp {^kitcreator-(.*).tar.gz$} $file -> vers
    30     44   		set kitcreator_versions($vers) $vers
    31     45   	}
    32     46   	set kitcreator_version_selected [lindex [lsort -dictionary [array names kitcreator_versions]] end]
    33     47   
    34     48   	set kitcreator_versions(trunk) "Fossil Trunk Tip"
    35     49   
           50  +	# Tcl Versions
    36     51   	set tcl_versions(8.5.15) 8.5.15
    37     52   	set tcl_versions(8.5.16) 8.5.16
    38     53   	set tcl_versions(8.5.17) 8.5.17
    39     54   	set tcl_versions(8.5.18) 8.5.18
    40     55   	set tcl_versions(8.5.19) 8.5.19
    41     56   	set tcl_versions(8.6.1) 8.6.1
    42     57   	set tcl_versions(8.6.2) 8.6.2
................................................................................
    45     60   	set tcl_versions(8.6.5) 8.6.5
    46     61   	set tcl_versions(8.6.6) 8.6.6
    47     62   	set tcl_versions(8.6.7) 8.6.7
    48     63   	set tcl_versions(8.6.8) 8.6.8
    49     64   	set tcl_versions(8.6.9) 8.6.9
    50     65   	set tcl_versions(fossil_trunk) "Fossil Trunk Tip"
    51     66   
           67  +	set tcl_version_list [lsort -dictionary [array names tcl_versions]]
           68  +	set tcl_version_selected [lindex $tcl_version_list end-1]
           69  +
           70  +	# Platforms
    52     71   	set platforms(android-arm) "Android/ARM"
    53     72   	set platforms(freebsd-amd64) "FreeBSD/amd64"
    54     73   	set platforms(hpux-hppa64) "HP-UX/PA-RISC 2.0"
    55     74   	set platforms(aix-ppc) "AIX/POWER"
    56     75   	set platforms(linux-amd64) "Linux/amd64"
    57     76   	set platforms(linux-amd64-static) "Linux/amd64 (static)"
    58     77   	set platforms(linux-arm) "Linux/ARM"
................................................................................
    86    105   	set packages(nsf) "Next Scripting Framework"
    87    106   	set packages(tdom) "tDOM"
    88    107   	set packages(tuapi) "Tcl UNIX API"
    89    108   	set packages(lmdb) "LMDB"
    90    109   	set packages(tclcurl) "cURL"
    91    110   	set packages(duktape) "Duktape"
    92    111   
          112  +	set options_info(threaded) "Kit: Threaded"
          113  +	set options_info(kitdll) "Kit: Build Library (KitDLL)"
          114  +	set options_info(debug) "Kit: Debugging Build"
          115  +	set options_info(dynamictk) "Kit: Always link Tk dynamically (if Tk is built)"
          116  +	set options_info(minbuild) "Kit: \"Minimal\" build (remove extra packages shipped as part of Tcl and reduce encodings)"
          117  +	set options_info(staticlibssl) "TLS: Statically link to LibSSL"
          118  +	set options_info(buildlibssl) "TLS: Build LibreSSL for this platform"
          119  +	set options_info(staticpkgs) "Kit: Statically link packages in pkgs directory"
          120  +	set options_info(tclutfmax6) "Kit: TCL_UTF_MAX=6 (incompatibility with standard Tcl)"
          121  +
    93    122   	set disable {
    94    123   		platform linux-mipsel {package_tk package_tcc4tcl package_tclx kitdll}
    95    124   		platform android-arm {package_tk package_tclx}
    96    125   		platform freebsd-amd64 {package_tuapi}
    97    126   		platform hpux-hppa64 {package_tuapi}
    98    127   		platform aix-ppc {package_tuapi kitdll}
    99    128   		platform netbsd-amd64 {package_tk package_tcc4tcl package_tclx package_tuapi}
................................................................................
   122    151   
   123    152   	set specific {
   124    153   		platform win32 file icon {Kit Icon}
   125    154   		platform win32 text description {Description}
   126    155   		platform win64 file icon {Kit Icon}
   127    156   		platform win64 text description {Description}
   128    157   	}
          158  +
          159  +	if {[info exists args(dict)] || [info exists args(json)]} {
          160  +		package require json
          161  +		package require json::write
          162  +	}
          163  +
          164  +	if {[info exists args(json)]} {
          165  +		set args(dict) [::json::json2dict $args(json)]
          166  +		unset args(json)
          167  +		set apiReturnFormat json
          168  +	}
          169  +
          170  +	set resultIsAPI false
          171  +	if {[info exists args(dict)]} {
          172  +		headers set "Access-Control-Allow-Origin" "*"
          173  +		if {![info exists apiReturnFormat]} {
          174  +			set apiReturnFormat dict
          175  +		}
          176  +
          177  +		set apiMethod build
          178  +		catch {
          179  +			set apiMethod [dict get $args(dict) action]
          180  +		}
          181  +
          182  +		switch -exact -- $apiMethod {
          183  +			build {
          184  +				# Do nothing, handled below
          185  +			}
          186  +			platforms {
          187  +				set apiResultDict [array get platforms]
          188  +			}
          189  +			tcl_versions {
          190  +				set apiResultDict [array get tcl_versions]
          191  +				dict set apiResultDict default $tcl_version_selected
          192  +			}
          193  +			kitcreator_versions {
          194  +				set apiResultDict [array get kitcreator_versions]
          195  +				dict set apiResultDict default $kitcreator_version_selected
          196  +			}
          197  +			options {
          198  +				set apiResultDict [array get options_info]
          199  +			}
          200  +			packages {
          201  +				set apiResultDict [array get packages]
          202  +			}
          203  +			help {
          204  +				set apiResultDict {
          205  +					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]}
          206  +					platforms {Get a list of platforms to use as the "platform" argument to build}
          207  +					tcl_versions {Get a list of Tcl versions and their descriptions to use as the "tcl_version" argument to build}
          208  +					kitcreator_versions {Get a list of KitCreator versions and their descriptions to use as the "kitcreator_version" argument to build}
          209  +					options {Get a list of options and their descriptions}
          210  +					packages {Get a list of packages and their descriptions}
          211  +					examples {A few examples}
          212  +					help {This help}
          213  +				}
          214  +			}
          215  +			examples {
          216  +				set apiResultDict {
          217  +					simple {curl -d 'json={"action": "build", "platform": "linux-amd64"}' http://kitcreator.rkeene.org/kitcreator}
          218  +				}
          219  +			}
          220  +			default {
          221  +				set apiResultDict [dict create error "Invalid action \"$apiMethod\""]
          222  +			}
          223  +		}
          224  +
          225  +		if {$apiMethod eq "build" && ![dict exists $args(dict) platform]} {
          226  +			set apiMethod error
          227  +			set apiResultDict [dict create error "The argument \"platform\" must be supplied when building"]
          228  +		}
          229  +
          230  +		if {$apiMethod ne "build"} {
          231  +			if {[dict exists $apiResultDict error]} {
          232  +				headers numeric 500
          233  +			}
          234  +
          235  +			switch -exact -- $apiReturnFormat {
          236  +				"json" {
          237  +					headers type application/json
          238  +
          239  +					set apiResultDictEncoded [list]
          240  +					foreach {key value} $apiResultDict {
          241  +						lappend apiResultDictEncoded $key [json::write string $value]
          242  +					}
          243  +					set apiResultJSON [json::write object {*}$apiResultDictEncoded]
          244  +					puts $apiResultJSON
          245  +				}
          246  +				"dict" {
          247  +					headers type text/plain
          248  +					
          249  +					puts [dict create {*}$apiResultDict]
          250  +				}
          251  +			}
          252  +
          253  +			rivet_flush
          254  +			abort_page
          255  +		}
          256  +
          257  +		set resultIsAPI true
          258  +		set args(platform) [dict get $args(dict) platform]
          259  +		set args(tcl_version) $tcl_version_selected
          260  +		set args(kitcreator_version) $kitcreator_version_selected
          261  +
          262  +		foreach arg {tcl_version kitcreator_version option_storage} {
          263  +			set dictArg $arg
          264  +			switch -exact -- $arg {
          265  +				option_storage {
          266  +					set dictArg "storage"
          267  +				}
          268  +			}
          269  +
          270  +			catch {
          271  +				set args($arg) [dict get $args(dict) $dictArg]
          272  +			}
          273  +		}
          274  +
          275  +		set selectedPackages [list]
          276  +		catch {
          277  +			set selectedPackages [dict get $args(dict) packages]
          278  +		}
          279  +		foreach arg $selectedPackages {
          280  +			set args(option_package_$arg) true
          281  +		}
          282  +
          283  +		set selectedOptions [list]
          284  +		catch {
          285  +			set selectedOptions [dict get $args(dict) options]
          286  +		}
          287  +		foreach arg $selectedOptions {
          288  +			switch -glob -- $arg {
          289  +				"package_*" {
          290  +					continue
          291  +				}
          292  +			}
          293  +
          294  +			set args(option_$arg) true
          295  +		}
          296  +	}
   129    297   
   130    298   	if {[info exists args(platform)] && [info exists args(tcl_version)] && [info exist args(kitcreator_version)]} {
   131    299   		# Read in arguments
   132    300   		## Mandatory arguments
   133         -		set build_platform $args(platform)
          301  +		set build_platform [normalize_platform $args(platform) [array names platforms]]
   134    302   		set build_tcl_version $args(tcl_version)
   135    303   		set build_kitcreator_version $args(kitcreator_version)
          304  +
          305  +		if {$build_tcl_version eq "default"} {
          306  +			set build_tcl_version $tcl_version_selected
          307  +		}
          308  +
          309  +		if {$build_kitcreator_version eq "default"} {
          310  +			set build_kitcreator_version $kitcreator_version_selected
          311  +		}
   136    312   
   137    313   		## Optional Arguments
   138    314   		set build_packages [list]
   139    315   		set build_options(threaded) 0
   140    316   		set build_options(kitdll) 0
   141    317   		set build_options(debug) 0
   142    318   		set build_options(dynamictk) 0
................................................................................
   270    446   
   271    447   		# Queue build up and wait for it to complete
   272    448   		set fd [open $queue a+]
   273    449   		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]]
   274    450   		close $fd
   275    451   
   276    452   		set url "http://kitcreator.rkeene.org/kits/building/$key/"
          453  +		set kiturl "http://kitcreator.rkeene.org/kits/$key/$filename"
   277    454   
   278         -		headers redirect $url
          455  +		if {!$resultIsAPI} {
          456  +			headers redirect $url
   279    457   ?><html>
   280    458   	<head>
   281    459   		<title>KitCreator, Web Interface</title>
   282    460   	</head>
   283    461   	<body>
   284    462   		<h1>KitCreator Web Interface</h1>
   285    463   		<p>Build in progress, see <a href="<? puts -nonewline $url ?>"><? puts -nonewline $url ?></a> for build information</p>
   286    464   	</body>
   287    465   </html>
   288    466   <?
          467  +		} else {
          468  +			switch -exact -- $apiReturnFormat {
          469  +				"json" {
          470  +					puts "{\"kit_url\": \"${kiturl}\"}"
          471  +				}
          472  +				"dict" {
          473  +					puts [dict create kit_url $kiturl]
          474  +				}
          475  +			}
          476  +		}
   289    477   	} else {
   290    478   ?><html>
   291    479     <head>
   292    480       <title>KitCreator, Web Interface</title>
   293    481       <script>
   294    482   <!--
   295    483   	function enableOption(option) {
................................................................................
   423    611             </td>
   424    612           </tr>
   425    613           <tr>
   426    614             <td>Tcl Version:</td>
   427    615             <td>
   428    616               <select name="tcl_version" onChange="verifyOptions();">
   429    617   <?
   430         -	set tcl_version_list [lsort -dictionary [array names tcl_versions]]
   431         -	set tcl_version_selected [lindex $tcl_version_list end-1]
   432    618   	foreach tcl_version $tcl_version_list {
   433    619   		set tcl_version_name $tcl_versions($tcl_version)
   434    620   
   435    621   		if {$tcl_version == $tcl_version_selected} {
   436    622   			set selected " selected"
   437    623   		} else {
   438    624   			set selected ""

Added build/web/kitcreator.vfs/lib/json/json.tcl version [363d086248].

            1  +# json.tcl --
            2  +#
            3  +#	JSON parser for Tcl. Management code, Tcl/C detection and selection.
            4  +#
            5  +# Copyright (c) 2013 by Andreas Kupries
            6  +
            7  +# @mdgen EXCLUDE: jsonc.tcl
            8  +
            9  +package require Tcl 8.4
           10  +namespace eval ::json {}
           11  +
           12  +# ### ### ### ######### ######### #########
           13  +## Management of json implementations.
           14  +
           15  +# ::json::LoadAccelerator --
           16  +#
           17  +#	Loads a named implementation, if possible.
           18  +#
           19  +# Arguments:
           20  +#	key	Name of the implementation to load.
           21  +#
           22  +# Results:
           23  +#	A boolean flag. True if the implementation
           24  +#	was successfully loaded; and False otherwise.
           25  +
           26  +proc ::json::LoadAccelerator {key} {
           27  +    variable accel
           28  +    set r 0
           29  +    switch -exact -- $key {
           30  +	critcl {
           31  +	    # Critcl implementation of json requires Tcl 8.4.
           32  +	    if {![package vsatisfies [package provide Tcl] 8.4]} {return 0}
           33  +	    if {[catch {package require tcllibc}]} {return 0}
           34  +	    # Check for the jsonc 1.1.1 API we are fixing later.
           35  +	    set r [llength [info commands ::json::many_json2dict_critcl]]
           36  +	}
           37  +	tcl {
           38  +	    variable selfdir
           39  +	    source [file join $selfdir json_tcl.tcl]
           40  +	    set r 1
           41  +	}
           42  +        default {
           43  +            return -code error "invalid accelerator/impl. package $key:\
           44  +                must be one of [join [KnownImplementations] {, }]"
           45  +        }
           46  +    }
           47  +    set accel($key) $r
           48  +    return $r
           49  +}
           50  +
           51  +# ::json::SwitchTo --
           52  +#
           53  +#	Activates a loaded named implementation.
           54  +#
           55  +# Arguments:
           56  +#	key	Name of the implementation to activate.
           57  +#
           58  +# Results:
           59  +#	None.
           60  +
           61  +proc ::json::SwitchTo {key} {
           62  +    variable accel
           63  +    variable loaded
           64  +    variable apicmds
           65  +
           66  +    if {[string equal $key $loaded]} {
           67  +	# No change, nothing to do.
           68  +	return
           69  +    } elseif {![string equal $key ""]} {
           70  +	# Validate the target implementation of the switch.
           71  +
           72  +	if {![info exists accel($key)]} {
           73  +	    return -code error "Unable to activate unknown implementation \"$key\""
           74  +	} elseif {![info exists accel($key)] || !$accel($key)} {
           75  +	    return -code error "Unable to activate missing implementation \"$key\""
           76  +	}
           77  +    }
           78  +
           79  +    # Deactivate the previous implementation, if there was any.
           80  +
           81  +    if {![string equal $loaded ""]} {
           82  +	foreach c $apicmds {
           83  +	    rename ::json::${c} ::json::${c}_$loaded
           84  +	}
           85  +    }
           86  +
           87  +    # Activate the new implementation, if there is any.
           88  +
           89  +    if {![string equal $key ""]} {
           90  +	foreach c $apicmds {
           91  +	    rename ::json::${c}_$key ::json::${c}
           92  +	}
           93  +    }
           94  +
           95  +    # Remember the active implementation, for deactivation by future
           96  +    # switches.
           97  +
           98  +    set loaded $key
           99  +    return
          100  +}
          101  +
          102  +# ::json::Implementations --
          103  +#
          104  +#	Determines which implementations are
          105  +#	present, i.e. loaded.
          106  +#
          107  +# Arguments:
          108  +#	None.
          109  +#
          110  +# Results:
          111  +#	A list of implementation keys.
          112  +
          113  +proc ::json::Implementations {} {
          114  +    variable accel
          115  +    set res {}
          116  +    foreach n [array names accel] {
          117  +	if {!$accel($n)} continue
          118  +	lappend res $n
          119  +    }
          120  +    return $res
          121  +}
          122  +
          123  +# ::json::KnownImplementations --
          124  +#
          125  +#	Determines which implementations are known
          126  +#	as possible implementations.
          127  +#
          128  +# Arguments:
          129  +#	None.
          130  +#
          131  +# Results:
          132  +#	A list of implementation keys. In the order
          133  +#	of preference, most prefered first.
          134  +
          135  +proc ::json::KnownImplementations {} {
          136  +    return {critcl tcl}
          137  +}
          138  +
          139  +proc ::json::Names {} {
          140  +    return {
          141  +	critcl {tcllibc based}
          142  +	tcl    {pure Tcl}
          143  +    }
          144  +}
          145  +
          146  +# ### ### ### ######### ######### #########
          147  +## Initialization: Data structures.
          148  +
          149  +namespace eval ::json {
          150  +    variable  selfdir [file dirname [info script]]
          151  +    variable  accel
          152  +    array set accel   {tcl 0 critcl 0}
          153  +    variable  loaded  {}
          154  +
          155  +    variable apicmds {
          156  +	json2dict
          157  +	many-json2dict
          158  +    }
          159  +}
          160  +
          161  +# ### ### ### ######### ######### #########
          162  +## Wrapper fix for the jsonc package to match APIs.
          163  +
          164  +proc ::json::many-json2dict_critcl {args} {
          165  +    eval [linsert $args 0 ::json::many_json2dict_critcl]
          166  +}
          167  +
          168  +# ### ### ### ######### ######### #########
          169  +## Initialization: Choose an implementation,
          170  +## most prefered first. Loads only one of the
          171  +## possible implementations. And activates it.
          172  +
          173  +namespace eval ::json {
          174  +    variable e
          175  +    foreach e [KnownImplementations] {
          176  +	if {[LoadAccelerator $e]} {
          177  +	    SwitchTo $e
          178  +	    break
          179  +	}
          180  +    }
          181  +    unset e
          182  +}
          183  +
          184  +# ### ### ### ######### ######### #########
          185  +## Tcl implementation of validation, shared for Tcl and C implementation.
          186  +##
          187  +## The regexp based validation is consistently faster than json-c.
          188  +## Suspected reasons: Tcl REs are mainly in C as well, and json-c has
          189  +## overhead in constructing its own data structures. While irrelevant
          190  +## to validation json-c still builds them, it has no mode doing pure
          191  +## syntax checking.
          192  +
          193  +namespace eval ::json {
          194  +    # Regular expression for tokenizing a JSON text (cf. http://json.org/)
          195  +
          196  +    # tokens consisting of a single character
          197  +    variable singleCharTokens { "{" "}" ":" "\\[" "\\]" "," }
          198  +    variable singleCharTokenRE "\[[join $singleCharTokens {}]\]"
          199  +
          200  +    # quoted string tokens
          201  +    variable escapableREs { "[\\\"\\\\/bfnrt]" "u[[:xdigit:]]{4}" "." }
          202  +    variable escapedCharRE "\\\\(?:[join $escapableREs |])"
          203  +    variable unescapedCharRE {[^\\\"]}
          204  +    variable stringRE "\"(?:$escapedCharRE|$unescapedCharRE)*\""
          205  +
          206  +    # as above, for validation
          207  +    variable escapableREsv { "[\\\"\\\\/bfnrt]" "u[[:xdigit:]]{4}" }
          208  +    variable escapedCharREv "\\\\(?:[join $escapableREsv |])"
          209  +    variable stringREv "\"(?:$escapedCharREv|$unescapedCharRE)*\""
          210  +
          211  +    # (unquoted) words
          212  +    variable wordTokens { "true" "false" "null" }
          213  +    variable wordTokenRE [join $wordTokens "|"]
          214  +
          215  +    # number tokens
          216  +    # negative lookahead (?!0)[[:digit:]]+ might be more elegant, but
          217  +    # would slow down tokenizing by a factor of up to 3!
          218  +    variable positiveRE {[1-9][[:digit:]]*}
          219  +    variable cardinalRE "-?(?:$positiveRE|0)"
          220  +    variable fractionRE {[.][[:digit:]]+}
          221  +    variable exponentialRE {[eE][+-]?[[:digit:]]+}
          222  +    variable numberRE "${cardinalRE}(?:$fractionRE)?(?:$exponentialRE)?"
          223  +
          224  +    # JSON token, and validation
          225  +    variable tokenRE "$singleCharTokenRE|$stringRE|$wordTokenRE|$numberRE"
          226  +    variable tokenREv "$singleCharTokenRE|$stringREv|$wordTokenRE|$numberRE"
          227  +
          228  +
          229  +    # 0..n white space characters
          230  +    set whiteSpaceRE {[[:space:]]*}
          231  +
          232  +    # Regular expression for validating a JSON text
          233  +    variable validJsonRE "^(?:${whiteSpaceRE}(?:$tokenREv))*${whiteSpaceRE}$"
          234  +}
          235  +
          236  +
          237  +# Validate JSON text
          238  +# @param jsonText JSON text
          239  +# @return 1 iff $jsonText conforms to the JSON grammar
          240  +#           (@see http://json.org/)
          241  +proc ::json::validate {jsonText} {
          242  +    variable validJsonRE
          243  +
          244  +    return [regexp -- $validJsonRE $jsonText]
          245  +}
          246  +
          247  +# ### ### ### ######### ######### #########
          248  +## These three procedures shared between Tcl and Critcl implementations.
          249  +## See also package "json::write".
          250  +
          251  +proc ::json::dict2json {dictVal} {
          252  +    # XXX: Currently this API isn't symmetrical, as to create proper
          253  +    # XXX: JSON text requires type knowledge of the input data
          254  +    set json ""
          255  +    set prefix ""
          256  +
          257  +    foreach {key val} $dictVal {
          258  +	# key must always be a string, val may be a number, string or
          259  +	# bare word (true|false|null)
          260  +	if {0 && ![string is double -strict $val]
          261  +	    && ![regexp {^(?:true|false|null)$} $val]} {
          262  +	    set val "\"$val\""
          263  +	}
          264  +    	append json "$prefix\"$key\": $val" \n
          265  +	set prefix ,
          266  +    }
          267  +
          268  +    return "\{${json}\}"
          269  +}
          270  +
          271  +proc ::json::list2json {listVal} {
          272  +    return "\[[join $listVal ,]\]"
          273  +}
          274  +
          275  +proc ::json::string2json {str} {
          276  +    return "\"$str\""
          277  +}
          278  +
          279  +# ### ### ### ######### ######### #########
          280  +## Ready
          281  +
          282  +package provide json 1.3.3

Added build/web/kitcreator.vfs/lib/json/json_tcl.tcl version [06b0cbc8b1].

            1  +#
            2  +#   JSON parser for Tcl.
            3  +#
            4  +#   See http://www.json.org/ && http://www.ietf.org/rfc/rfc4627.txt
            5  +#
            6  +#   Total rework of the code published with version number 1.0 by
            7  +#   Thomas Maeder, Glue Software Engineering AG
            8  +#
            9  +#   $Id: json.tcl,v 1.7 2011/11/10 21:05:58 andreas_kupries Exp $
           10  +#
           11  +
           12  +if {![package vsatisfies [package provide Tcl] 8.5]} {
           13  +    package require dict
           14  +}
           15  +
           16  +# Parse JSON text into a dict
           17  +# @param jsonText JSON text
           18  +# @return dict (or list) containing the object represented by $jsonText
           19  +proc ::json::json2dict_tcl {jsonText} {
           20  +    variable tokenRE
           21  +
           22  +    set tokens [regexp -all -inline -- $tokenRE $jsonText]
           23  +    set nrTokens [llength $tokens]
           24  +    set tokenCursor 0
           25  +
           26  +#puts T:\t[join $tokens \nT:\t]
           27  +    return [parseValue $tokens $nrTokens tokenCursor]
           28  +}
           29  +
           30  +# Parse multiple JSON entities in a string into a list of dictionaries
           31  +# @param jsonText JSON text to parse
           32  +# @param max      Max number of entities to extract.
           33  +# @return list of (dict (or list) containing the objects) represented by $jsonText
           34  +proc ::json::many-json2dict_tcl {jsonText {max -1}} {
           35  +    variable tokenRE
           36  +
           37  +    if {$max == 0} {
           38  +	return -code error -errorCode {JSON BAD-LIMIT ZERO} \
           39  +	    "Bad limit 0 of json entities to extract."
           40  +    }
           41  +
           42  +    set tokens [regexp -all -inline -- $tokenRE $jsonText]
           43  +    set nrTokens [llength $tokens]
           44  +    set tokenCursor 0
           45  +
           46  +    set result {}
           47  +    set found 0
           48  +    set n $max
           49  +    while {$n != 0} {
           50  +	if {$tokenCursor >= $nrTokens} break
           51  +	lappend result [parseValue $tokens $nrTokens tokenCursor]
           52  +	incr found
           53  +	if {$n > 0} {incr n -1}
           54  +    }
           55  +
           56  +    if {$n > 0} {
           57  +	return -code error -errorCode {JSON BAD-LIMIT TOO LARGE} \
           58  +	    "Bad limit $max of json entities to extract, found only $found."
           59  +    }
           60  +
           61  +    return $result
           62  +}
           63  +
           64  +# Throw an exception signaling an unexpected token
           65  +proc ::json::unexpected {tokenCursor token expected} {
           66  +    return -code error -errorcode [list JSON UNEXPECTED $tokenCursor $expected] \
           67  +	"unexpected token \"$token\" at position $tokenCursor; expecting $expected"
           68  +}
           69  +
           70  +# Get rid of the quotes surrounding a string token and substitute the
           71  +# real characters for escape sequences within it
           72  +# @param token
           73  +# @return unquoted unescaped value of the string contained in $token
           74  +proc ::json::unquoteUnescapeString {tokenCursor token} {
           75  +    variable stringREv
           76  +    set unquoted [string range $token 1 end-1]
           77  +
           78  +    if {![regexp $stringREv $token]} {
           79  +	unexpected $tokenCursor $token STRING
           80  +    }
           81  +
           82  +    set res [subst -nocommands -novariables $unquoted]
           83  +    return $res
           84  +}
           85  +
           86  +# Parse an object member
           87  +# @param tokens list of tokens
           88  +# @param nrTokens length of $tokens
           89  +# @param tokenCursorName name (in caller's context) of variable
           90  +#                        holding current position in $tokens
           91  +# @param objectDictName name (in caller's context) of dict
           92  +#                       representing the JSON object of which to
           93  +#                       parse the next member
           94  +proc ::json::parseObjectMember {tokens nrTokens tokenCursorName objectDictName} {
           95  +    upvar $tokenCursorName tokenCursor
           96  +    upvar $objectDictName objectDict
           97  +
           98  +    set token [lindex $tokens $tokenCursor]
           99  +    set tc $tokenCursor
          100  +    incr tokenCursor
          101  +
          102  +    set leadingChar [string index $token 0]
          103  +    if {$leadingChar eq "\""} {
          104  +        set memberName [unquoteUnescapeString $tc $token]
          105  +
          106  +        if {$tokenCursor == $nrTokens} {
          107  +            unexpected $tokenCursor "END" "\":\""
          108  +        } else {
          109  +            set token [lindex $tokens $tokenCursor]
          110  +            incr tokenCursor
          111  +
          112  +            if {$token eq ":"} {
          113  +                set memberValue [parseValue $tokens $nrTokens tokenCursor]
          114  +                dict set objectDict $memberName $memberValue
          115  +            } else {
          116  +                unexpected $tokenCursor $token "\":\""
          117  +            }
          118  +        }
          119  +    } else {
          120  +        unexpected $tokenCursor $token "STRING"
          121  +    }
          122  +}
          123  +
          124  +# Parse the members of an object
          125  +# @param tokens list of tokens
          126  +# @param nrTokens length of $tokens
          127  +# @param tokenCursorName name (in caller's context) of variable
          128  +#                        holding current position in $tokens
          129  +# @param objectDictName name (in caller's context) of dict
          130  +#                       representing the JSON object of which to
          131  +#                       parse the next member
          132  +proc ::json::parseObjectMembers {tokens nrTokens tokenCursorName objectDictName} {
          133  +    upvar $tokenCursorName tokenCursor
          134  +    upvar $objectDictName objectDict
          135  +
          136  +    while true {
          137  +        parseObjectMember $tokens $nrTokens tokenCursor objectDict
          138  +
          139  +        set token [lindex $tokens $tokenCursor]
          140  +        incr tokenCursor
          141  +
          142  +        switch -exact $token {
          143  +            "," {
          144  +                # continue
          145  +            }
          146  +            "\}" {
          147  +                break
          148  +            }
          149  +            default {
          150  +                unexpected $tokenCursor $token "\",\"|\"\}\""
          151  +            }
          152  +        }
          153  +    }
          154  +}
          155  +
          156  +# Parse an object
          157  +# @param tokens list of tokens
          158  +# @param nrTokens length of $tokens
          159  +# @param tokenCursorName name (in caller's context) of variable
          160  +#                        holding current position in $tokens
          161  +# @return parsed object (Tcl dict)
          162  +proc ::json::parseObject {tokens nrTokens tokenCursorName} {
          163  +    upvar $tokenCursorName tokenCursor
          164  +
          165  +    if {$tokenCursor == $nrTokens} {
          166  +        unexpected $tokenCursor "END" "OBJECT"
          167  +    } else {
          168  +        set result [dict create]
          169  +
          170  +        set token [lindex $tokens $tokenCursor]
          171  +
          172  +        if {$token eq "\}"} {
          173  +            # empty object
          174  +            incr tokenCursor
          175  +        } else {
          176  +            parseObjectMembers $tokens $nrTokens tokenCursor result
          177  +        }
          178  +
          179  +        return $result
          180  +    }
          181  +}
          182  +
          183  +# Parse the elements of an array
          184  +# @param tokens list of tokens
          185  +# @param nrTokens length of $tokens
          186  +# @param tokenCursorName name (in caller's context) of variable
          187  +#                        holding current position in $tokens
          188  +# @param resultName name (in caller's context) of the list
          189  +#                   representing the JSON array
          190  +proc ::json::parseArrayElements {tokens nrTokens tokenCursorName resultName} {
          191  +    upvar $tokenCursorName tokenCursor
          192  +    upvar $resultName result
          193  +
          194  +    while true {
          195  +        lappend result [parseValue $tokens $nrTokens tokenCursor]
          196  +
          197  +        if {$tokenCursor == $nrTokens} {
          198  +            unexpected $tokenCursor "END" "\",\"|\"\]\""
          199  +        } else {
          200  +            set token [lindex $tokens $tokenCursor]
          201  +            incr tokenCursor
          202  +
          203  +            switch -exact $token {
          204  +                "," {
          205  +                    # continue
          206  +                }
          207  +                "\]" {
          208  +                    break
          209  +                }
          210  +                default {
          211  +                    unexpected $tokenCursor $token "\",\"|\"\]\""
          212  +                }
          213  +            }
          214  +        }
          215  +    }
          216  +}
          217  +
          218  +# Parse an array
          219  +# @param tokens list of tokens
          220  +# @param nrTokens length of $tokens
          221  +# @param tokenCursorName name (in caller's context) of variable
          222  +#                        holding current position in $tokens
          223  +# @return parsed array (Tcl list)
          224  +proc ::json::parseArray {tokens nrTokens tokenCursorName} {
          225  +    upvar $tokenCursorName tokenCursor
          226  +
          227  +    if {$tokenCursor == $nrTokens} {
          228  +        unexpected $tokenCursor "END" "ARRAY"
          229  +    } else {
          230  +        set result {}
          231  +
          232  +        set token [lindex $tokens $tokenCursor]
          233  +
          234  +        set leadingChar [string index $token 0]
          235  +        if {$leadingChar eq "\]"} {
          236  +            # empty array
          237  +            incr tokenCursor
          238  +        } else {
          239  +            parseArrayElements $tokens $nrTokens tokenCursor result
          240  +        }
          241  +
          242  +        return $result
          243  +    }
          244  +}
          245  +
          246  +# Parse a value
          247  +# @param tokens list of tokens
          248  +# @param nrTokens length of $tokens
          249  +# @param tokenCursorName name (in caller's context) of variable
          250  +#                        holding current position in $tokens
          251  +# @return parsed value (dict, list, string, number)
          252  +proc ::json::parseValue {tokens nrTokens tokenCursorName} {
          253  +    upvar $tokenCursorName tokenCursor
          254  +
          255  +    if {$tokenCursor == $nrTokens} {
          256  +        unexpected $tokenCursor "END" "VALUE"
          257  +    } else {
          258  +        set token [lindex $tokens $tokenCursor]
          259  +	set tc $tokenCursor
          260  +        incr tokenCursor
          261  +
          262  +        set leadingChar [string index $token 0]
          263  +        switch -exact -- $leadingChar {
          264  +            "\{" {
          265  +                return [parseObject $tokens $nrTokens tokenCursor]
          266  +            }
          267  +            "\[" {
          268  +                return [parseArray $tokens $nrTokens tokenCursor]
          269  +            }
          270  +            "\"" {
          271  +                # quoted string
          272  +                return [unquoteUnescapeString $tc $token]
          273  +            }
          274  +            "t" -
          275  +            "f" -
          276  +            "n" {
          277  +                # bare word: true, false, null (return as is)
          278  +                return $token
          279  +            }
          280  +            default {
          281  +                # number?
          282  +                if {[string is double -strict $token]} {
          283  +                    return $token
          284  +                } else {
          285  +                    unexpected $tokenCursor $token "VALUE"
          286  +                }
          287  +            }
          288  +        }
          289  +    }
          290  +}

Added build/web/kitcreator.vfs/lib/json/json_write.tcl version [2c890932e8].

            1  +# json_write.tcl --
            2  +#
            3  +#	Commands for the generation of JSON (Java Script Object Notation).
            4  +#
            5  +# Copyright (c) 2009-2011 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.2 2011/08/24 20:09:44 andreas_kupries Exp $
           11  +
           12  +# ### ### ### ######### ######### #########
           13  +## Requisites
           14  +
           15  +package require Tcl 8.5
           16  +
           17  +namespace eval ::json::write {
           18  +    namespace export \
           19  +	string array object indented aligned
           20  +
           21  +    namespace ensemble create
           22  +}
           23  +
           24  +# ### ### ### ######### ######### #########
           25  +## API.
           26  +
           27  +proc ::json::write::indented {{bool {}}} {
           28  +    variable indented
           29  +
           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\""
           35  +	}
           36  +	set indented $bool
           37  +	if {!$indented} {
           38  +	    variable aligned 0
           39  +	}
           40  +    }
           41  +
           42  +    return $indented
           43  +}
           44  +
           45  +proc ::json::write::aligned {{bool {}}} {
           46  +    variable aligned
           47  +
           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\""
           53  +	}
           54  +	set aligned $bool
           55  +	if {$aligned} {
           56  +	    variable indented 1
           57  +	}
           58  +    }
           59  +
           60  +    return $aligned
           61  +}
           62  +
           63  +proc ::json::write::string {s} {
           64  +    variable quotes
           65  +    return "\"[::string map $quotes $s]\""
           66  +}
           67  +
           68  +proc ::json::write::array {args} {
           69  +    # always compact form.
           70  +    return "\[[join $args ,]\]"
           71  +}
           72  +
           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.
           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  +
          126  +proc ::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  +
          136  +proc ::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  +
          150  +proc ::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  +
          157  +namespace 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  +	     \x00 \\u0000 \x01 \\u0001 \x02 \\u0002 \x03 \\u0003 \
          180  +	     \x04 \\u0004 \x05 \\u0005 \x06 \\u0006 \x07 \\u0007 \
          181  +	     \x0b \\u000b \x0e \\u000e \x0f \\u000f \x10 \\u0010 \
          182  +	     \x11 \\u0011 \x12 \\u0012 \x13 \\u0013 \x14 \\u0014 \
          183  +	     \x15 \\u0015 \x16 \\u0016 \x17 \\u0017 \x18 \\u0018 \
          184  +	     \x19 \\u0019 \x1a \\u001a \x1b \\u001b \x1c \\u001c \
          185  +	     \x1d \\u001d \x1e \\u001e \x1f \\u001f \x7f \\u007f \
          186  +	     \x80 \\u0080 \x81 \\u0081 \x82 \\u0082 \x83 \\u0083 \
          187  +	     \x84 \\u0084 \x85 \\u0085 \x86 \\u0086 \x87 \\u0087 \
          188  +	     \x88 \\u0088 \x89 \\u0089 \x8a \\u008a \x8b \\u008b \
          189  +	     \x8c \\u008c \x8d \\u008d \x8e \\u008e \x8f \\u008f \
          190  +	     \x90 \\u0090 \x91 \\u0091 \x92 \\u0092 \x93 \\u0093 \
          191  +	     \x94 \\u0094 \x95 \\u0095 \x96 \\u0096 \x97 \\u0097 \
          192  +	     \x98 \\u0098 \x99 \\u0099 \x9a \\u009a \x9b \\u009b \
          193  +	     \x9c \\u009c \x9d \\u009d \x9e \\u009e \x9f \\u009f ]
          194  +}
          195  +
          196  +# ### ### ### ######### ######### #########
          197  +## Ready
          198  +
          199  +package provide json::write 1.0.3
          200  +return

Added build/web/kitcreator.vfs/lib/json/jsonc.tcl version [28dc982541].

            1  +# jsonc.tcl --
            2  +#
            3  +#       Implementation of a JSON parser in C.
            4  +#	Binding to a yacc/bison parser by Mikhail.
            5  +#
            6  +# Copyright (c) 2013 - critcl wrapper - Andreas Kupries <andreas_kupries@users.sourceforge.net>
            7  +# Copyright (c) 2013 - C binding      - mi+tcl.tk-2013@aldan.algebra.com
            8  +
            9  +package require critcl
           10  +# @sak notprovided jsonc
           11  +package provide jsonc 1.1.1
           12  +package require Tcl 8.4
           13  +
           14  +#critcl::cheaders -g
           15  +#critcl::debug memory symbols
           16  +critcl::cheaders -Ic c/*.h
           17  +critcl::csources c/*.c
           18  +
           19  +# # ## ### Import base declarations, forwards ### ## # #
           20  +
           21  +critcl::ccode {
           22  +    #include <json_y.h>
           23  +}
           24  +
           25  +# # ## ### Main Conversion ### ## # #
           26  +
           27  +namespace eval ::json {
           28  +    critcl::ccommand json2dict_critcl {dummy I objc objv} {
           29  +	struct context context = { NULL };
           30  +
           31  +	if (objc != 2) {
           32  +	    Tcl_WrongNumArgs(I, 1, objv, "json");
           33  +	    return TCL_ERROR;
           34  +	}
           35  +
           36  +	context.text   = Tcl_GetStringFromObj(objv[1], &context.remaining);
           37  +	context.I      = I;
           38  +	context.has_error = 0;
           39  +	context.result = TCL_ERROR;
           40  +
           41  +	jsonparse (&context);
           42  +	return context.result;
           43  +    }
           44  +
           45  +    # Issue with critcl 2 used here. Cannot use '-', incomplete distinction of C and Tcl names.
           46  +    # The json.tcl file making use of this code has a wrapper fixing the issue.
           47  +    critcl::ccommand many_json2dict_critcl {dummy I objc objv} {
           48  +	struct context context = { NULL };
           49  +
           50  +	int                      max;
           51  +	int                      found;
           52  +
           53  +	Tcl_Obj* result = Tcl_NewListObj (0, NULL);
           54  +
           55  +	if ((objc < 2) || (objc > 3)) {
           56  +	    Tcl_WrongNumArgs(I, 1, objv, "jsonText ?max?");
           57  +	    return TCL_ERROR;
           58  +	}
           59  +
           60  +	if (objc == 3) {
           61  +	    if (Tcl_GetIntFromObj(I, objv[2], &max) != TCL_OK) {
           62  +		return TCL_ERROR;
           63  +	    }
           64  +	    if (max <= 0) {
           65  +		Tcl_AppendResult (I, "Bad limit ",
           66  +				  Tcl_GetString (objv[2]),
           67  +				  " of json entities to extract.",
           68  +				  NULL);
           69  +		Tcl_SetErrorCode (I, "JSON", "BAD-LIMIT", NULL);
           70  +		return TCL_ERROR;
           71  +	    }
           72  +
           73  +	} else {
           74  +	    max = -1;
           75  +	}
           76  +
           77  +	context.text   = Tcl_GetStringFromObj(objv[1], &context.remaining);
           78  +	context.I      = I;
           79  +	context.has_error = 0;
           80  +	found  = 0;
           81  +
           82  +	/* Iterate over the input until
           83  +	 * - we have gotten all requested values.
           84  +	 * - we have run out of input
           85  +	 * - we have run into an error
           86  +	 */
           87  +
           88  +	while ((max < 0) || max) {
           89  +	    context.result = TCL_ERROR;
           90  +	    jsonparse (&context);
           91  +
           92  +	    /* parse error, abort */
           93  +	    if (context.result != TCL_OK) {
           94  +		Tcl_DecrRefCount (result);
           95  +		return TCL_ERROR;
           96  +	    }
           97  +
           98  +	    /* Proper value extracted, extend result */
           99  +	    found ++;
          100  +	    Tcl_ListObjAppendElement(I, result,
          101  +				     Tcl_GetObjResult (I));
          102  +
          103  +	    /* Count down on the number of still missing
          104  +	     * values, if not asking for all (-1)
          105  +	     */
          106  +	    if (max > 0) max --;
          107  +
          108  +	    /* Jump over trailing whitespace for proper end-detection */
          109  +	    jsonskip (&context);
          110  +
          111  +	    /* Abort if we have consumed all input */
          112  +	    if (!context.remaining) break;
          113  +
          114  +	    /* Clear scratch pad before continuing */
          115  +	    context.obj = NULL;
          116  +	}
          117  +
          118  +	/* While all parses were ok we reached end of
          119  +	 * input without getting all requested values,
          120  +	 * this is an error
          121  +	 */
          122  +	if (max > 0) {
          123  +	    char buf [30];
          124  +	    sprintf (buf, "%d", found);
          125  +            Tcl_ResetResult (I);
          126  +	    Tcl_AppendResult (I, "Bad limit ",
          127  +			      Tcl_GetString (objv[2]),
          128  +			      " of json entities to extract, found only ",
          129  +			      buf,
          130  +			      ".",
          131  +			      NULL);
          132  +	    Tcl_SetErrorCode (I, "JSON", "BAD-LIMIT", "TOO", "LARGE", NULL);
          133  +	    Tcl_DecrRefCount (result);
          134  +	    return TCL_ERROR;
          135  +	}
          136  +
          137  +	/* We are good and done */
          138  +	Tcl_SetObjResult(I, result);
          139  +	return TCL_OK;
          140  +    }
          141  +
          142  +    if 0 {critcl::ccommand validate_critcl {dummy I objc objv} {
          143  +	struct context context = { NULL };
          144  +
          145  +	if (objc != 2) {
          146  +	    Tcl_WrongNumArgs(I, 1, objv, "jsonText");
          147  +	    return TCL_ERROR;
          148  +	}
          149  +
          150  +	context.text   = Tcl_GetStringFromObj(objv[1], &context.remaining);
          151  +	context.I      = I;
          152  +	context.result = TCL_ERROR;
          153  +
          154  +	/* Iterate over the input until we have run
          155  +	 * out of text, or encountered an error. We
          156  +	 * use only the lexer here, and told it to not
          157  +	* create superfluous token values.
          158  +	 */
          159  +
          160  +	while (context.remaining) {
          161  +	    if (jsonlex (&context) == -1) {
          162  +		Tcl_SetObjResult(I, Tcl_NewBooleanObj (0));
          163  +		return TCL_OK;
          164  +	    }
          165  +	}
          166  +
          167  +	/* We are good and done */
          168  +	Tcl_SetObjResult(I, Tcl_NewBooleanObj (1));
          169  +	return TCL_OK;
          170  +    }}
          171  +}

Added build/web/kitcreator.vfs/lib/json/pkgIndex.tcl version [7808338db3].

            1  +# Tcl package index file, version 1.1
            2  +
            3  +if {![package vsatisfies [package provide Tcl] 8.4]} {return}
            4  +package ifneeded json 1.3.3 [list source [file join $dir json.tcl]]
            5  +
            6  +if {![package vsatisfies [package provide Tcl] 8.5]} {return}
            7  +package ifneeded json::write 1.0.3 [list source [file join $dir json_write.tcl]]