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 Unified Diffs Ignore Whitespace Patch

Deleted NOTES.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
"Global" options.

(1) Specification
	Officers are extended
**	(a)	with a spec command 'option', equivalent to the same
		for 'private's.
**	(b)	with a cmdr::config instance.

(2) Semantics
**	The global options of an officer O are automatically visible
	to all its sub-ordinates.

**	This is done by importing them into the cmdr::config of the
	sub-ordinate at the time it is processing its own specification.

**	This means that sub-ordinates _cannot_ specify their own
	options with the same name.

**	An exception is the generation of help, where the options of
	the officer are only seen by the officer itself, and none of
	the sub-ordinates. This will unclutter the individual commands
	which otherwise would show all the .use'd options.

**	The import also means that the backend code can access these
	option parameters directly, without having to walk up in the
	command tree. There is no need to extend officers with
	accessor commands.

(2) Processing
**	(a)	Setup of officers and privates imports the parameters
		of their direct superior officer. As that officer
		in turn imported from their own superior all global
		options automatically spread down the entire tree.

**	(b)	Cmdline processing in officers is extended to check
		for options and handle them if known, or throw an
		error if not.

(3) Help
**	(a)	Imported parameters of an officer or private are
		excluded from the generated help.

TODO	(b)	The help structure is extended so that officers can
		declare the options they understand.
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<






















































































Changes to help.tcl.

323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
...
447
448
449
450
451
452
453
454
455

456
457
458
459
460
461
462
463
464
465
466









467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483


















484
485


486
487
488
489
490
491
492
...
495
496
497
498
499
500
501





502
503
504
505
506
507
508
509
510
511
512


513

514
515
516
517
518
519
520
521
522
523
...
527
528
529
530
531
532
533
534
535

536
537
538
539
540
541
542
543
544
545
546
547
    return [join $lines \n]
}

# # ## ### ##### ######## ############# #####################
## Show help by category/ies

proc ::cmdr::help::format::by-category {root width help} {
    debug.cmdr/help {}

    # I. Extract the category information from the help structure and
    #    generate the tree of categories with their commands.

    lassign [SectionTree $help] 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 {
................................................................................
    if {[dict size $options]} {
	return "\[OPTIONS\] "
    } else {
	return {}
    }
}

proc ::cmdr::help::format::SectionTree {help {fmtname 1}} {


    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
	}










	if {![llength $sections]} {
	    lappend sections Miscellaneous
	}

	if {$fmtname} {
	    append name " " [Arguments $arguments $parameters]
	}
	set    desc [lindex [split $desc .] 0]
	set    cmd  [::list $name $desc]

	foreach category $sections {
	    lappend cmds($category) $cmd
	    LinkParent $category
	}
    }



















    #parray subc
    #parray cmds



    ::list [array get subc] [array get cmds]
}

proc ::cmdr::help::format::LinkParent {category} {
    if {![llength $category]} return
    upvar 1 subc subc
................................................................................
    LinkParent $parent
    return
}

proc ::cmdr::help::format::SectionOrder {root subc} {
    # IIa. Natural order first.
    set categories [lsort -dict -unique [dict get $subc {}]]






    # 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 category, move to end.
	if {"Miscellaneous" in $categories} {


	    dict set map Miscellaneous -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]
	}
................................................................................
	# 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 bespoke ordering only the generated category gets
	# treated specially.

	set pos [lsearch -exact $categories Miscellaneous]
	if {$pos >= 0} {
	    set categories [linsert [lreplace $categories $pos $pos] end Miscellaneous]
	}
    }

    return $categories
}

# # ## ### ##### ######## ############# #####################
## Ready
package provide cmdr::help 1.3






|




|







 







|

>











>
>
>
>
>
>
>
>
>









|







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
|
>
>







 







>
>
>
>
>









|
|
>
>
|
>


|







 







|

>
|
|
|









323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
...
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
...
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
...
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
    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 {
................................................................................
    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) $options
	    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)]} {
	set options $opts($root)

	set category {Global Options}
	lappend sections $category
	set category [::list $category]
	foreach {o d} $options {
	    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::LinkParent {category} {
    if {![llength $category]} return
    upvar 1 subc subc
................................................................................
    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]
	}
................................................................................
	# 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

Changes to help_json.tcl.

62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
...
110
111
112
113
114
115
116


117

118
119
120
121
122
123
124
...
199
200
201
202
203
204
205
206
    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 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]
