cmdr
Check-in [d1d45c1de3]
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:Started implementation of "global" options (and state) associated with officers and inherited to subordinates. Another way of sharing common options (like --debug, --trace, and the like) without cluttering command definitions via *all*. This commit has the specification changes done. Not yet done are recognition during cmdline processing, nor the needed changes to get uncluttered help output, nor the extended help output for officers.
Timelines: family | ancestors | descendants | both | global-options
Files: files | file ages | folders
SHA1: d1d45c1de35ba9cc3abd6023335237f752acc0fb
User & Date: andreask 2014-08-21 01:29:25
Context
2014-08-22
23:22
Added processing of options to officers. Note that this needs an updated tokenizer from Tcllib. Otherwise the main shell will treat cmd options as options of the tokenizer procedure itself, which breaks it. Help handling and generation is the only TODO left. check-in: 3230322f4d user: andreask tags: global-options
2014-08-21
01:29
Started implementation of "global" options (and state) associated with officers and inherited to subordinates. Another way of sharing common options (like --debug, --trace, and the like) without cluttering command definitions via *all*. This commit has the specification changes done. Not yet done are recognition during cmdline processing, nor the needed changes to get uncluttered help output, nor the extended help output for officers. check-in: d1d45c1de3 user: andreask tags: global-options
2014-08-15
23:58
Fixed varname typo in the error handling for escape code definitions. Plus extension of the general colorization command to allow use without a text. This simply returns the control characters. check-in: 509f2d765f user: andreask tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Added 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.

TODO	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.

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

(3) Help
TODO	(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 config.tcl.

25
26
27
28
29
30
31



32
33
34
35
36
37
38
..
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
...
109
110
111
112
113
114
115









116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132


133



134


135
136
137
138
139
140
141
...
502
503
504
505
506
507
508













509
510
511
512
513
514
515
...
529
530
531
532
533
534
535











536
537
538
539
540
541
542
...
552
553
554
555
556
557
558






















559
560
561
562
563
564


565
566
567
568
569
570
571
# Meta require {struct::queue 1}

# @@ Meta End

## - The config manages the argument values, and can parse
##   a command line against the definition, filling values,
##   issuing errors on mismatches, etc.




# # ## ### ##### ######## ############# #####################
## Requisites

package require Tcl 8.5
package require debug
package require debug::caller
................................................................................
    ## Lifecycle.

    forward context context

    # Make self accessible.
    method self {} { self }

    constructor {context spec} {
	debug.cmdr/config {}

	classvariable ourinteractive
	if {![info exists ourinteractive]} { set ourinteractive 0 }

	classvariable ourdisplay
	if {[info exists ourdisplay]} {
	    set mydisplay $ourdisplay
................................................................................
	set mymap      {} ;# parameter name -> object
	set mypub      {} ;# parameter name -> object, non-state only, i.e. user visible
	set myoption   {} ;# option         -> object
	set myfullopt  {} ;# option prefix  -> list of full options having that prefix.
	set myargs     {} ;# List of argument names.
	set mysections {}
	set myinforce  no










	# Import the DSL commands.
	link \
	    {undocumented Undocumented} \
	    {description  Description} \
	    {use          Use} \
	    {input        Input} \
	    {interactive  Interactive} \
	    {option       Option} \
	    {state        State} \
	    {section      Section}

	# Updated in my DefineParameter, called from the $spec
	set splat no

	# Auto inherit common options, state, arguments.
	# May not be defined.


	catch { use *all* }



	eval $spec



	# Postprocessing

	my SetThresholds
	my UniquePrefixes
	my CompletionGraph

................................................................................
    }

    method Section {args} {
	# Remember the help section this private is a part of.
	lappend mysections $args
	return
    }














    # Parameter definition itself.
    # order, cmdline, required, defered (O C R D) name ?spec?
    forward Input     my DefineParameter 1 1 1 0
    forward Option    my DefineParameter 0 1 0 0
    forward State     my DefineParameter 0 0 1 1
    # O+C+R specify the parameter type. D may vary.
................................................................................
	my ValidateAsUnknown $name

	# Create and initialize handler.
	set para [cmdr::parameter create param_$name [self] \
		      $order $cmdline $required $defered \
		      $name $desc $spec]












	# Map parameter name to handler object.
	dict set mymap $name $para

	# And a second map, user-visible parameters only,
	# i.e. available on the cmdline, and documented.
	if {[$para cmdline] && [$para documented]} {
	    dict set mypub $name $para
................................................................................
		dict set myoption $option $para
	    }
	}

	# And the list of all parameters in declaration order, for use
	# in 'force'.
	lappend mynames $name






















	return
    }

    method ValidateAsUnknown {name} {
	debug.cmdr/config {}
	if {![dict exists $mymap $name]} return


	return -code error -errorcode {CMDR CONFIG KNOWN} \
	    "Duplicate parameter \"[context fullname]: $name\", already specified."
    }

    # # ## ### ##### ######## #############
    ## Command completion. This is the entry point for recursion from
    ## the higher level officers, delegated to config from cmdr::private






