## -*- tcl -*- # # ## ### ##### ######## ############# ##################### ## CMDR - Help - JSON format. Not available by default. ## Require this package before creation a commander, so that the ## mdr::help heuristics see and automatically integrate the format. # @@ Meta Begin # Package cmdr::help::json 1.0.1 # Meta author {Andreas Kupries} # Meta location https://core.tcl.tk/akupries/cmdr # Meta platform tcl # Meta summary Formatting help as JSON object. # Meta description Formatting help as JSON object. # Meta subject {command line} # Meta require {Tcl 8.5-} # Meta require debug # Meta require debug::caller # Meta require {cmdr::help 1} # Meta require {cmdr::util 1} # Meta require json::write # @@ Meta End # # ## ### ##### ######## ############# ##################### ## Requisites package require Tcl 8.5 package require debug package require debug::caller package require cmdr::help 1 package require cmdr::util 1 package require json::write # # ## ### ##### ######## ############# ##################### debug define cmdr/help/json debug level cmdr/help/json debug prefix cmdr/help/json {[debug caller] | } # # ## ### ##### ######## ############# ##################### ## Definition # # ## ### ##### ######## ############# ##################### namespace eval ::cmdr::help::format { namespace export json namespace ensemble create namespace import ::cmdr::help::query } # # ## ### ##### ######## ############# ##################### proc ::cmdr::help::format::json {root width help} { debug.cmdr/help/json {} # help = dict (name -> command) # Step 1. Command mapping. set dict {} dict for {cmd desc} $help { lappend dict $cmd [JSON $desc] } set commands [json::write object {*}$dict] # Step 2. Section Tree. This is very similar to # cmdr::help::format::by-category, and re-uses its frontend helper # commands. lassign [SectionTree $help \000 0] subc cmds foreach c [SectionOrder $root $subc] { lappend sections [JSON::acategory [::list $c] $cmds $subc] } return [json::write object \ sections [json::write array {*}$sections] \ commands $commands] } # # ## ### ##### ######## ############# ##################### namespace eval ::cmdr::help::format::JSON {} proc ::cmdr::help::format::JSON::acategory {path cmds subc} { set name [lindex $path end] # With struct::list map we could then also re-use alist. set commands {} if {[dict exists $cmds $path]} { foreach def [lsort -dict -unique [dict get $cmds $path]] { lassign $def cname _ lappend commands [json::write string $cname] } } set sections {} if {[dict exists $subc $path]} { # Add the sub-categories, if any. foreach c [lsort -dict -unique [dict get $subc $path]] { lappend sections [acategory [linsert $path end $c] $cmds $subc] } } return [json::write object \ name [json::write string $name] \ commands [json::write array {*}$commands] \ sections [json::write array {*}$sections]] } proc ::cmdr::help::format::JSON {command} { # Data structure: see config.tcl, method 'help'. # Data structure: see private.tcl, method 'help'. dict with command {} # -> action, desc, options, arguments, parameters, states, sections lappend dict description [JSON::astring $desc] if {[info exists action]} { # Missing for officers. lappend dict action [JSON::alist $action] } lappend dict arguments [JSON::alist $arguments] lappend dict options [JSON::adict $options] lappend dict opt2para [JSON::adict $opt2para] lappend dict states [JSON::alist $states] lappend dict parameters [JSON::parameters $parameters] lappend dict sections [JSON::alist $sections] return [json::write object {*}$dict] } proc ::cmdr::help::format::JSON::parameters {parameters} { set dict {} foreach {name def} [::cmdr util dictsort $parameters] { set tmp {} foreach {xname xdef} [::cmdr util dictsort $def] { switch -glob -- $xname { cmdline - defered - documented - interactive - isbool - list - ordered - presence - required - @bool { # normalize to boolean set value [expr {!!$xdef}] } threshold { # null|integer set value [expr {($xdef eq {}) ? "null" : $xdef}] } code - default - description - prompt - type - label - arglabel - @string { set value [astring $xdef] } generator - validator - @cmdprefix { set value [alist $xdef] } flags - @dict { set value [adict $xdef] } * { error "Unknown key \"$xname\", do not know how to format" #lappend tmp $xname [astring $xdef] } } lappend tmp $xname $value } lappend dict $name [json::write object {*}$tmp] } return [json::write object {*}$dict] } # # ## ### ##### ######## ############# ##################### proc ::cmdr::help::format::JSON::alist {thelist} { set tmp {} foreach w $thelist { lappend tmp [json::write string $w] } return [json::write array {*}$tmp] } proc ::cmdr::help::format::JSON::adict {thedict} { set tmp {} foreach {k v} [::cmdr util dictsort $thedict] { lappend tmp $k [json::write string $v] } return [json::write object {*}$tmp] } proc ::cmdr::help::format::JSON::astring {string} { regsub -all -- {[ \n\t]+} $string { } string return [json::write string [string trim $string]] } # # ## ### ##### ######## ############# ##################### ## Ready package provide cmdr::help::json 1.1.1