................................................................................
    # 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]


    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]
    
................................................................................
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.0.1






|







 







>
>
|
>







 







|
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
...
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
...
202
203
204
205
206
207
208
209
    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]
................................................................................
    # 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]
    
................................................................................
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

Changes to help_sql.tcl.

97
98
99
100
101
102
103





104

105

106
107
108
109
110
111
112
...
289
290
291
292
293
294
295
296
    upvar 1 states     xstates
    upvar 1 flags      xflags

    # ---

    dict with command {} ; # -> action, desc, options, arguments, parameters, states






    set cid [SQL::++ commands cno [SQL::astring $name] \

		 [SQL::astring $desc] [SQL::astring $action]]


    set sequence 0
    foreach {pname param} $parameters {
	set pid [SQL::++ parameters pno [SQL::astring $pname] \
		     $cid $sequence \
		     {*}[SQL::para $param]]

................................................................................
	       pid  INTEGER REFERENCES parameters
       );
	CREATE INDEX fname on flags ( name );
    }
}
# # ## ### ##### ######## ############# #####################
## Ready
package provide cmdr::help::sql 1.0






>
>
>
>
>
|
>
|
>







 







|
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
...
296
297
298
299
300
301
302
303
    upvar 1 states     xstates
    upvar 1 flags      xflags

    # ---

    dict with command {} ; # -> action, desc, options, arguments, parameters, states

    if {[info exists action]} {
	set action [SQL::astring $action]
    } {
	set action NULL
    }
    set cid [SQL::++ commands cno \
		 [SQL::astring $name] \
		 [SQL::astring $desc] \
		 $action]

    set sequence 0
    foreach {pname param} $parameters {
	set pid [SQL::++ parameters pno [SQL::astring $pname] \
		     $cid $sequence \
		     {*}[SQL::para $param]]

................................................................................
	       pid  INTEGER REFERENCES parameters
       );
	CREATE INDEX fname on flags ( name );
    }
}
# # ## ### ##### ######## ############# #####################
## Ready
package provide cmdr::help::sql 1.1

Changes to help_tcl.tcl.

58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
...
104
105
106
107
108
109
110


111

112
113
114
115
116
117
118
...
178
179
180
181
182
183
184
185
	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 0] subc cmds
    foreach c [SectionOrder $root $subc] {
	lappend sections [TCL::acategory [::list $c] $cmds $subc]
    }

    return [dict create \
		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



    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
................................................................................
proc ::cmdr::help::format::TCL::astring {string} {
    regsub -all -- {[ \n\t]+} $string { } string
    return [string trim $string]
}

# # ## ### ##### ######## ############# #####################
## Ready
package provide cmdr::help::tcl 1.0.1






|







 







>
>
|
>







 







|
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
...
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
...
181
182
183
184
185
186
187
188
	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]
................................................................................
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
................................................................................
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

Changes to officer.tcl.

734
735
736
737
738
739
740




741
742
743
744
745
746
747
	set help {}
	foreach c [my known] {
	    set cname [list {*}$prefix $c]
	    set actor [my lookup $c]
	    if {![$actor documented]} continue
	    set help [dict merge $help [$actor help $cname]]
	}




	return $help
    }

    # # ## ### ##### ######## #############

    variable myinit myactions mymap mycommands myccommands mychildren \
	myreplexit myhandler mypmap myshandler myconfig






>
>
>
>







734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
	set help {}
	foreach c [my known] {
	    set cname [list {*}$prefix $c]
	    set actor [my lookup $c]
	    if {![$actor documented]} continue
	    set help [dict merge $help [$actor help $cname]]
	}

	# Add the officer itself, to provide its shared options.
	dict set help $prefix [config help]

	return $help
    }

    # # ## ### ##### ######## #############

    variable myinit myactions mymap mycommands myccommands mychildren \
	myreplexit myhandler mypmap myshandler myconfig