cmdr
Check-in [9fc3922163]
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:cmdr::parameter - Utility DSL commands for easy locking (disallow) and trivial accss to siblings (touch, touch?). Semantic change for when-* hooks. Now storing a list and multiple when-set definitions accumulate. Tweaking locking error message to use better name of the locked parameter.
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 9fc3922163e42048e1d3d005cb38b1bf3ff539fd
User & Date: andreask 2014-09-19 17:52:58
Context
2014-10-08
21:13
When printing config state, show parameter inheritance. Plus label now showing regular names, no titling. check-in: 7501cc673b user: andreask tags: trunk
2014-09-19
17:52
cmdr::parameter - Utility DSL commands for easy locking (disallow) and trivial accss to siblings (touch, touch?). Semantic change for when-* hooks. Now storing a list and multiple when-set definitions accumulate. Tweaking locking error message to use better name of the locked parameter. check-in: 9fc3922163 user: andreask tags: trunk
2014-09-10
20:35
Move handling of global option to before checking for a command. We can now enter a main shell with global options set. Bump version numbers. check-in: 2bfa8d5785 user: andreask tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to parameter.tcl.

84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
...
286
287
288
289
290
291
292
293




294
295
296
297
298
299
300
...
309
310
311
312
313
314
315























316
317
318
319
320
321
322
...
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
...
726
727
728
729
730
731
732
733
734

735
736
737
738
739

740
741
742
743
744
745
746
747
748
749
750
751
752

753
754
755
756
757

758
759
760
761
762
763
764
...
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
....
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190

1191
1192
1193
1194
1195
1196
1197
....
1204
1205
1206
1207
1208
1209
1210




















1211
1212
1213
1214
1215
1216
1217
....
1221
1222
1223
1224
1225
1226
1227
1228
	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
	set myinteractive  no ;# no interactive query of value
	set myprompt       "Enter ${name}: " ;# standard prompt for interaction

	set myvalidate     {} ;# validation command
	set mywhencomplete {} ;# action-on-int-rep-creation command.
	set mywhenset      {} ;# action-on-set(-from-parse) command.

	set mythreshold    {} ;# threshold for optional arguments
	#                     ;# empty: Undefined
	#                     ;#    -1: No threshold, peek and validate for choice.
	#                     ;#  else: #required arguments after this one.

	my ExecuteSpecification $valuespec
................................................................................
	    {no-promotion  NoPromote} \
	    {optional      Optional} \
	    {presence      Presence} \
	    {test          Test} \
	    {undocumented  Undocumented} \
	    {validate      Validate} \
	    {when-complete WhenComplete} \
	    {when-set      WhenSet}




	eval $valuespec

	# Postprocessing ... Fill in validation and other defaults

	my FillMissingValidation
	my FillMissingDefault
	my DefineStandardFlags
................................................................................
	my C6_RequiredArgumentForbiddenDefault
	my C6_RequiredArgumentForbiddenGenerator
	my C6_RequiredArgumentForbiddenInteract
	my C7_DefaultGeneratorConflict

	return
    }
























    # # ## ### ##### ######## #############
    ## Internal: Parameter DSL commands.

    method Label {name} {
	set mylabel $name
	return
................................................................................
	}

	set myvalidate $cmdprefix
	return
    }

    method WhenComplete {cmd} {
	set mywhencomplete $cmd
	return
    }

    method WhenSet {cmd} {
	set mywhenset $cmd
	return
    }

    method Test {} {
	my Test_NotState    ; # Order of tests is important, enabling us
	my Test_NotOption   ; # to simplify the guard conditions inside.
	my Test_NotRequired ; #
................................................................................

	    if {$n == 1} {
		set mystring [::list $mystring]
	    }
	} else {
	    set mystring [$queue get]
	}
	set myhasstring yes


	my forget

	if {[llength $mywhenset]} {
	    {*}$mywhenset [self] $mystring
	}

	return
    }

    method set {value} {
	debug.cmdr/parameter {}
	my Locked
	if {$myislist} {
	    lappend mystring $value
	} else {
	    set mystring $value
	}
	set myhasstring yes


	my forget

	if {[llength $mywhenset]} {
	    {*}$mywhenset [self] $mystring
	}

	return
    }

    method accept {x} {
	debug.cmdr/parameter {}
	try {
	    my ValueRelease [{*}$myvalidate validate [self] $x]
................................................................................
    }

    method Locked {} {
	if {$mylocker eq {}} return
	debug.cmdr/parameter {}
	return -code error \
	    -errorcode {CMDR PARAMETER LOCKED} \
	    "You cannot use \"[my name]\" together with \"$mylocker\"."
    }

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

................................................................................
	return -code error \
	    -errorcode {CMDR PARAMETER UNDEFINED} \
	    "Undefined: $myname"
    }

    method Value: {v} {
	debug.cmdr/parameter {}
	if {[llength $mywhencomplete]} {
	    {*}$mywhencomplete [self] $v
	}
	set myvalue $v
	set myhasvalue yes


	# Return value, abort caller!
	return -code return $myvalue
    }

    method ValueRelease {value} {
	debug.cmdr/parameter {}
................................................................................
		{*}$myvalidate release [self] $v
	    }
	} else {
	    {*}$myvalidate release [self] $value
	}
	return
    }





















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

    variable myname mylabel myarglabel mydescription \
	myisordered myiscmdline myislist myisrequired \
	myinteractive myprompt mydefault myhasdefault \
	mywhencomplete mywhenset mygenerate myvalidate \
