cmdr
Check-in [3230322f4d]
Not logged in
Bounty program for improvements to Tcl and certain Tcl packages.

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

Overview
Comment: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.
Timelines: family | ancestors | descendants | both | global-options
Files: files | file ages | folders
SHA1: 3230322f4d2bbce1c09646a7cf69f05e780fd468
User & Date: andreask 2014-08-22 23:22:12
Context
2014-08-25
23:08
Merge fixes from trunk. check-in: 7d15626394 user: andreask tags: global-options
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
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to NOTES.

28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
(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.






|









28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
(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
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.

85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
...
148
149
150
151
152
153
154
155
156
157
158

159
160
161
162
163
164
165








166
167
168
169
170
171
172
...
871
872
873
874
875
876
877


































878
879
880
881
882
883
884
....
1004
1005
1006
1007
1008
1009
1010

1011
1012
1013
1014
1015
1016
1017
1018
1019


1020
1021
1022
1023
1024
1025
1026
    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
................................................................................
		# Swallow possibility of a misisng *all*.
	    }
	    eval $spec
	    debug.cmdr/config {==== eval spec done =====}
	}

	# Postprocessing

	my SetThresholds
	my UniquePrefixes
	my CompletionGraph


	set mypq [struct::queue P] ;# actual parameters
	if {[llength $myargs]} {
	    set myaq [struct::queue A] ;# formal argument parameters
	}
	return
    }









    method help {{mode public}} {
	debug.cmdr/config {}
	# command   = dict ('desc'       -> description
	#                   'options'    -> options
	#                   'arguments'  -> arguments
	#                   'parameters' -> parameters)
................................................................................
	    return
	}
	P put {*}$arguments

	debug.cmdr/config {done}
	return
    }



































    method parse {args} {
	debug.cmdr/config {}

	# - Reset the state values (we might be in an interactive shell, multiple commands).
	# - Stash the parameters into a queue for processing.
	# - Stash the (ordered) arguments into a second queue.
................................................................................

    method ProcessOption {} {
	debug.cmdr/config {}
	# Get option. Do special handling.
	# Non special option gets dispatched to handler (cmdr::parameter instance).
	# The handler is responsible for retrieved the option's value.
	set option [P get]


	# Handle general special forms:
	#
	# --foo=bar ==> --foo bar
	# -f=bar    ==> -f bar

	if {[regexp {^(-[^=]+)=(.*)$} $option --> option value]} {
	    P unget $value
	}



	# Validate existence of the option
	if {![dict exists $myfullopt $option]} {
	    my raise "Unknown option $option" \
		CMDR CONFIG BAD OPTION
	}







|







 







<
<
<
<
>







>
>
>
>
>
>
>
>







 







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







 







>









>
>







85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
...
148
149
150
151
152
153
154




155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
...
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
....
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
    forward context context

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

    constructor {context spec {super {}}} {
	debug.cmdr/config {owner=([$context fullname])}

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

	classvariable ourdisplay
	if {[info exists ourdisplay]} {
	    set mydisplay $ourdisplay
................................................................................
		# Swallow possibility of a misisng *all*.
	    }
	    eval $spec
	    debug.cmdr/config {==== eval spec done =====}
	}

	# Postprocessing




	my complete-definitions

	set mypq [struct::queue P] ;# actual parameters
	if {[llength $myargs]} {
	    set myaq [struct::queue A] ;# formal argument parameters
	}
	return
    }

    method complete-definitions {} {
	debug.cmdr/config {}
	my SetThresholds
	my UniquePrefixes
	my CompletionGraph
	return
    }

    method help {{mode public}} {
	debug.cmdr/config {}
	# command   = dict ('desc'       -> description
	#                   'options'    -> options
	#                   'arguments'  -> arguments
	#                   'parameters' -> parameters)
................................................................................
	    return
	}
	P put {*}$arguments

	debug.cmdr/config {done}
	return
    }

    method parse-head-options {args} {
	debug.cmdr/config {}

	# - Reset the state values (we might be in an interactive shell, multiple commands).
	# - Stash the parameters into a queue for processing.
	# - Stash the (ordered) arguments into a second queue.
	# - Operate on parameter and arg queues until empty,
	#   dispatching the words to handlers as needed.

	if {![llength $args]} { return {} }

	my reset
	P clear
	P put {*}$args

	debug.cmdr/config {options only}
	while {[P size]} {
	    set word [P peek]
	    debug.cmdr/config {[P size] ? $word}
	    if {![string match -* $word]} break
	    my ProcessOption
	}
	# Non-option found, or end of words reached.
	# Return the remainder.
	set n [P size]
	if {!$n} {
	    return {}
	} elseif {$n == 1} {
	    return [list [P get]]
	} else {
	    return [P get $n]
	}
    }

    method parse {args} {
	debug.cmdr/config {}

	# - Reset the state values (we might be in an interactive shell, multiple commands).
	# - Stash the parameters into a queue for processing.
	# - Stash the (ordered) arguments into a second queue.
................................................................................

    method ProcessOption {} {
	debug.cmdr/config {}
	# Get option. Do special handling.
	# Non special option gets dispatched to handler (cmdr::parameter instance).
	# The handler is responsible for retrieved the option's value.
	set option [P get]
	debug.cmdr/config {taking ($option)}

	# Handle general special forms:
	#
	# --foo=bar ==> --foo bar
	# -f=bar    ==> -f bar

	if {[regexp {^(-[^=]+)=(.*)$} $option --> option value]} {
	    P unget $value
	}

	debug.cmdr/config {having ($option)}

	# Validate existence of the option
	if {![dict exists $myfullopt $option]} {
	    my raise "Unknown option $option" \
		CMDR CONFIG BAD OPTION
	}

Changes to officer.tcl.

22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
...
209
210
211
212
213
214
215

216
217
218
219
220
221
222
...
452
453
454
455
456
457
458




459
460
461
462
463
464
465
...
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
# Meta require cmdr::private
# Meta require debug
# Meta require debug::caller
# Meta require linenoise::facade
# Meta require try
# Meta require {Tcl 8.5-}
# Meta require {oo::util 1.2}
# Meta require {string::token::shell 1.1}
# @@ Meta End

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

package require Tcl 8.5
package require debug
package require debug::caller
package require linenoise::facade
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
................................................................................
	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]
	}

