cmdr
Check-in [a09daa498b]
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 tclconference@googlegroups.com
or submit via the online form by Sep 9.

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

Overview
Comment:Begin support of negative/inverted aliases for boolean options.
Timelines: family | ancestors | descendants | both | neg-aliases
Files: files | file ages | folders
SHA1:a09daa498b2f55ffff8d18e261be867dfa7594db
User & Date: andreask 2015-05-08 00:17:20
Context
2015-05-11
22:28
Merged trunk testsuite fixes. check-in: 5ae1694710 user: aku tags: neg-aliases
2015-05-08
00:17
Begin support of negative/inverted aliases for boolean options. check-in: a09daa498b user: andreask tags: neg-aliases
2015-04-17
23:24
history - Added missing docs. check-in: 860ef7cfb3 user: andreask tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to config.tcl.

1083
1084
1085
1086
1087
1088
1089
1090

1091
1092
1093
1094
1095
1096
1097
		CMDR CONFIG AMBIGUOUS OPTION
	}

	# Now map the fully expanded option name to its handler and
	# let it deal with the remaining things, including retrieval
	# of the option argument (if any), validation, etc.

	[dict get $myoption [lindex $options 0]] process $option $mypq

	return
    }

    method tooMany {} {
	debug.cmdr/config {}
	my raise "wrong#args, too many" \
	    CMDR CONFIG WRONG-ARGS TOO-MANY







|
>







1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
		CMDR CONFIG AMBIGUOUS OPTION
	}

	# Now map the fully expanded option name to its handler and
	# let it deal with the remaining things, including retrieval
	# of the option argument (if any), validation, etc.

	set full [lindex $options 0]
	[dict get $myoption $full] process $full $mypq
	return
    }

    method tooMany {} {
	debug.cmdr/config {}
	my raise "wrong#args, too many" \
	    CMDR CONFIG WRONG-ARGS TOO-MANY

Changes to parameter.tcl.

82
83
84
85
86
87
88

89
90
91
92
93
94
95
...
173
174
175
176
177
178
179




180
181
182
183
184
185
186
...
274
275
276
277
278
279
280


281
282
283
284
285
286
287
...
313
314
315
316
317
318
319


320
321
322
323
324
325
326
...
378
379
380
381
382
383
384







385
386
387
388
389
390
391
...
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
...
669
670
671
672
673
674
675

676
677
678
679
680
681
682
...
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
....
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
	my C2_OptionIsOptional
	my C3_StateIsRequired

	set mystopinteraction no ;# specified interaction is not suppressed.
	set myislist       no ;# scalar vs list parameter
	set myisdocumented yes
	set myonlypresence no ;# options only, no argument when true.

	set myhasdefault   no ;# flag for default existence
	set mydefault      {} ;# default value - raw
	set mygenerate     {} ;# generator command prefix
	set myinteractive  no ;# no interactive query of value
	set myprompt       "Enter ${name}: " ;# standard prompt for interaction

	set myvalidate     {} ;# validation command prefix
................................................................................
		primary  {}
		alias    { return "Alias of [my Option $myname]." }
		inverted { return "Complementary alias of [my Option $myname]." }
	    }
	}
	return $mydescription
    }





    method primary {option} {
	return [expr {[dict get $myflags $option] eq "primary"}]
    }

    method flag {} {
	my Option $mylabel
................................................................................
	# generated text as description of the aliases.

	set myflags {}

	# Import the DSL commands to translate the specification.
	link \
	    {alias         Alias} \


	    {default       Default} \
	    {defered       Defered} \
	    {generate      Generate} \
	    {immediate     Immediate} \
	    {interact      Interact} \
	    {label         Label} \
	    {argument      ArgLabel} \
................................................................................
	my C3_StateIsRequired
	my C5_OptionalHasAlternateInput
	my C5_StateHasAlternateInput
	my C6_RequiredArgumentForbiddenDefault
	my C6_RequiredArgumentForbiddenGenerator
	my C6_RequiredArgumentForbiddenInteract
	my C7_DefaultGeneratorConflict



	return
    }

    # # ## ### ##### ######## #############
    ## Utility functionality for easy setup of exclusions and data
    ## propagation
................................................................................
    }

    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
	my Optional_Option ; # to simplify the guard conditions inside.
	set myisrequired no
