cmdr
Check-in [f853a46223]
Not logged in
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Updated help generation to show global options in categorized help. General update to handle officers now appearing in the help structures. Bumped version numbers. All parts done. Notes removed.
Timelines: family | ancestors | descendants | both | global-options
Files: files | file ages | folders
SHA1: f853a462231dd40bd778d729d1ed0089f9a4be6a
User & Date: andreask 2014-08-26 19:45:03
Context
2014-08-26
19:45
Make handling of shared options official. check-in: fc97d9c23b user: andreask tags: trunk
19:45
Updated help generation to show global options in categorized help. General update to handle officers now appearing in the help structures. Bumped version numbers. All parts done. Notes removed. Closed-Leaf check-in: f853a46223 user: andreask tags: global-options
00:11
Bumped version number of the changed packages. Started on help. First, excluded imported parameters from help. check-in: 9a37e9fade user: andreask tags: global-options
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Deleted NOTES.

     1         -"Global" options.
     2         -
     3         -(1) Specification
     4         -	Officers are extended
     5         -**	(a)	with a spec command 'option', equivalent to the same
     6         -		for 'private's.
     7         -**	(b)	with a cmdr::config instance.
     8         -
     9         -(2) Semantics
    10         -**	The global options of an officer O are automatically visible
    11         -	to all its sub-ordinates.
    12         -
    13         -**	This is done by importing them into the cmdr::config of the
    14         -	sub-ordinate at the time it is processing its own specification.
    15         -
    16         -**	This means that sub-ordinates _cannot_ specify their own
    17         -	options with the same name.
    18         -
    19         -**	An exception is the generation of help, where the options of
    20         -	the officer are only seen by the officer itself, and none of
    21         -	the sub-ordinates. This will unclutter the individual commands
    22         -	which otherwise would show all the .use'd options.
    23         -
    24         -**	The import also means that the backend code can access these
    25         -	option parameters directly, without having to walk up in the
    26         -	command tree. There is no need to extend officers with
    27         -	accessor commands.
    28         -
    29         -(2) Processing
    30         -**	(a)	Setup of officers and privates imports the parameters
    31         -		of their direct superior officer. As that officer
    32         -		in turn imported from their own superior all global
    33         -		options automatically spread down the entire tree.
    34         -
    35         -**	(b)	Cmdline processing in officers is extended to check
    36         -		for options and handle them if known, or throw an
    37         -		error if not.
    38         -
    39         -(3) Help
    40         -**	(a)	Imported parameters of an officer or private are
    41         -		excluded from the generated help.
    42         -
    43         -TODO	(b)	The help structure is extended so that officers can
    44         -		declare the options they understand.

