## -*- tcl -*- # # ## ### ##### ######## ############# ##################### ## CMDR - Help - Help support. # @@ Meta Begin # Package cmdr::help 0 # Meta author {Andreas Kupries} # Meta location https://core.tcl.tk/akupries/cmdr # Meta platform tcl # Meta summary Internal. Utilities for help text formatting and setup. # Meta description Internal. Utilities for help text formatting and setup. # Meta subject {command line} # Meta require {Tcl 8.5-} # Meta require debug # Meta require debug::caller # Meta require lambda # Meta require linenoise # Meta require textutil::adjust # Meta require cmdr::util # Meta require cmdr::pager # @@ Meta End # # ## ### ##### ######## ############# ##################### ## Requisites package require Tcl 8.5 package require debug package require debug::caller package require lambda package require linenoise package require textutil::adjust package require cmdr::util package require cmdr::pager # # ## ### ##### ######## ############# ##################### debug define cmdr/help debug level cmdr/help debug prefix cmdr/help {[debug caller] | } debug prefix cmdr/help/short {| } # # ## ### ##### ######## ############# ##################### ## Definition namespace eval ::cmdr { namespace export help namespace ensemble create } namespace eval ::cmdr::help { namespace export query format auto auto-option namespace ensemble create namespace import ::cmdr::tty } # # ## ### ##### ######## ############# ##################### ## A helper to resolve a chain of words (i.e. command name path) to ## the actor responsible for that command, starting from the specified ## actor. proc ::cmdr::help::query {actor words} { debug.cmdr/help {} set root [$actor root] set prefix $words if {![$root exists *in-shell*] || ![$root get *in-shell*]} { # Not in the shell, put executable's name into the prefix. set prefix [linsert $prefix 0 [$root name]] } return [[$actor find $words] help $prefix] } # # ## ### ##### ######## ############# ##################### ## The internal support command dynamically generating and inserting ## the user's --help option. This is restricted to the root actor. proc ::cmdr::help::auto-option {actor} { $actor learn { option help { Show the help of the application or of the current command, and stop. } { alias h alias ? presence when-set [lambda {p x} { # Invoke the help command which will be generated and # inserted below. set root [$p config context root] if {[$root exists *prefix*]} { debug.cmdr/help/short {/prefix $root ([$root get *prefix*])} # Invoke help for the current command. $root do help {*}[$root get *prefix*] } else { # Invoke global help. $root do help } # Prevent any other processing. return -code error -errorcode {CMDR QUIT} Quit }] } } return } # # ## ### ##### ######## ############# ##################### ## The internal support command dynamically generating and inserting ## the user's help command into the specified actor. See officer.tcl, ## method 'Setup' for the place where this gets used. If the actor is ## the root of the hierarchy a global option --help is added as well. proc ::cmdr::help::auto {actor} { debug.cmdr/help {} # Auto create options based on the help formats found installed foreach c [lsort -dict [info commands {::cmdr::help::format::[a-z]*}]] { set format [namespace tail $c] # Skip the imported helper commands which are NOT formats if {[string match query* $format]} continue lappend formats --$format lappend options [string map [list @c@ $format] { option @c@ { Activate @c@ form of the help. } { presence when-set [lambda {p x} { $p config @format set @c@ }] }}] } # Standard options # - line width to format against. # - disable paging lappend options { option width { The line width to format the help for. Defaults to the terminal width, or 80 when no terminal is available. } { alias w validate integer ;# better: integer > 0, or even > 10 generate [lambda {p} { linenoise columns }] } option no-pager { Disable use of paging. } { presence } } lappend map @formats@ [linsert [join $formats {, }] end-1 and] lappend map @options@ [join $options \n] $actor extend help [string map $map { section *AutoGenerated* description { Retrieve help for a command or command set. Without arguments help for all commands is given. The default format is --full. } @options@ state format { Format of the help to generate. This field is fed by the options @formats@. } { default {} } input cmdname { The entire command line, the name of the command to get help for. This can be several words. } { optional ; list } }] [list ::cmdr::help::auto-help $actor] return } # # ## ### ##### ######## ############# ##################### ## Implementation/back-end of the generated help. ## The bridge between cmd hierarchy and actual generation. proc ::cmdr::help::auto-help {actor config} { debug.cmdr/help {} set width [$config @width] set nopage [$config @no-pager] set words [$config @cmdname] set format [$config @format] if {$format eq {}} { # The chosen default format depends on the presence of # additional arguments, i.e. if a specific command is asked # for, or not, and the general context (root, leaf, inner # node). if {[llength $words]} { set sub [$actor find $words] if {[llength [$sub children]]} { # Interior command node set format short } else { set format full } } else { set format by-category } } set text [format $format \ [$actor root] \ $width \ [cmdr util dictsort \ [query $actor $words]]] # Determine how to show the help, in a pager, or not ? if {$nopage} { puts $text } else { cmdr pager $text } return } # # ## ### ##### ######## ############# ##################### namespace eval ::cmdr::help::format { namespace export full list short by-category namespace ensemble create } # Alternate formats: # List # Short # By-Category # ... entirely different formats (json, .rst, docopts, ...) # ... See help_json.tcl, help_sql.tcl, and help_tcl.tcl for examples. # # # ## ### ##### ######## ############# ##################### ## Full list of commands, with full description (text and parameters) proc ::cmdr::help::format::full {root width help} { debug.cmdr/help {} # help = dict (name -> command) set result {} dict for {cmd desc} $help { lappend result [Full $width $cmd $desc] } return [join $result \n] } proc ::cmdr::help::format::Full {width name command} { # Data structure: see config.tcl, method 'help'. # Data structure: see private.tcl, method 'help'. dict with command {} ; # -> desc, options, arguments, parameters # Short line. lappend lines \ [string trimright \ "[join $name] [HasOptions $options][Arguments $arguments $parameters]"] if {$desc ne {}} { # plus description set w [expr {$width - 5}] set w [expr {$w < 1 ? 1 : $w}] lappend lines [textutil::adjust::indent \ [textutil::adjust::adjust $desc \ -length $w -strictlength 1] \ { }] } # plus per-option descriptions (sort by flag name) if {[dict size $options]} { set onames {} set odefs {} foreach {oname ohelp} [::cmdr util dictsort $options] { set oname [OptionName $oname parameters opt2para] lappend onames $oname lappend odefs $ohelp } DefList $width $onames $odefs } # plus per-argument descriptions (keep in cmdline order) if {[llength $arguments]} { set anames {} set adefs {} foreach aname $arguments { set v [dict get $parameters $aname] dict with v {} ; # -> code, description, label lappend anames $label lappend adefs $description } DefList $width $anames $adefs } lappend lines "" return [join $lines \n] } # # ## ### ##### ######## ############# ##################### ## List of commands. Nothing else. proc ::cmdr::help::format::list {root width help} { debug.cmdr/help {} # help = dict (name -> command) set result {} dict for {cmd desc} $help { lappend result [List $width $cmd $desc] } return [join $result \n] } proc ::cmdr::help::format::List {width name command} { # Data structure: see config.tcl, method 'help'. # Data structure: see private.tcl, method 'help'. dict with command {} ; # -> desc, options, arguments, parameters # Short line. lappend lines \ [string trimright \ " [join $name] [HasOptions $options][Arguments $arguments $parameters]"] return [join $lines \n] } # # ## ### ##### ######## ############# ##################### ## List of commands with basic description. No parameter information. proc ::cmdr::help::format::short {root width help} { debug.cmdr/help {} # help = dict (name -> command) set result {} dict for {cmd desc} $help { lappend result [Short $width $cmd $desc] } return [join $result \n] } proc ::cmdr::help::format::Short {width name command} { # Data structure: see config.tcl, method 'help'. # Data structure: see private.tcl, method 'help'. dict with command {} ; # -> desc, options, arguments, parameters # Short line. lappend lines \ [string trimright \ "[join $name] [HasOptions $options][Arguments $arguments $parameters]"] if {$desc ne {}} { # plus description set w [expr {$width - 5}] set w [expr {$w < 1 ? 1 : $w}] lappend lines [textutil::adjust::indent \ [textutil::adjust::adjust $desc \ -length $w -strictlength 1] \ { }] } lappend lines "" return [join $lines \n] } # # ## ### ##### ######## ############# ##################### ## Show help by category/ies proc ::cmdr::help::format::by-category {root width help} { debug.cmdr/help {name ([$root name])} # I. Extract the category information from the help structure and # generate the tree of categories with their commands. lassign [SectionTree $help [$root name]] subc cmds # II. Order the main categories. Allow for user influences. set categories [SectionOrder $root $subc] # III. Take the category tree and do the final formatting. set lines {} foreach c $categories { ShowCategory $width lines [::list $c] "" } return [join $lines \n] } proc ::cmdr::help::format::ShowCategory {width lv path indent} { upvar 1 $lv lines cmds cmds subc subc # Print category header lappend lines "$indent[lindex $path end]" # Indent the commands and sub-categories a bit more... append indent " " set sep " " # Get the commands in the category, preliminary formatting # (labels, descriptions). set names {} set descs {} if {[dict exists $cmds $path]} { foreach def [lsort -dict -unique -index 0 [dict get $cmds $path]] { lassign $def syntax desc lappend names $syntax lappend descs $desc } } set labels [cmdr util padr $names] # With the padding all labels are the same length. We can # precompute the blank and the width to format the descriptions # into. regsub -all {[^\t]} "$indent[lindex $labels 0]$sep" { } blank set w [expr {$width - [string length $blank]}] if {$w < 10} { # Force a minimum size for the description. This will cause # either cutting at the terminal width, and/or wrapping into # the next line, depending on the terminal. set w 10 } # Print the commands, final formatting. set commands 0 foreach label $labels desc $descs { set desc [textutil::adjust::adjust $desc \ -length $w \ -strictlength 1] set desc [textutil::adjust::indent $desc $blank 1] lappend lines $indent$label$sep$desc set commands 1 } if {$commands} { # Separate sub-categories and commands with an empty line. lappend lines {} } if {![dict exists $subc $path]} return # Print the sub-categories, if any. foreach c [lsort -dict -unique [dict get $subc $path]] { ShowCategory $width lines [linsert $path end $c] $indent } return } # # ## ### ##### ######## ############# ##################### ## Common utility commands. proc ::cmdr::help::format::DefList {width labels defs} { upvar 1 lines lines set labels [cmdr util padr $labels] set nl [string length [lindex $labels 0]] incr nl 5 set blank [string repeat { } $nl] lappend lines "" foreach l $labels def $defs { # FUTURE: Consider paragraph breaks in $def (\n\n), # and format them separately. set w [expr {$width - $nl}] set w [expr {$w < 1 ? 1 : $w}] lappend lines " $l [textutil::adjust::indent \ [textutil::adjust::adjust $def \ -length $w -strictlength 1] \ $blank 1]" } return } proc ::cmdr::help::format::Arguments {arguments parameters} { set result {} foreach a $arguments { set v [dict get $parameters $a] dict with v {} ; # -> code, desc, label switch -exact -- $code { + { set text "<$label>" } ? { set text "\[<${label}>\]" } +* { set text "<${label}>..." } ?* { set text "\[<${label}>...\]" } } lappend result $text } return [join $result] } proc ::cmdr::help::format::HasOptions {options} { if {[dict size $options]} { return "\[OPTIONS\] " } else { return {} } } proc ::cmdr::help::format::SectionTree {help root {fmtname 1}} { array set opts {} ;# cmd -> option -> odesc array set subc {} ;# category path -> list (child category path) array set cmds {} ;# category path -> list (cmd) # cmd = tuple (label description) dict for {name def} $help { dict with def {} ; # -> desc, arguments, parameters, sections # Do not show the auto-generated commands in the categorized help. if {"*AutoGenerated*" in $sections} { continue } # Exclude officers from the categorized help. They can only be # a source of shared options. Shared options are collected in # a separate structure. if {![info exists action] && [dict size $options]} { set opts($name) [::list $options $parameters $opt2para] continue } if {![llength $sections]} { lappend sections Miscellaneous } if {$fmtname} { append name " " [Arguments $arguments $parameters] } set desc [lindex [split $desc .] 0] set cmd [::list [string trim $name] $desc] foreach category $sections { lappend cmds($category) $cmd LinkParent $category } } # Options for the root => global options, put into the section tree. # We are ignoring deeper shared options. if {[info exists opts($root)]} { lassign $opts($root) options parameters opt2para set category {Global Options} lappend sections $category set category [::list $category] foreach {o d} [::cmdr util dictsort $options] { set o [OptionName $o parameters opt2para] lappend cmds($category) [::list $o [string trim $d]] LinkParent $category } unset opts($root) } # puts ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ # parray subc # parray cmds # parray opts # puts ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ::list [array get subc] [array get cmds] } proc ::cmdr::help::format::OptionName {oname pv ov} { upvar 1 $pv parameters $ov opt2para # Inspect the parameter and determine of the option # requires an argument. If yes, suitably extend the # definition key of the option list. set pname [dict get $opt2para $oname] set vt [dict get $parameters $pname validator] if {$vt ne "::cmdr::validate::boolean"} { if {[dict exists $parameters $pname arglabel]} { set plabel [dict get $parameters $pname arglabel] } else { set plabel [dict get $parameters $pname label] } append oname " [string toupper $plabel]" } return $oname } proc ::cmdr::help::format::LinkParent {category} { if {![llength $category]} return upvar 1 subc subc set parent [lreverse [lassign [lreverse $category] leaf]] lappend subc($parent) $leaf LinkParent $parent return } proc ::cmdr::help::format::SectionOrder {root subc} { # IIa. Natural order first. set categories [lsort -dict -unique [dict get $subc {}]] set generated { Miscellaneous {Global Options} } # IIb. Look for and apply user overrides. if {[$root exists *category-order*]} { # Record natural order set n 0 foreach c $categories { dict set map $c $n incr n -10 } # Special treatment of generated categories, move to end. set end -10000 foreach c $generated { if {$c ni $categories} continue dict set map $c $end incr end -10000 } # Overwrite natural with custom ordering. dict for {c n} [$root get *category-order*] { if {$c ni $categories} continue dict set map $c $n } # Rewrite into tuples. foreach {c n} $map { lappend tmp [::list $n $c] } #puts [join [lsort -decreasing -integer -index 0 $tmp] \n] # Sort tuples into chosen order, and rewrite back to list of # plain categories. set categories {} foreach item [lsort -decreasing -integer -index 0 $tmp] { lappend categories [lindex $item 1] } } else { # Without a bespoke ordering only the generated categories are # treated specially. foreach c $generated { set pos [lsearch -exact $categories $c] if {$pos < 0} continue set categories [linsert [lreplace $categories $pos $pos] end $c] } } return $categories } # # ## ### ##### ######## ############# ##################### ## Ready package provide cmdr::help 1.3.2