>
>
>







 







|
|







 







>
>
>
>
>
>
>
>
>












|
|
<
|
|
>
>
|
>
>
>
|
>
>







 







>
>
>
>
>
>
>
>
>
>
>
>
>







 







>
>
>
>
>
>
>
>
>
>
>







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>






>
>







25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
..
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
...
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141

142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
...
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
...
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
...
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
# Meta require {struct::queue 1}

# @@ Meta End

## - The config manages the argument values, and can parse
##   a command line against the definition, filling values,
##   issuing errors on mismatches, etc.

## TODO: Replace the direct ansi color references in state dumps with
##       "cmdr::color" and its symbolic names.

# # ## ### ##### ######## ############# #####################
## Requisites

package require Tcl 8.5
package require debug
package require debug::caller
................................................................................
    ## Lifecycle.

    forward context context

    # Make self accessible.
    method self {} { self }

    constructor {context spec {super {}}} {
	debug.cmdr/config {[context fullname]}

	classvariable ourinteractive
	if {![info exists ourinteractive]} { set ourinteractive 0 }

	classvariable ourdisplay
	if {[info exists ourdisplay]} {
	    set mydisplay $ourdisplay
................................................................................
	set mymap      {} ;# parameter name -> object
	set mypub      {} ;# parameter name -> object, non-state only, i.e. user visible
	set myoption   {} ;# option         -> object
	set myfullopt  {} ;# option prefix  -> list of full options having that prefix.
	set myargs     {} ;# List of argument names.
	set mysections {}
	set myinforce  no

	# Updated in Import and DefineParameter, called from the $spec
	set splat no

	# Import from the 'super', if specified. This is done before
	# the specification is run, as these have priority.
	if {$super ne {}} {
	    my Import $super
	}

	# Import the DSL commands.
	link \
	    {undocumented Undocumented} \
	    {description  Description} \
	    {use          Use} \
	    {input        Input} \
	    {interactive  Interactive} \
	    {option       Option} \
	    {state        State} \
	    {section      Section}

	if {$spec ne {}} {
	    debug.cmdr/config {==== eval spec begin ====}

	    # Auto inherit common options, state, arguments.
	    # May not be defined. Only done if the context
	    # has a specification (=> i.e. is private). For officers we start out empty.
	    try {
		use *all*
	    } trap {CMDR STORE UNKNOWN} {e o} {
		# Swallow possibility of a misisng *all*.
	    }
	    eval $spec
	    debug.cmdr/config {==== eval spec done =====}
	}

	# Postprocessing

	my SetThresholds
	my UniquePrefixes
	my CompletionGraph

................................................................................
    }

    method Section {args} {
	# Remember the help section this private is a part of.
	lappend mysections $args
	return
    }

    # Externally visible variant of the 'Option' specification command.
    method make-option {args} {
	# Splat is a dummy for this.
	set splat no
	my DefineParameter 0 1 0 0 {*}$args
    }
    # Externally visible variant of the 'State' specification command.
    method make-state {args} {
	# Splat is a dummy for this.
	set splat no
	my DefineParameter 0 0 1 1 {*}$args
    }

    # Parameter definition itself.
    # order, cmdline, required, defered (O C R D) name ?spec?
    forward Input     my DefineParameter 1 1 1 0
    forward Option    my DefineParameter 0 1 0 0
    forward State     my DefineParameter 0 0 1 1
    # O+C+R specify the parameter type. D may vary.
................................................................................
	my ValidateAsUnknown $name

	# Create and initialize handler.
	set para [cmdr::parameter create param_$name [self] \
		      $order $cmdline $required $defered \
		      $name $desc $spec]

	my LinkPara $para
	return
    }

    method LinkPara {para} {
	debug.cmdr/config {}
	upvar 1 splat splat

	set name  [$para name]
	set order [$para ordered]

	# Map parameter name to handler object.
	dict set mymap $name $para

	# And a second map, user-visible parameters only,
	# i.e. available on the cmdline, and documented.
	if {[$para cmdline] && [$para documented]} {
	    dict set mypub $name $para
................................................................................
		dict set myoption $option $para
	    }
	}

	# And the list of all parameters in declaration order, for use
	# in 'force'.
	lappend mynames $name

	debug.cmdr/config {/done $name}
	return
    }

    method Import {other} {
	debug.cmdr/config {from [$other context fullname]}

	upvar 1 splat splat
	# Import the parameters from another config instance
	# into ourselves.

	# This is similar to DefineParameter, except that the
	# parameter instances are not created. They already exist and
	# simply have to be linked into the local data structures.

	foreach name [$other names] {
	    debug.cmdr/config {importing $name}
	    my LinkPara [$other lookup $name]
	}

	debug.cmdr/config {/done}
	return
    }

    method ValidateAsUnknown {name} {
	debug.cmdr/config {}
	if {![dict exists $mymap $name]} return

	debug.cmdr/config {DUP}
	return -code error -errorcode {CMDR CONFIG KNOWN} \
	    "Duplicate parameter \"[context fullname]: $name\", already specified."
    }

    # # ## ### ##### ######## #############
    ## Command completion. This is the entry point for recursion from
    ## the higher level officers, delegated to config from cmdr::private