................................................................................
	myisundefined mynopromote

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

# # ## ### ##### ######## ############# #####################
## Ready
package provide cmdr::parameter 1.3






|



|
|
|







 







|
>
>
>
>







 







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







 







|




|







 







<

>

<
<
<
<
>











<

>

<
<
<
<
>







 







|







 







<
<
|


>







 







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







 







|
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
...
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
...
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
...
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
...
753
754
755
756
757
758
759

760
761
762




763
764
765
766
767
768
769
770
771
772
773
774

775
776
777




778
779
780
781
782
783
784
785
...
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
....
1200
1201
1202
1203
1204
1205
1206


1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
....
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
....
1261
1262
1263
1264
1265
1266
1267
1268
	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
	set mywhencomplete {} ;# list of action-on-int-rep-creation command prefixes
	set mywhenset      {} ;# list of action-on-set(-from-parse) command prefixes

	set mythreshold    {} ;# threshold for optional arguments
	#                     ;# empty: Undefined
	#                     ;#    -1: No threshold, peek and validate for choice.
	#                     ;#  else: #required arguments after this one.

	my ExecuteSpecification $valuespec
................................................................................
	    {no-promotion  NoPromote} \
	    {optional      Optional} \
	    {presence      Presence} \
	    {test          Test} \
	    {undocumented  Undocumented} \
	    {validate      Validate} \
	    {when-complete WhenComplete} \
	    {when-set      WhenSet} \
	    \
	    {touch    Touch} \
	    {touch?   TouchIfExists} \
	    {disallow Disallow}
	eval $valuespec

	# Postprocessing ... Fill in validation and other defaults

	my FillMissingValidation
	my FillMissingDefault
	my DefineStandardFlags
................................................................................
	my C6_RequiredArgumentForbiddenDefault
	my C6_RequiredArgumentForbiddenGenerator
	my C6_RequiredArgumentForbiddenInteract
	my C7_DefaultGeneratorConflict

	return
    }

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

    method Touch {attr val} {
	lambda {attr val p x} {
	    $p config $attr set $val
	} $attr $val
    }

    method TouchIfExists {attr val} {
	lambda {attr val p x} {
	    if {![$p config has $attr]} return
	    $p config $attr set $val
	} $attr $val
    }

    method Disallow {attr} {
	lambda {attr excluder p args} {
	    $p config $attr lock $excluder
	} $attr [my the-name]
    }

    # # ## ### ##### ######## #############
    ## Internal: Parameter DSL commands.

    method Label {name} {
	set mylabel $name
	return
................................................................................
	}

	set myvalidate $cmdprefix
	return
    }

    method WhenComplete {cmd} {
	lappend mywhencomplete $cmd
	return
    }

    method WhenSet {cmd} {
	lappend mywhenset $cmd
	return
    }

    method Test {} {
	my Test_NotState    ; # Order of tests is important, enabling us
	my Test_NotOption   ; # to simplify the guard conditions inside.
	my Test_NotRequired ; #
................................................................................

	    if {$n == 1} {
		set mystring [::list $mystring]
	    }
	} else {
	    set mystring [$queue get]
	}


	set myhasstring yes
	my forget




	my RunWhenSetHooks
	return
    }

    method set {value} {
	debug.cmdr/parameter {}
	my Locked
	if {$myislist} {
	    lappend mystring $value
	} else {
	    set mystring $value
	}


	set myhasstring yes
	my forget




	my RunWhenSetHooks
	return
    }

    method accept {x} {
	debug.cmdr/parameter {}
	try {
	    my ValueRelease [{*}$myvalidate validate [self] $x]
................................................................................
    }

    method Locked {} {
	if {$mylocker eq {}} return
	debug.cmdr/parameter {}
	return -code error \
	    -errorcode {CMDR PARAMETER LOCKED} \
	    "You cannot use \"[my the-name]\" together with \"$mylocker\"."
    }

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

................................................................................
	return -code error \
	    -errorcode {CMDR PARAMETER UNDEFINED} \
	    "Undefined: $myname"
    }

    method Value: {v} {
	debug.cmdr/parameter {}



	set myvalue $v
	set myhasvalue yes
	my RunWhenCompleteHooks

	# Return value, abort caller!
	return -code return $myvalue
    }

    method ValueRelease {value} {
	debug.cmdr/parameter {}
................................................................................
		{*}$myvalidate release [self] $v
	    }
	} else {
	    {*}$myvalidate release [self] $value
	}
	return
    }

    method RunWhenSetHooks {} {
	if {![llength $mywhenset]} return
	set self [self]
	foreach cmd $mywhenset {
	    if {![llength $cmd]} continue
	    {*}$cmd $self $mystring
	}
	return
    }

    method RunWhenCompleteHooks {} {
	if {![llength $mywhencomplete]} return
	set self [self]
	foreach cmd $mywhencomplete {
	    if {![llength $cmd]} continue
	    {*}$cmd $self $myvalue
	}
	return
    }

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

    variable myname mylabel myarglabel mydescription \
	myisordered myiscmdline myislist myisrequired \
	myinteractive myprompt mydefault myhasdefault \
	mywhencomplete mywhenset mygenerate myvalidate \
................................................................................
	myisundefined mynopromote

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

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