cmdr
Check-in [f9ae78b9ad]
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:Changed boolean options name like --no-foo to have --foo as alias, not --no-no-foo. Changed flag memory to dictionary, enables the system to distinguish primary option from aliases and inverted aliases. The latter two get a generated description. Modified the help generation for a parameter collection to supply the necessary data. Extended testsuite to cover the changes and new feature.
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: f9ae78b9adfaa40678032f6cdddd4a7d2f339122
User & Date: aku 2013-03-14 03:22:07
Context
2013-03-17
09:08
Moved string utility out of help to general utility package check-in: 60628e9e00 user: aku tags: trunk
2013-03-14
03:22
Changed boolean options name like --no-foo to have --foo as alias, not --no-no-foo. Changed flag memory to dictionary, enables the system to distinguish primary option from aliases and inverted aliases. The latter two get a generated description. Modified the help generation for a parameter collection to supply the necessary data. Extended testsuite to cover the changes and new feature. check-in: f9ae78b9ad user: aku tags: trunk
03:18
Fixed missing exports of new API methods. check-in: 06bb9db792 user: aku tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to tests/support.tcl.

13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
## Supporting procedures for xo.test et. al.

proc StartNotes {}     { set ::result {} ; return }
proc Note       {args} { lappend ::result $args ; return }
proc StopNotes  {}     { unset ::result ; return }
proc Notes      {}     { Wrap $::result }

proc NiceParamSpec {kind spec} {
    try {
	xo create x foo [list private bar [list $kind A - $spec] {}]
	ShowPrivate [x lookup bar]
    } finally {
	x destroy
    }
}

proc BadParamSpec {kind spec} {






|

|







13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
## Supporting procedures for xo.test et. al.

proc StartNotes {}     { set ::result {} ; return }
proc Note       {args} { lappend ::result $args ; return }
proc StopNotes  {}     { unset ::result ; return }
proc Notes      {}     { Wrap $::result }

proc NiceParamSpec {kind spec {name A}} {
    try {
	xo create x foo [list private bar [list $kind $name - $spec] {}]
	ShowPrivate [x lookup bar]
    } finally {
	x destroy
    }
}

proc BadParamSpec {kind spec} {

Changes to tests/xo_help.tests.

38
39
40
41
42
43
44
45













46
47
48
	    undocumented
	    private cloak {} ::dagger
	}
    }
    x help
} -cleanup {
    x destroy
} -result {{bar aloha} {desc hawaii options {--lulu loop --no-lulu loop} arguments {yoyo {code + desc height} jump {code ? desc gate} run {code +* desc lane}}} {snafu aloha} {desc hawaii options {--lulu loop --no-lulu loop} arguments {yoyo {code + desc height} jump {code ? desc gate} run {code +* desc lane}}} {tool hammer nail} {desc workbench options {--driver force --force force} arguments {supply {code ?* desc magazine}}} {hammer nail} {desc workbench options {--driver force --force force} arguments {supply {code ?* desc magazine}}}}














# # ## ### ##### ######## ############# #####################
return






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



38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
	    undocumented
	    private cloak {} ::dagger
	}
    }
    x help
} -cleanup {
    x destroy
} -result {{bar aloha} {desc hawaii options {--lulu loop --no-lulu {Complementary alias of --lulu.}} arguments {yoyo {code + desc height} jump {code ? desc gate} run {code +* desc lane}}} {snafu aloha} {desc hawaii options {--lulu loop --no-lulu {Complementary alias of --lulu.}} arguments {yoyo {code + desc height} jump {code ? desc gate} run {code +* desc lane}}} {tool hammer nail} {desc workbench options {--driver force --force {Alias of --driver.}} arguments {supply {code ?* desc magazine}}} {hammer nail} {desc workbench options {--driver force --force {Alias of --driver.}} arguments {supply {code ?* desc magazine}}}}

test xo-help-1.1 {help structure, inverted boolean option} -body {
    xo create x foo {
	description TEST
	private nail {
	    description workbench
	    option no-driver force { list ; alias force }
	} ::wall
    }
    x help
} -cleanup {
    x destroy
} -result {nail {desc workbench options {--driver {Alias of --no-driver.} --force {Alias of --no-driver.} --no-driver force} arguments {}}}

# # ## ### ##### ######## ############# #####################
return

Changes to tests/xo_parameter.tests.

55
56
57
58
59
60
61


























62
63
64
65
66
67
68
    }
}