Changes to officer.tcl.

39
40
41
42
43
44
45

46
47
48
49
50
51
52
..
83
84
85
86
87
88
89

90
91
92
93
94
95
96
...
183
184
185
186
187
188
189






190
191
192
193
194
195
196
197
198
199
200






201
202
203
204
205
206
207
...
238
239
240
241
242
243
244
245


246
247
248
249
250
251
252
...
270
271
272
273
274
275
276



277
278
279
280
281
282
283
...
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
package require string::token::shell 1.1
package require try
package require TclOO
package require oo::util 1.2 ;# link helper.
package require cmdr::actor
package require cmdr::private
package require cmdr::help


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

debug define cmdr/officer
debug level  cmdr/officer
debug prefix cmdr/officer {[debug caller] | }

................................................................................
	set mypmap      {}       ; # Ditto for the map of action abbreviations.
	set mycommands  {}       ; # Ditto
	set myccommands {}       ; # Ditto, derived cache, see method CCommands.
	set mychildren  {}       ; # List of created subordinates.
	set myhandler   {}       ; # Handler around cmd parsing and execution.
	set myshandler  {}       ; # Setup handler, run after regular object
	#                          # initialization from its definition.

	return
    }

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

    method ehandler {cmd} {
	debug.cmdr/officer {}
................................................................................
    }

    method children {} {
	debug.cmdr/officer {}
	my Setup
	return $mychildren
    }







    # # ## ### ##### ######## #############
    ## Internal. Dispatcher setup. Defered until required.
    ## Core setup code runs only once.

    method Setup {} {
	# Process the action specification only once.
	if {$myinit} return
	set myinit 1
	debug.cmdr/officer {}







	my learn $myactions

	# Auto-create a 'help' command when possible, i.e not in
	# conflict with a user-specified command.
	if {![my has help]} {
	    cmdr help auto [self]
	}
................................................................................
	    {shandler    shandler} \
	    {private     Private} \
	    {officer     Officer} \
	    {default     Default} \
	    {alias       Alias} \
	    {description description:} \
	    undocumented \
	    {common      set}


	eval $script

	# Postprocessing.
	set mycommands [lsort -dict $mycommands]
	return
    }