................................................................................
	set reset 0
	if {![my exists *command*]} {
	    # Prevent handling of application-specific options here.
	    my set *command* -- $args
	    set reset 1
	}
	try {




	    # Empty command. Delegate to the default, if we have any.
	    # Otherwise fail.
	    if {![llength $args]} {
		if {[my hasdefault]} {
		    return [[my lookup [my default]] do]
		}
		return -code error -errorcode {CMDR DO EMPTY} \
................................................................................

	if {$cmd eq ".exit"} {
	    # See method 'shell-exit' as well, and 'Setup' for
	    # the auto-creation of an 'exit' command when possible,
	    # i.e not in conflict with a user-specified command.
	    set myreplexit 1 ; return
	}
	my Do {*}[string token shell $cmd]
    }

    method report {what data} {
	debug.cmdr/officer {}
	switch -exact -- $what {
	    ok {
		if {$data eq {}} return






|









|







 







>







 







>
>
>
>







 







|







22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
...
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
...
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
...
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
# Meta require cmdr::private
# Meta require debug
# Meta require debug::caller
# Meta require linenoise::facade
# Meta require try
# Meta require {Tcl 8.5-}
# Meta require {oo::util 1.2}
# Meta require {string::token::shell 1.2}
# @@ Meta End

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

package require Tcl 8.5
package require debug
package require debug::caller
package require linenoise::facade
package require string::token::shell 1.2
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
................................................................................
	set super [my super]
	if {$super ne {}} {
	    set super [$super config]
	}

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

	# 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]
	}

................................................................................
	set reset 0
	if {![my exists *command*]} {
	    # Prevent handling of application-specific options here.
	    my set *command* -- $args
	    set reset 1
	}
	try {
	    # Process any options we may find. The first non-option
	    # will be the command to dispatch on.
	    set arg [config parse-head-options {*}$args]

	    # Empty command. Delegate to the default, if we have any.
	    # Otherwise fail.
	    if {![llength $args]} {
		if {[my hasdefault]} {
		    return [[my lookup [my default]] do]
		}
		return -code error -errorcode {CMDR DO EMPTY} \
................................................................................

	if {$cmd eq ".exit"} {
	    # See method 'shell-exit' as well, and 'Setup' for
	    # the auto-creation of an 'exit' command when possible,
	    # i.e not in conflict with a user-specified command.
	    set myreplexit 1 ; return
	}
	my Do {*}[string token shell -- $cmd]
    }

    method report {what data} {
	debug.cmdr/officer {}
	switch -exact -- $what {
	    ok {
		if {$data eq {}} return