test xo-parameter-1.4 {parameter DSL, state, alias} -body {
    BadParamSpec state { alias X }
} -returnCodes error \
    -result {Non-option parameter "A" cannot have alias}



























# # ## ### ##### ######## ############# #####################
## Parameter DSL: 'default' across parameters (input, option, state)

test xo-parameter-2.0 {parameter DSL, default, wrong num args, not enough} -body {
    BadParamSpec input { default }
} -returnCodes error \






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







55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
    }
}

test xo-parameter-1.4 {parameter DSL, state, alias} -body {
    BadParamSpec state { alias X }
} -returnCodes error \
    -result {Non-option parameter "A" cannot have alias}

test xo-parameter-1.5 {parameter DSL, negative option, alias} -body {
    NiceParamSpec option { alias X } no-A
} -result {
    foo bar = {
        description: ''
        option (--no-A) = no-A
        option (-A) = no-A
        option (-X) = no-A
        map --n --> (--no-A)
        map --no --> (--no-A)
        map --no- --> (--no-A)
        map --no-A --> (--no-A)
        map -A --> (-A)
        map -X --> (-X)
        para (no-A) {
            description: '-'
            !ordered, cmdline, !splat, !required, !interact
            default: 'no'
            flags [--no-A -A -X]
            ge ()
            va (::xo::validate::boolean)
            wd ()
        }
    }
}

# # ## ### ##### ######## ############# #####################
## Parameter DSL: 'default' across parameters (input, option, state)

test xo-parameter-2.0 {parameter DSL, default, wrong num args, not enough} -body {
    BadParamSpec input { default }
} -returnCodes error \

Changes to xo_config.tcl.

