## -*- tcl -*-
# # ## ### ##### ######## ############# #####################
## CMDR - Help - TCL 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::tcl 1.0.1
# Meta author {Andreas Kupries}
# Meta location https://core.tcl.tk/akupries/cmdr
# Meta platform tcl
# Meta summary Formatting help as TCL data structure (nested dict/list).
# Meta description Formatting help as TCL data structure (nested dict/list).
# 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 End
# # ## ### ##### ######## ############# #####################
## Requisites
package require Tcl 8.5
package require debug
package require debug::caller
package require cmdr::help 1
package require cmdr::util 1
# # ## ### ##### ######## ############# #####################
debug define cmdr/help/tcl
debug level cmdr/help/tcl
debug prefix cmdr/help/tcl {[debug caller] | }
# # ## ### ##### ######## ############# #####################
## Definition
# # ## ### ##### ######## ############# #####################
namespace eval ::cmdr::help::format {
namespace export tcl
namespace ensemble create
namespace import ::cmdr::help::query
}
# # ## ### ##### ######## ############# #####################
proc ::cmdr::help::format::tcl {root width help} {
debug.cmdr/help/tcl {}
# help = dict (name -> command)
# Step 1. Command mapping.
set commands {}
dict for {cmd desc} $help {
lappend commands $cmd [TCL $desc]
}
# 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 [TCL::acategory [::list $c] $cmds $subc]
}
return [dict create \
commands $commands \
sections $sections]
}
# # ## ### ##### ######## ############# #####################
namespace eval ::cmdr::help::format::TCL {}
proc ::cmdr::help::format::TCL::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]] {
lappend commands [lindex $def 0]
}
}
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 [dict create \
name $name \
commands $commands \
sections $sections]
}
proc ::cmdr::help::format::TCL {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
if {[info exists action]} {
# Missing for officers.
lappend dict action $action
}
lappend dict arguments $arguments
lappend dict description [TCL::astring $desc]
lappend dict opt2para [::cmdr util dictsort $opt2para]
lappend dict options [::cmdr util dictsort $options]
lappend dict parameters [TCL::parameters $parameters]
lappend dict sections $sections
lappend dict states $states
return $dict
}
proc ::cmdr::help::format::TCL::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 $xdef
}
flags -
@dict {
set value [::cmdr util dictsort $xdef]
}
* {
error "Unknown key \"$xname\", do not know how to format"
#lappend tmp $xname [astring $xdef]
}
}
lappend tmp $xname $value
}
lappend dict $name $tmp
}
return $dict
}
# # ## ### ##### ######## ############# #####################
proc ::cmdr::help::format::TCL::astring {string} {
regsub -all -- {[ \n\t]+} $string { } string
return [string trim $string]
}
# # ## ### ##### ######## ############# #####################
## Ready
package provide cmdr::help::tcl 1.1.1
