Artifact 22ec78cd80157bde97cdfdf8dd67f360d335626d:

• File help/help_tcl.tcl — part of check-in [b09c92cbff] at 2016-06-22 19:01:38 on branch trunk — Restructured the file hierarchy, sorted the package files into related groups. (user: aku size: 4843)
• File help_tcl.tcl — part of check-in [9660d12cb0] at 2014-11-26 23:12:20 on branch trunk — Followup on [463519edc6]. Fixed missing handling of "arglabel" data in the json, tcl, and sql help formats. (user: andreask size: 4843)

## -*- 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