................................................................................

    forward C8_PresenceOption \
	my Assert {$myiscmdline && !$myisordered} \
	{Non-option parameter "@" cannot have presence-only}

    forward C9_ForbiddenPresence \
	my Assert {(!$myhasdefault && ![llength $mygenerate] && ![llength $myvalidate]) || !$myonlypresence} \
	{Customized option cannot be presence-only}

    forward C9_PresenceDefaultConflict \
	my Assert {!$myonlypresence} \
	{Presence-only option cannot have custom default value}

    forward C9_PresenceGeneratorConflict \
	my Assert {!$myonlypresence} \
	{Presence-only option cannot have custom generator command}

    forward C9_PresenceValidateConflict \
	my Assert {!$myonlypresence} \
	{Presence-only option cannot have custom validation type}
















    # # ## ### ##### ######## #############
    ## Internal: DSL support. Syntax constraints.

    forward Alias_Option \
	my Assert {$myiscmdline && !$myisordered} \
	{Non-option parameter "@" cannot have alias}
................................................................................
	    set alternate [string range $myname 3 end]
	} else {
	    # The primary option is not inverted, make an alias which is.
	    set alternate no-$myname
	}

	dict set myflags [my Option $alternate] inverted

	return
    }

    method Option {name} {
	# Short options (single character) get a single-dash '-'.
	# Long options use a double-dash '--'.
	if {[string length $name] == 1} {
................................................................................
	    # Look for and process boolean special forms.

	    # Insert implied boolean flag value.
	    #
	    # --foo    non-boolean-value ==> --foo YES non-boolean-value
	    # --no-foo non-boolean-value ==> --foo NO  non-boolean-value

	    # Invert meaning of option.
	    # --no-foo YES ==> --foo NO
	    # --no-foo NO  ==> --foo YES

	    # Take implied or explicit value.
	    if {![$queue size] || ![string is boolean -strict [$queue peek]]} {
		set value yes
	    } else {
		# queue size && boolean
		set value [$queue get]
	    }

	    # Invert meaning, if so requested.
	    if {[string match --no-* $flag]} {
		set value [expr {!$value}]
	    }
	} else {
	    # Everything else has no special forms. The option's value
	    # is required here.
	    if {![$queue size]} { config missingOptionValue $flag }
	    set value [$queue get]
................................................................................
    variable myname mylabel myarglabel mydescription \
	myisordered myiscmdline myislist myisrequired \
	myinteractive myprompt mydefault myhasdefault \
	mywhencomplete mywhenset mygenerate myvalidate \
	myflags mythreshold myhasstring mystring \
	myhasvalue myvalue mylocker mystopinteraction \
	myisdocumented myonlypresence myisdefered \
	myisundefined mynopromote

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

# # ## ### ##### ######## ############# #####################
## Ready
package provide cmdr::parameter 1.4







>







 







>
>
>
>







 







>
>







 







>
>







 







>
>
>
>
>
>
>







 







|



|



|



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







 







>







 







|












|







 







|







82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
...
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
...
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
...
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
...
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
...
546
547
548
549
550
551
552
553
554
555
556
557
558
559
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
585
586
587
...
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
...
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
....
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
	my C2_OptionIsOptional
	my C3_StateIsRequired

	set mystopinteraction no ;# specified interaction is not suppressed.
	set myislist       no ;# scalar vs list parameter
	set myisdocumented yes
	set myonlypresence no ;# options only, no argument when true.
	set myhasinverted  no ;# options only, presence of negative aliases.
	set myhasdefault   no ;# flag for default existence
	set mydefault      {} ;# default value - raw
	set mygenerate     {} ;# generator command prefix
	set myinteractive  no ;# no interactive query of value
	set myprompt       "Enter ${name}: " ;# standard prompt for interaction

	set myvalidate     {} ;# validation command prefix
................................................................................
		primary  {}
		alias    { return "Alias of [my Option $myname]." }
		inverted { return "Complementary alias of [my Option $myname]." }
	    }
	}
	return $mydescription
    }

    method flag-type {detail} {
	return [dict get $myflags $detail]
    }

    method primary {option} {
	return [expr {[dict get $myflags $option] eq "primary"}]
    }

    method flag {} {
	my Option $mylabel
................................................................................
	# generated text as description of the aliases.

	set myflags {}

	# Import the DSL commands to translate the specification.
	link \
	    {alias         Alias} \
	    {!alias        NegAlias} \
	    {neg-alias     NegAlias} \
	    {default       Default} \
	    {defered       Defered} \
	    {generate      Generate} \
	    {immediate     Immediate} \
	    {interact      Interact} \
	    {label         Label} \
	    {argument      ArgLabel} \
................................................................................
	my C3_StateIsRequired
	my C5_OptionalHasAlternateInput
	my C5_StateHasAlternateInput
	my C6_RequiredArgumentForbiddenDefault
	my C6_RequiredArgumentForbiddenGenerator
	my C6_RequiredArgumentForbiddenInteract
	my C7_DefaultGeneratorConflict
	my C10_ForbiddenInvertedAlias
	my C11_ForbiddenInvertedAlias

	return
    }

    # # ## ### ##### ######## #############
    ## Utility functionality for easy setup of exclusions and data
    ## propagation