Changes to help.tcl.

   323    323       return [join $lines \n]
   324    324   }
   325    325   
   326    326   # # ## ### ##### ######## ############# #####################
   327    327   ## Show help by category/ies
   328    328   
   329    329   proc ::cmdr::help::format::by-category {root width help} {
   330         -    debug.cmdr/help {}
          330  +    debug.cmdr/help {name ([$root name])}
   331    331   
   332    332       # I. Extract the category information from the help structure and
   333    333       #    generate the tree of categories with their commands.
   334    334   
   335         -    lassign [SectionTree $help] subc cmds
          335  +    lassign [SectionTree $help [$root name]] subc cmds
   336    336   
   337    337       # II. Order the main categories. Allow for user influences.
   338    338       set categories [SectionOrder $root $subc]
   339    339   
   340    340       # III. Take the category tree and do the final formatting.
   341    341       set lines {}
   342    342       foreach c $categories {
................................................................................
   447    447       if {[dict size $options]} {
   448    448   	return "\[OPTIONS\] "
   449    449       } else {
   450    450   	return {}
   451    451       }
   452    452   }
   453    453   
   454         -proc ::cmdr::help::format::SectionTree {help {fmtname 1}} {
          454  +proc ::cmdr::help::format::SectionTree {help root {fmtname 1}} {
   455    455   
          456  +    array set opts {} ;# cmd -> option -> odesc
   456    457       array set subc {} ;# category path -> list (child category path)
   457    458       array set cmds {} ;# category path -> list (cmd)
   458    459       #                    cmd = tuple (label description)
   459    460   
   460    461       dict for {name def} $help {
   461    462   	dict with def {} ; # -> desc, arguments, parameters, sections
   462    463   
   463    464   	# Do not show the auto-generated commands in the categorized help.
   464    465   	if {"*AutoGenerated*" in $sections} {
   465    466   	    continue
   466    467   	}
          468  +
          469  +	# Exclude officers from the categorized help. They can only be
          470  +	# a source of shared options. Shared options are collected in
          471  +	# a separate structure.
          472  +	if {![info exists action] && [dict size $options]} {
          473  +	    set opts($name) $options
          474  +	    continue
          475  +	}
          476  +
   467    477   
   468    478   	if {![llength $sections]} {
   469    479   	    lappend sections Miscellaneous
   470    480   	}
   471    481   
   472    482   	if {$fmtname} {
   473    483   	    append name " " [Arguments $arguments $parameters]
   474    484   	}
   475    485   	set    desc [lindex [split $desc .] 0]
   476         -	set    cmd  [::list $name $desc]
          486  +	set    cmd  [::list [string trim $name] $desc]
   477    487   
   478    488   	foreach category $sections {
   479    489   	    lappend cmds($category) $cmd
   480    490   	    LinkParent $category
   481    491   	}
   482    492       }
   483    493   
   484         -    #parray subc
   485         -    #parray cmds
          494  +    # Options for the root => global options, put into the section tree.
          495  +    # We are ignoring deeper shared options.
          496  +
          497  +    if {[info exists opts($root)]} {
          498  +	set options $opts($root)
          499  +
          500  +	set category {Global Options}
          501  +	lappend sections $category
          502  +	set category [::list $category]
          503  +	foreach {o d} $options {
          504  +	    lappend cmds($category) [::list $o [string trim $d]]
          505  +	    LinkParent $category
          506  +	}
          507  +
          508  +	unset opts($root)
          509  +    }
          510  +
          511  +    # puts ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
          512  +    # parray subc
          513  +    # parray cmds
          514  +    # parray opts
          515  +    # puts ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
   486    516   
   487    517       ::list [array get subc] [array get cmds]
   488    518   }
   489    519   
   490    520   proc ::cmdr::help::format::LinkParent {category} {
   491    521       if {![llength $category]} return
   492    522       upvar 1 subc subc
................................................................................
   495    525       LinkParent $parent
   496    526       return
   497    527   }
   498    528   
   499    529   proc ::cmdr::help::format::SectionOrder {root subc} {
   500    530       # IIa. Natural order first.
   501    531       set categories [lsort -dict -unique [dict get $subc {}]]
          532  +
          533  +    set generated {
          534  +	Miscellaneous
          535  +	{Global Options}
          536  +    }
   502    537   
   503    538       # IIb. Look for and apply user overrides.
   504    539       if {[$root exists *category-order*]} {
   505    540   	# Record natural order
   506    541   	set n 0
   507    542   	foreach c $categories {
   508    543   	    dict set map $c $n
   509    544   	    incr n -10
   510    545   	}
   511         -	# Special treatment of generated category, move to end.
   512         -	if {"Miscellaneous" in $categories} {
   513         -	    dict set map Miscellaneous -10000
          546  +	# Special treatment of generated categories, move to end.
          547  +	set end -10000
          548  +	foreach $c generated {
          549  +	    if {$c ni $categories} continue
          550  +	    dict set map $c $end
          551  +	    incr end -10000
   514    552   	}
   515    553   	# Overwrite natural with custom ordering.
   516         -	dict for {c n}  [$root get *category-order*] {
          554  +	dict for {c n} [$root get *category-order*] {
   517    555   	    if {$c ni $categories} continue
   518    556   	    dict set map $c $n
   519    557   	}
   520    558   	# Rewrite into tuples.
   521    559   	foreach {c n} $map {
   522    560   	    lappend tmp [::list $n $c]
   523    561   	}
................................................................................
   527    565   	# Sort tuples into chosen order, and rewrite back to list of
   528    566   	# plain categories.
   529    567   	set categories {}
   530    568   	foreach item [lsort -decreasing -integer -index 0 $tmp] {
   531    569   	    lappend categories [lindex $item 1]
   532    570   	}
   533    571       } else {
   534         -	# Without bespoke ordering only the generated category gets
          572  +	# Without a bespoke ordering only the generated categories are
   535    573   	# treated specially.
   536         -	set pos [lsearch -exact $categories Miscellaneous]
   537         -	if {$pos >= 0} {
   538         -	    set categories [linsert [lreplace $categories $pos $pos] end Miscellaneous]
          574  +	foreach c $generated {
          575  +	    set pos [lsearch -exact $categories $c]
          576  +	    if {$pos < 0} continue
          577  +	    set categories [linsert [lreplace $categories $pos $pos] end $c]
   539    578   	}
   540    579       }
   541    580   
   542    581       return $categories
   543    582   }
   544    583   
   545    584   # # ## ### ##### ######## ############# #####################
   546    585   ## Ready
   547    586   package provide cmdr::help 1.3

Changes to help_json.tcl.

    62     62       set commands [json::write object {*}$dict]
    63     63   
    64     64   
    65     65       # Step 2. Section Tree. This is very similar to
    66     66       # cmdr::help::format::by-category, and re-uses its frontend helper
    67     67       # commands.
    68     68   
    69         -    lassign [SectionTree $help 0] subc cmds
           69  +    lassign [SectionTree $help \000 0] subc cmds
    70     70       foreach c [SectionOrder $root $subc] {
    71     71   	lappend sections [JSON::acategory [::list $c] $cmds $subc]
    72     72       }
    73     73   
    74     74       return [json::write object \
    75     75   		sections [json::write array {*}$sections] \
    76     76   		commands $commands]
................................................................................
   110    110       # Data structure: see config.tcl,  method 'help'.
   111    111       # Data structure: see private.tcl, method 'help'.
   112    112   
   113    113       dict with command {}
   114    114       # -> action, desc, options, arguments, parameters, states, sections
   115    115   
   116    116       lappend dict description [JSON::astring    $desc]
   117         -    lappend dict action      [JSON::alist      $action]
          117  +    if {[info exists action]} {
          118  +	# Missing for officers.
          119  +	lappend dict action [JSON::alist $action]
          120  +    }
   118    121       lappend dict arguments   [JSON::alist      $arguments]
   119    122       lappend dict options     [JSON::adict      $options]
   120    123       lappend dict opt2para    [JSON::adict      $opt2para]
   121    124       lappend dict states      [JSON::alist      $states]
   122    125       lappend dict parameters  [JSON::parameters $parameters]
   123    126       lappend dict sections    [JSON::alist      $sections]
   124    127       
................................................................................
   199    202   proc ::cmdr::help::format::JSON::astring {string} {
   200    203       regsub -all -- {[ \n\t]+} $string { } string
   201    204       return [json::write string [string trim $string]]
   202    205   }
   203    206   
   204    207   # # ## ### ##### ######## ############# #####################
   205    208   ## Ready
   206         -package provide cmdr::help::json 1.0.1
          209  +package provide cmdr::help::json 1.1

Changes to help_sql.tcl.

    97     97       upvar 1 states     xstates
    98     98       upvar 1 flags      xflags
    99     99   
   100    100       # ---
   101    101   
   102    102       dict with command {} ; # -> action, desc, options, arguments, parameters, states
   103    103   
   104         -    set cid [SQL::++ commands cno [SQL::astring $name] \
   105         -		 [SQL::astring $desc] [SQL::astring $action]]
          104  +    if {[info exists action]} {
          105  +	set action [SQL::astring $action]
          106  +    } {
          107  +	set action NULL
          108  +    }
          109  +    set cid [SQL::++ commands cno \
          110  +		 [SQL::astring $name] \
          111  +		 [SQL::astring $desc] \
          112  +		 $action]
   106    113   
   107    114       set sequence 0
   108    115       foreach {pname param} $parameters {
   109    116   	set pid [SQL::++ parameters pno [SQL::astring $pname] \
   110    117   		     $cid $sequence \
   111    118   		     {*}[SQL::para $param]]
   112    119   
................................................................................
   289    296   	       pid  INTEGER REFERENCES parameters
   290    297          );
   291    298   	CREATE INDEX fname on flags ( name );
   292    299       }
   293    300   }
   294    301   # # ## ### ##### ######## ############# #####################
   295    302   ## Ready
   296         -package provide cmdr::help::sql 1.0
          303  +package provide cmdr::help::sql 1.1

Changes to help_tcl.tcl.

    58     58   	lappend commands $cmd [TCL $desc]
    59     59       }
    60     60   
    61     61       # Step 2. Section Tree. This is very similar to
    62     62       # cmdr::help::format::by-category, and re-uses its frontend helper
    63     63       # commands.
    64     64   
    65         -    lassign [SectionTree $help 0] subc cmds
           65  +    lassign [SectionTree $help \000 0] subc cmds
    66     66       foreach c [SectionOrder $root $subc] {
    67     67   	lappend sections [TCL::acategory [::list $c] $cmds $subc]
    68     68       }
    69     69   
    70     70       return [dict create \
    71     71   		commands $commands \
    72     72   		sections $sections]
................................................................................
   104    104   proc ::cmdr::help::format::TCL {command} {
   105    105       # Data structure: see config.tcl,  method 'help'.
   106    106       # Data structure: see private.tcl, method 'help'.
   107    107   
   108    108       dict with command {}
   109    109       # -> action, desc, options, arguments, parameters, states, sections
   110    110   
   111         -    lappend dict action      $action
          111  +    if {[info exists action]} {
          112  +	# Missing for officers.
          113  +	lappend dict action $action
          114  +    }
   112    115       lappend dict arguments   $arguments
   113    116       lappend dict description [TCL::astring $desc]
   114    117       lappend dict opt2para    [::cmdr util dictsort $opt2para]
   115    118       lappend dict options     [::cmdr util dictsort $options]
   116    119       lappend dict parameters  [TCL::parameters $parameters]
   117    120       lappend dict sections    $sections
   118    121       lappend dict states      $states
................................................................................
   178    181   proc ::cmdr::help::format::TCL::astring {string} {
   179    182       regsub -all -- {[ \n\t]+} $string { } string
   180    183       return [string trim $string]
   181    184   }
   182    185   
   183    186   # # ## ### ##### ######## ############# #####################
   184    187   ## Ready
   185         -package provide cmdr::help::tcl 1.0.1
          188  +package provide cmdr::help::tcl 1.1

Changes to officer.tcl.

   734    734   	set help {}
   735    735   	foreach c [my known] {
   736    736   	    set cname [list {*}$prefix $c]
   737    737   	    set actor [my lookup $c]
   738    738   	    if {![$actor documented]} continue
   739    739   	    set help [dict merge $help [$actor help $cname]]
   740    740   	}
          741  +
          742  +	# Add the officer itself, to provide its shared options.
          743  +	dict set help $prefix [config help]
          744  +
   741    745   	return $help
   742    746       }
   743    747   
   744    748       # # ## ### ##### ######## #############
   745    749   
   746    750       variable myinit myactions mymap mycommands myccommands mychildren \
   747    751   	myreplexit myhandler mypmap myshandler myconfig