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 Side-by-Side Diffs Ignore Whitespace Patch

Changes to parameter.tcl.

    84     84   
    85     85   	set mystopinteraction no ;# specified interaction is not suppressed.
    86     86   	set myislist       no ;# scalar vs list parameter
    87     87   	set myisdocumented yes
    88     88   	set myonlypresence no ;# options only, no argument when true.
    89     89   	set myhasdefault   no ;# flag for default existence
    90     90   	set mydefault      {} ;# default value - raw
    91         -	set mygenerate     {} ;# generator command
           91  +	set mygenerate     {} ;# generator command prefix
    92     92   	set myinteractive  no ;# no interactive query of value
    93     93   	set myprompt       "Enter ${name}: " ;# standard prompt for interaction
    94     94   
    95         -	set myvalidate     {} ;# validation command
    96         -	set mywhencomplete {} ;# action-on-int-rep-creation command.
    97         -	set mywhenset      {} ;# action-on-set(-from-parse) command.
           95  +	set myvalidate     {} ;# validation command prefix
           96  +	set mywhencomplete {} ;# list of action-on-int-rep-creation command prefixes
           97  +	set mywhenset      {} ;# list of action-on-set(-from-parse) command prefixes
    98     98   
    99     99   	set mythreshold    {} ;# threshold for optional arguments
   100    100   	#                     ;# empty: Undefined
   101    101   	#                     ;#    -1: No threshold, peek and validate for choice.
   102    102   	#                     ;#  else: #required arguments after this one.
   103    103   
   104    104   	my ExecuteSpecification $valuespec
................................................................................
   286    286   	    {no-promotion  NoPromote} \
   287    287   	    {optional      Optional} \
   288    288   	    {presence      Presence} \
   289    289   	    {test          Test} \
   290    290   	    {undocumented  Undocumented} \
   291    291   	    {validate      Validate} \
   292    292   	    {when-complete WhenComplete} \
   293         -	    {when-set      WhenSet}
          293  +	    {when-set      WhenSet} \
          294  +	    \
          295  +	    {touch    Touch} \
          296  +	    {touch?   TouchIfExists} \
          297  +	    {disallow Disallow}
   294    298   	eval $valuespec
   295    299   
   296    300   	# Postprocessing ... Fill in validation and other defaults
   297    301   
   298    302   	my FillMissingValidation
   299    303   	my FillMissingDefault
   300    304   	my DefineStandardFlags