................................................................................
    }

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

    method NegAlias {name} {
	my Alias_Option
	dict set myflags [my Option $name] inverted
	set myhasinverted yes
	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
	my Optional_Option ; # to simplify the guard conditions inside.
	set myisrequired no
................................................................................

    forward C8_PresenceOption \
	my Assert {$myiscmdline && !$myisordered} \
	{Non-option parameter "@" cannot have presence-only}

    forward C9_ForbiddenPresence \
	my Assert {(!$myhasdefault && ![llength $mygenerate] && ![llength $myvalidate]) || !$myonlypresence} \
	{Customized option "@" cannot be presence-only}

    forward C9_PresenceDefaultConflict \
	my Assert {!$myonlypresence} \
	{Presence-only option "@" cannot have custom default value}

    forward C9_PresenceGeneratorConflict \
	my Assert {!$myonlypresence} \
	{Presence-only option "@" cannot have custom generator command}

    forward C9_PresenceValidateConflict \
	my Assert {!$myonlypresence} \
	{Presence-only option "@" cannot have custom validation type}

    forward C10_ForbiddenInvertedAlias \
	my Assert {
	    ($myiscmdline && !$myisordered &&
	    ($myvalidate ne "::cmdr::validate::boolean")) ||
	    $myhasinverted
	} \
	{Non-boolean option "@" cannot have negated alias}

    forward C11_ForbiddenInvertedAlias \
	my Assert {
	    ($myiscmdline && !$myisordered && $myonlypresence) ||
	    $myhasinverted
	} \
	{Presence option "@" cannot have negated alias}

    # # ## ### ##### ######## #############
    ## Internal: DSL support. Syntax constraints.

    forward Alias_Option \
	my Assert {$myiscmdline && !$myisordered} \
	{Non-option parameter "@" cannot have alias}
................................................................................
	    set alternate [string range $myname 3 end]
	} else {
	    # The primary option is not inverted, make an alias which is.
	    set alternate no-$myname
	}

	dict set myflags [my Option $alternate] inverted
	set myhasinverted yes
	return
    }

    method Option {name} {
	# Short options (single character) get a single-dash '-'.
	# Long options use a double-dash '--'.
	if {[string length $name] == 1} {
................................................................................
	    # Look for and process boolean special forms.

	    # Insert implied boolean flag value.
	    #
	    # --foo    non-boolean-value ==> --foo YES non-boolean-value
	    # --no-foo non-boolean-value ==> --foo NO  non-boolean-value

	    # Invert meaning of option (inverted aliases, std, and user).
	    # --no-foo YES ==> --foo NO
	    # --no-foo NO  ==> --foo YES

	    # Take implied or explicit value.
	    if {![$queue size] || ![string is boolean -strict [$queue peek]]} {
		set value yes
	    } else {
		# queue size && boolean
		set value [$queue get]
	    }

	    # Invert meaning, if so requested.
	    if {[dict get $myflags $flag] eq "inverted"} {
		set value [expr {!$value}]
	    }
	} else {
	    # Everything else has no special forms. The option's value
	    # is required here.
	    if {![$queue size]} { config missingOptionValue $flag }
	    set value [$queue get]
................................................................................
    variable myname mylabel myarglabel mydescription \
	myisordered myiscmdline myislist myisrequired \
	myinteractive myprompt mydefault myhasdefault \
	mywhencomplete mywhenset mygenerate myvalidate \
	myflags mythreshold myhasstring mystring \
	myhasvalue myvalue mylocker mystopinteraction \
	myisdocumented myonlypresence myisdefered \
	myisundefined mynopromote myhasinverted

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

# # ## ### ##### ######## ############# #####################
## Ready
package provide cmdr::parameter 1.4

Changes to tests/parameter.tests.

44
45
46
47
48
49
50



51
52
53
54
55
56
57
..
75
76
77
78
79
80
81
































82
83
84
85
86
87










88
89
90
91
92
93
94
        map -A --> (-A)
        map -X --> (-X)
        para (A) {
            description: '-'
            unordered, cmdline, single, optional, silent, immediate
            default: 'no'
            flags [--no-A -A -X]



            ge ()
            va (::cmdr::validate::boolean)
            wd ()
        }
    }
}