77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
	#     +*	<=> required splat
	#     ?* 	<=> optional splat
	# }

	set options {}
	dict for {o para} $myoption {
	    if {![$para documented]} continue
	    dict set options $o [$para description]
	}

	set arguments {}
	foreach a $myargs {
	    set para [dict get $mymap $a]
	    dict set arguments $a \
		[dict create \






|







77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
	#     +*	<=> required splat
	#     ?* 	<=> optional splat
	# }

	set options {}
	dict for {o para} $myoption {
	    if {![$para documented]} continue
	    dict set options $o [$para description $o]
	}

	set arguments {}
	foreach a $myargs {
	    set para [dict get $mymap $a]
	    dict set arguments $a \
		[dict create \

Changes to xo_parameter.tcl.

88
89
90
91
92
93
94








95

96
97
98
99
100
101
102
...
122
123
124
125
126
127
128
129





130
131
132
133
134
135
136
...
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
...
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
...
393
394
395
396
397
398
399
400
401
402
403
404








405
406
407
408
409
410
411
...
429
430
431
432
433
434
435
436


437
438
439
440
441
442
443
	append code [expr {$myisrequired ? "+" : "?"}]
	append code [expr {$myislist     ? "*" : ""}]
	return $code
    }

    # Identification and help. Add context name into it?
    method name        {} { return $myname }








    method description {} { return $mydescription }


    # Core classification properties
    method ordered      {} { return $myisordered }
    method cmdline      {} { return $myiscmdline }
    method required     {} { return $myisrequired }
    method list         {} { return $myislist }

................................................................................
	return
    }

    # # ## ### ##### ######## #############
    ## Internal: Parameter DSL implementation + support.

    method ExecuteSpecification {valuespec} {
	set myflags {} ;# List of flags to recognize for an option.






	# Import the DSL commands to translate the specification.
	link \
	    {alias        Alias} \
	    {default      Default} \
	    {force        Force} \
	    {generate     Generate} \
................................................................................
	eval $valuespec

	# Postprocessing ... Fill in validation and other defaults

	my FillMissingValidation
	my FillMissingDefault
	my DefineStandardFlags
	set myflags [lsort -dict $myflags]

	# Validate all constraints.

	my C1_StateIsUnordered
	my C2_OptionIsOptional
	my C3_StateIsRequired
	my C5_OptionalHasAlternateInput
................................................................................
    method Undocumented {} {
	set myisdocumented no
	return
    }

    method Alias {name} {
	my Alias_Option
	lappend myflags [my Option $name]
	return
    }

    method Optional {} {
	# Arguments only. Options are already optional, and state
	# parameters must not be.
	my Optional_State  ; # Order of tests is important, enabling us
................................................................................

    method DefineStandardFlags {} {
	# Only options have flags, arguments and state don't.
	# NOTE: Arguments may change in the future (--ask-FOO)
	if {!$myiscmdline || $myisordered} return

	# Flag derived from option name.
	lappend myflags [my Option $myname]
	# Special flags for boolean options
	# XXX Consider pushing this into the validators.
	if {$myvalidate ne "::xo::validate::boolean"} return
	lappend myflags --no-$myname








	return
    }

    method Option {name} {
	# Short options (single character) get a single-dash '-'.
	# Long options use a double-dash '--'.
	if {[string length $name] == 1} {
................................................................................
	set myhasstring no
	set mystring    {}
	set myhasvalue  no
	set myvalue     {}
	return
    }

    method options {} { return $myflags }



    method process {detail queue} {
	# detail = actual flag (option)
	#        = parameter name (argument)

	my Assert {$myiscmdline} "Illegal command line input for state parameter \"$myname\""







>
>
>
>
>
>
>
>
|
>







 







|
>
>
>
>
>







 







<







 







|







 







|



<
>
>
>
>
>
>
>
>







 







|
>
>







88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
...
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
...
158
159
160
161
162
163
164

165
166
167
168
169
170
171
...
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
...
406
407
408
409
410
411
412
413
414
415
416

417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
...
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
	append code [expr {$myisrequired ? "+" : "?"}]
	append code [expr {$myislist     ? "*" : ""}]
	return $code
    }

    # Identification and help. Add context name into it?
    method name        {} { return $myname }
    method description {{detail {}}} {
	if {($detail ne {}) && [dict exists $myflags $detail]} {
	    switch -exact -- [dict get $myflags $detail] {
		primary  {}
		alias    { return "Alias of [my Option $myname]." }
		inverted { return "Complementary alias of [my Option $myname]." }
	    }
	}
	return $mydescription
    }

    # Core classification properties
    method ordered      {} { return $myisordered }
    method cmdline      {} { return $myiscmdline }
    method required     {} { return $myisrequired }
    method list         {} { return $myislist }

................................................................................
	return
    }

    # # ## ### ##### ######## #############
    ## Internal: Parameter DSL implementation + support.

    method ExecuteSpecification {valuespec} {
	# Dictionary of flags to recognize for an option.
	# The value indicates if the flag is primary or alias, or
	# inverted alias. This is used by 'description' to return
	# generated text as description of the aliases.

	set myflags {}

	# Import the DSL commands to translate the specification.
	link \
	    {alias        Alias} \
	    {default      Default} \
	    {force        Force} \
	    {generate     Generate} \
................................................................................
	eval $valuespec

	# Postprocessing ... Fill in validation and other defaults

	my FillMissingValidation
	my FillMissingDefault
	my DefineStandardFlags


	# Validate all constraints.

	my C1_StateIsUnordered
	my C2_OptionIsOptional
	my C3_StateIsRequired
	my C5_OptionalHasAlternateInput
................................................................................
    method Undocumented {} {
	set myisdocumented no
	return
    }

    method Alias {name} {
	my Alias_Option
	dict set myflags [my Option $name] alias
	return
    }

    method Optional {} {
	# Arguments only. Options are already optional, and state
	# parameters must not be.
	my Optional_State  ; # Order of tests is important, enabling us
................................................................................

    method DefineStandardFlags {} {
	# Only options have flags, arguments and state don't.
	# NOTE: Arguments may change in the future (--ask-FOO)
	if {!$myiscmdline || $myisordered} return

	# Flag derived from option name.
	dict set myflags [my Option $myname] primary
	# Special flags for boolean options
	# XXX Consider pushing this into the validators.
	if {$myvalidate ne "::xo::validate::boolean"} return


	if {[string match no-* $myname]} {
	    # The primary option has prefix 'no-', create an alias without it.
	    dict set myflags [my Option [string range $myname 3 end]] alias
	} else {
	    # The primary option is not inverted, make an alias which is.
	    dict set myflags [my Option no-$myname] inverted
	}
	return
    }

    method Option {name} {
	# Short options (single character) get a single-dash '-'.
	# Long options use a double-dash '--'.
	if {[string length $name] == 1} {
................................................................................
	set myhasstring no
	set mystring    {}
	set myhasvalue  no
	set myvalue     {}
	return
    }

    method options {} { 
	return [lsort -dict [dict keys $myflags]]
    }

    method process {detail queue} {
	# detail = actual flag (option)
	#        = parameter name (argument)

	my Assert {$myiscmdline} "Illegal command line input for state parameter \"$myname\""