................................................................................
	}

	[my lookup $cmd] extend $path $arguments $action
    }

    # # ## ### ##### ######## #############
    ## Implementation of the action specification language.




    # common      => set          (super cmdr::actor)
    # description => description: (super cmdr::actor)

    forward Private my DefineAction private
    forward Officer my DefineAction officer

................................................................................
	}
	return $help
    }

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

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

    # # ## ### ##### ######## #############
}

# # ## ### ##### ######## ############# #####################
## Ready
package provide cmdr::officer 1.3






>







 







>







 







>
>
>
>
>
>











>
>
>
>
>
>







 







|
>
>







 







>
>
>







 







|







39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
..
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
...
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
...
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
...
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
...
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
package require string::token::shell 1.1
package require try
package require TclOO
package require oo::util 1.2 ;# link helper.
package require cmdr::actor
package require cmdr::private
package require cmdr::help
package require cmdr::config

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

debug define cmdr/officer
debug level  cmdr/officer
debug prefix cmdr/officer {[debug caller] | }

................................................................................
	set mypmap      {}       ; # Ditto for the map of action abbreviations.
	set mycommands  {}       ; # Ditto
	set myccommands {}       ; # Ditto, derived cache, see method CCommands.
	set mychildren  {}       ; # List of created subordinates.
	set myhandler   {}       ; # Handler around cmd parsing and execution.
	set myshandler  {}       ; # Setup handler, run after regular object
	#                          # initialization from its definition.
	set myconfig    {}
	return
    }

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

    method ehandler {cmd} {
	debug.cmdr/officer {}
................................................................................
    }

    method children {} {
	debug.cmdr/officer {}
	my Setup
	return $mychildren
    }

    # Make the parameter container accessible.
    method config {} {
	debug.cmdr/officer {}
	return $myconfig
    }

    # # ## ### ##### ######## #############
    ## Internal. Dispatcher setup. Defered until required.
    ## Core setup code runs only once.

    method Setup {} {
	# Process the action specification only once.
	if {$myinit} return
	set myinit 1
	debug.cmdr/officer {}

	set super [my super]
	if {$super ne {}} {
	    set super [$super config]
	}

	set myconfig [cmdr::config create config [self] {} $super]
	my learn $myactions

	# Auto-create a 'help' command when possible, i.e not in
	# conflict with a user-specified command.
	if {![my has help]} {
	    cmdr help auto [self]
	}
................................................................................
	    {shandler    shandler} \
	    {private     Private} \
	    {officer     Officer} \
	    {default     Default} \
	    {alias       Alias} \
	    {description description:} \
	    undocumented \
	    {common      set} \
	    {option      Option} \
	    {state       State}
	eval $script

	# Postprocessing.
	set mycommands [lsort -dict $mycommands]
	return
    }

................................................................................
	}

	[my lookup $cmd] extend $path $arguments $action
    }

    # # ## ### ##### ######## #############
    ## Implementation of the action specification language.

    forward Option  config make-option
    forward State   config make-state

    # common      => set          (super cmdr::actor)
    # description => description: (super cmdr::actor)

    forward Private my DefineAction private
    forward Officer my DefineAction officer

................................................................................
	}
	return $help
    }

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

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

    # # ## ### ##### ######## #############
}

# # ## ### ##### ######## ############# #####################
## Ready
package provide cmdr::officer 1.3

Changes to private.tcl.

112
113
114
115
116
117
118
119
120


121
122
123
124
125
126
127
    method Setup {} {
	# Process myarguments only once.
	if {$myinit} return
	debug.cmdr/private {}
	set myinit 1

	# Create and fill the parameter collection
	set myconfig [cmdr::config create config [self] $myarguments]


	return
    }

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

    method FullCmd {cmd} {
	# See also officer::Do






|
|
>
>







112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
    method Setup {} {
	# Process myarguments only once.
	if {$myinit} return
	debug.cmdr/private {}
	set myinit 1

	# Create and fill the parameter collection.
	set myconfig [cmdr::config create config [self] \
			  $myarguments \
			  [[my super] config]]
	return
    }

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

    method FullCmd {cmd} {
	# See also officer::Do