................................................................................
        map -A --> (-A)
        map -X --> (-X)
        para (no-A) {
            description: '-'
            unordered, cmdline, single, optional, silent, immediate
            default: 'no'
            flags [--no-A -A -X]
































            ge ()
            va (::cmdr::validate::boolean)
            wd ()
        }
    }
}











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

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







>
>
>







 







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






>
>
>
>
>
>
>
>
>
>







44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
..
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
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
        map -A --> (-A)
        map -X --> (-X)
        para (A) {
            description: '-'
            unordered, cmdline, single, optional, silent, immediate
            default: 'no'
            flags [--no-A -A -X]
                no-A inverted
                A primary
                X alias
            ge ()
            va (::cmdr::validate::boolean)
            wd ()
        }
    }
}

................................................................................
        map -A --> (-A)
        map -X --> (-X)
        para (no-A) {
            description: '-'
            unordered, cmdline, single, optional, silent, immediate
            default: 'no'
            flags [--no-A -A -X]
                no-A primary
                A inverted
                X alias
            ge ()
            va (::cmdr::validate::boolean)
            wd ()
        }
    }
}

test cmdr-parameter-1.6 {parameter DSL, option, negative alias} -body {
    NiceParamSpec option { neg-alias X }
} -result {
    foo bar = {
        description: ''
        option (--no-A) = A
        option (-A) = A
        option (-X) = 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 (A) {
            description: '-'
            unordered, cmdline, single, optional, silent, immediate
            default: 'no'
            flags [--no-A -A -X]
                no-A primary
                A inverted
                X inverted
            ge ()
            va (::cmdr::validate::boolean)
            wd ()
        }
    }
}

test cmdr-parameter-1.7 {parameter DSL, option, non-boolean, negative alias} -body {
    BadParamSpec option { default 2 ; neg-alias X }
} -returnCodes error \
    -result {Non-boolean option "A" cannot have negated alias}

test cmdr-parameter-1.8 {parameter DSL, option, presence, negative alias} -body {
    BadParamSpec option { presence ; neg-alias X }
} -returnCodes error \
    -result {Presence option "A" cannot have negated alias}

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

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

Changes to tests/support.tcl.

248
249
250
251
252
253
254



255
256
257
258
259
260
261
	    if {[$c threshold] >= 0} {
		lappend result "        mode=threshold [$c threshold]"
	    } else {
		lappend result "        mode=peek+test"
	    }
	}
	lappend result "        flags \[[$c options]\]"



	lappend result "        ge ([$c generator])"
	lappend result "        va ([$c validator])"
	lappend result "        wd ([$c when-complete])"
	lappend result "    \}"
    }

    lappend result "\}"







>
>
>







248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
	    if {[$c threshold] >= 0} {
		lappend result "        mode=threshold [$c threshold]"
	    } else {
		lappend result "        mode=peek+test"
	    }
	}
	lappend result "        flags \[[$c options]\]"
	foreach o [$c options] {
	    lappend result "            $o = [$c flag-type $o]"
	}
	lappend result "        ge ([$c generator])"
	lappend result "        va ([$c validator])"
	lappend result "        wd ([$c when-complete])"
	lappend result "    \}"
    }

    lappend result "\}"