................................................................................
   309    313   	my C6_RequiredArgumentForbiddenDefault
   310    314   	my C6_RequiredArgumentForbiddenGenerator
   311    315   	my C6_RequiredArgumentForbiddenInteract
   312    316   	my C7_DefaultGeneratorConflict
   313    317   
   314    318   	return
   315    319       }
          320  +
          321  +    # # ## ### ##### ######## #############
          322  +    ## Utility functionality for easy setup of exclusions and data
          323  +    ## propagation
          324  +
          325  +    method Touch {attr val} {
          326  +	lambda {attr val p x} {
          327  +	    $p config $attr set $val
          328  +	} $attr $val
          329  +    }
          330  +
          331  +    method TouchIfExists {attr val} {
          332  +	lambda {attr val p x} {
          333  +	    if {![$p config has $attr]} return
          334  +	    $p config $attr set $val
          335  +	} $attr $val
          336  +    }
          337  +
          338  +    method Disallow {attr} {
          339  +	lambda {attr excluder p args} {
          340  +	    $p config $attr lock $excluder
          341  +	} $attr [my the-name]
          342  +    }
   316    343   
   317    344       # # ## ### ##### ######## #############
   318    345       ## Internal: Parameter DSL commands.
   319    346   
   320    347       method Label {name} {
   321    348   	set mylabel $name
   322    349   	return
................................................................................
   433    460   	}
   434    461   
   435    462   	set myvalidate $cmdprefix
   436    463   	return
   437    464       }
   438    465   
   439    466       method WhenComplete {cmd} {
   440         -	set mywhencomplete $cmd
          467  +	lappend mywhencomplete $cmd
   441    468   	return
   442    469       }
   443    470   
   444    471       method WhenSet {cmd} {
   445         -	set mywhenset $cmd
          472  +	lappend mywhenset $cmd
   446    473   	return
   447    474       }
   448    475   
   449    476       method Test {} {
   450    477   	my Test_NotState    ; # Order of tests is important, enabling us
   451    478   	my Test_NotOption   ; # to simplify the guard conditions inside.
   452    479   	my Test_NotRequired ; #
................................................................................
   726    753   
   727    754   	    if {$n == 1} {
   728    755   		set mystring [::list $mystring]
   729    756   	    }
   730    757   	} else {
   731    758   	    set mystring [$queue get]
   732    759   	}
          760  +
   733    761   	set myhasstring yes
   734         -
   735    762   	my forget
   736         -
   737         -	if {[llength $mywhenset]} {
   738         -	    {*}$mywhenset [self] $mystring
   739         -	}
          763  +	my RunWhenSetHooks
   740    764   	return
   741    765       }
   742    766   
   743    767       method set {value} {
   744    768   	debug.cmdr/parameter {}
   745    769   	my Locked
   746    770   	if {$myislist} {
   747    771   	    lappend mystring $value
   748    772   	} else {
   749    773   	    set mystring $value
   750    774   	}
          775  +
   751    776   	set myhasstring yes
   752         -
   753    777   	my forget
   754         -
   755         -	if {[llength $mywhenset]} {
   756         -	    {*}$mywhenset [self] $mystring
   757         -	}
          778  +	my RunWhenSetHooks
   758    779   	return
   759    780       }
   760    781   
   761    782       method accept {x} {
   762    783   	debug.cmdr/parameter {}
   763    784   	try {
   764    785   	    my ValueRelease [{*}$myvalidate validate [self] $x]
................................................................................
   773    794       }
   774    795   
   775    796       method Locked {} {
   776    797   	if {$mylocker eq {}} return
   777    798   	debug.cmdr/parameter {}
   778    799   	return -code error \
   779    800   	    -errorcode {CMDR PARAMETER LOCKED} \
   780         -	    "You cannot use \"[my name]\" together with \"$mylocker\"."
          801  +	    "You cannot use \"[my the-name]\" together with \"$mylocker\"."
   781    802       }
   782    803   
   783    804       method process {detail queue} {
   784    805   	debug.cmdr/parameter {}
   785    806   	# detail = actual flag (option)
   786    807   	#        = parameter name (argument)
   787    808   
................................................................................
  1179   1200   	return -code error \
  1180   1201   	    -errorcode {CMDR PARAMETER UNDEFINED} \
  1181   1202   	    "Undefined: $myname"
  1182   1203       }
  1183   1204   
  1184   1205       method Value: {v} {
  1185   1206   	debug.cmdr/parameter {}
  1186         -	if {[llength $mywhencomplete]} {
  1187         -	    {*}$mywhencomplete [self] $v
  1188         -	}
         1207  +
  1189   1208   	set myvalue $v
  1190   1209   	set myhasvalue yes
         1210  +	my RunWhenCompleteHooks
  1191   1211   
  1192   1212   	# Return value, abort caller!
  1193   1213   	return -code return $myvalue
  1194   1214       }
  1195   1215   
  1196   1216       method ValueRelease {value} {
  1197   1217   	debug.cmdr/parameter {}
................................................................................
  1204   1224   		{*}$myvalidate release [self] $v
  1205   1225   	    }
  1206   1226   	} else {
  1207   1227   	    {*}$myvalidate release [self] $value
  1208   1228   	}
  1209   1229   	return
  1210   1230       }
         1231  +
         1232  +    method RunWhenSetHooks {} {
         1233  +	if {![llength $mywhenset]} return
         1234  +	set self [self]
         1235  +	foreach cmd $mywhenset {
         1236  +	    if {![llength $cmd]} continue
         1237  +	    {*}$cmd $self $mystring
         1238  +	}
         1239  +	return
         1240  +    }
         1241  +
         1242  +    method RunWhenCompleteHooks {} {
         1243  +	if {![llength $mywhencomplete]} return
         1244  +	set self [self]
         1245  +	foreach cmd $mywhencomplete {
         1246  +	    if {![llength $cmd]} continue
         1247  +	    {*}$cmd $self $myvalue
         1248  +	}
         1249  +	return
         1250  +    }
  1211   1251   
  1212   1252       # # ## ### ##### ######## #############
  1213   1253   
  1214   1254       variable myname mylabel myarglabel mydescription \
  1215   1255   	myisordered myiscmdline myislist myisrequired \
  1216   1256   	myinteractive myprompt mydefault myhasdefault \
  1217   1257   	mywhencomplete mywhenset mygenerate myvalidate \
................................................................................
  1221   1261   	myisundefined mynopromote
  1222   1262   
  1223   1263       # # ## ### ##### ######## #############
  1224   1264   }
  1225   1265   
  1226   1266   # # ## ### ##### ######## ############# #####################
  1227   1267   ## Ready
  1228         -package provide cmdr::parameter 1.3
         1268  +package provide cmdr::parameter 1.4