Добавлены функции для работы с JSON

lib/function.tcl

@@ -340,23 +340,6 @@ proc GetWorkTreeRow {} {
     return $lst
 }
 
-proc JsonGet {json args} {
-    foreach key $args {
-        if {[dict exists $json $key]} {
-            set json [dict get $json $key]
-        } elseif {[string is integer $key]} {
-            if {$key >= 0 && $key < [llength $json]} {
-                set json [lindex $json $key]
-            } else {
-                error "can't get item number $key from {$json}"
-            }
-        } else {
-            error "can't get \"$key\": no such key in {$json}"
-        }
-    }
-    return $json
-}
-
 proc CreateInfoBasesJSONfile {} {
     global default dir
     set info_base_json_file [file join $dir(work) infobases.lst]
@@ -2479,3 +2462,5 @@ proc Del::inet {tree host profile_name} {
 
 
 
+
+

lib/json.tcl

@@ -0,0 +1,59 @@
+proc tcl2json value {
+    # https://rosettacode.org/wiki/JSON#Tcl
+    # Guess the type of the value; deep *UNSUPPORTED* magic!
+    regexp {^value is a (.*?) with a refcount} \
+        [::tcl::unsupported::representation $value] -> type
+ 
+    switch $type {
+        string {
+            return [json::write string $value]
+        }
+        dict {
+            return [json::write object {*}[
+                dict map {k v} $value {tcl2json $v}]]
+        }
+        list {
+            return [json::write array {*}[lmap v $value {tcl2json $v}]]
+        }
+        int - double {
+            return [expr {$value}]
+        }
+        booleanString {
+            return [expr {$value ? "true" : "false"}]
+        }
+        default {
+            # Some other type; do some guessing...
+            if {$value eq "null"} {
+                # Tcl has *no* null value at all; empty strings are semantically
+                # different and absent variables aren't values. So cheat!
+                return $value
+            } elseif {[string is integer -strict $value]} {
+                return [expr {$value}]
+            } elseif {[string is double -strict $value]} {
+                return [expr {$value}]
+            } elseif {[string is boolean -strict $value]} {
+                return [expr {$value ? "true" : "false"}]
+            }
+            return [json::write string $value]
+        }
+    }
+}
+
+proc jsonget {json args} {
+    # https://wiki.tcl-lang.org/page/JSON
+    foreach key $args {
+        if {[dict exists $json $key]} {
+            set json [dict get $json $key]
+        } elseif {[string is integer $key]} {
+            if {$key >= 0 && $key < [llength $json]} {
+                set json [lindex $json $key]
+            } else {
+                error "can't get item number $key from {$json}"
+            }
+        } else {
+            error "can't get \"$key\": no such key in {$json}"
+        }
+    }
+    return $json
+}
+