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 [email protected]
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 Side-by-Side Diffs Ignore Whitespace Patch

Changes to config.tcl.

  1083   1083   		CMDR CONFIG AMBIGUOUS OPTION
  1084   1084   	}
  1085   1085   
  1086   1086   	# Now map the fully expanded option name to its handler and
  1087   1087   	# let it deal with the remaining things, including retrieval
  1088   1088   	# of the option argument (if any), validation, etc.
  1089   1089   
  1090         -	[dict get $myoption [lindex $options 0]] process $option $mypq
         1090  +	set full [lindex $options 0]
         1091  +	[dict get $myoption $full] process $full $mypq
  1091   1092   	return
  1092   1093       }
  1093   1094   
  1094   1095       method tooMany {} {
  1095   1096   	debug.cmdr/config {}
  1096   1097   	my raise "wrong#args, too many" \
  1097   1098   	    CMDR CONFIG WRONG-ARGS TOO-MANY

Changes to parameter.tcl.

    82     82   	my C2_OptionIsOptional
    83     83   	my C3_StateIsRequired
    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  +	set myhasinverted  no ;# options only, presence of negative aliases.
    89     90   	set myhasdefault   no ;# flag for default existence
    90     91   	set mydefault      {} ;# default value - raw
    91     92   	set mygenerate     {} ;# generator command prefix
    92     93   	set myinteractive  no ;# no interactive query of value
    93     94   	set myprompt       "Enter ${name}: " ;# standard prompt for interaction
    94     95   
    95     96   	set myvalidate     {} ;# validation command prefix
................................................................................
   173    174   		primary  {}
   174    175   		alias    { return "Alias of [my Option $myname]." }
   175    176   		inverted { return "Complementary alias of [my Option $myname]." }
   176    177   	    }
   177    178   	}
   178    179   	return $mydescription
   179    180       }
          181  +
          182  +    method flag-type {detail} {
          183  +	return [dict get $myflags $detail]
          184  +    }
   180    185   
   181    186       method primary {option} {
   182    187   	return [expr {[dict get $myflags $option] eq "primary"}]
   183    188       }
   184    189   
   185    190       method flag {} {
   186    191   	my Option $mylabel
................................................................................
   274    279   	# generated text as description of the aliases.
   275    280   
   276    281   	set myflags {}
   277    282   
   278    283   	# Import the DSL commands to translate the specification.
   279    284   	link \
   280    285   	    {alias         Alias} \
          286  +	    {!alias        NegAlias} \
          287  +	    {neg-alias     NegAlias} \
   281    288   	    {default       Default} \
   282    289   	    {defered       Defered} \
   283    290   	    {generate      Generate} \
   284    291   	    {immediate     Immediate} \
   285    292   	    {interact      Interact} \
   286    293   	    {label         Label} \
   287    294   	    {argument      ArgLabel} \
................................................................................
   313    320   	my C3_StateIsRequired
   314    321   	my C5_OptionalHasAlternateInput
   315    322   	my C5_StateHasAlternateInput
   316    323   	my C6_RequiredArgumentForbiddenDefault
   317    324   	my C6_RequiredArgumentForbiddenGenerator
   318    325   	my C6_RequiredArgumentForbiddenInteract
   319    326   	my C7_DefaultGeneratorConflict
          327  +	my C10_ForbiddenInvertedAlias
          328  +	my C11_ForbiddenInvertedAlias
   320    329   
   321    330   	return
   322    331       }
   323    332   
   324    333       # # ## ### ##### ######## #############
   325    334       ## Utility functionality for easy setup of exclusions and data
   326    335       ## propagation
................................................................................
   378    387       }
   379    388   
   380    389       method Alias {name} {
   381    390   	my Alias_Option
   382    391   	dict set myflags [my Option $name] alias
   383    392   	return
   384    393       }
          394  +
          395  +    method NegAlias {name} {
          396  +	my Alias_Option
          397  +	dict set myflags [my Option $name] inverted
          398  +	set myhasinverted yes
          399  +	return
          400  +    }
   385    401   
   386    402       method Optional {} {
   387    403   	# Arguments only. Options are already optional, and state
   388    404   	# parameters must not be.
   389    405   	my Optional_State  ; # Order of tests is important, enabling us
   390    406   	my Optional_Option ; # to simplify the guard conditions inside.
   391    407   	set myisrequired no
................................................................................
   530    546   
   531    547       forward C8_PresenceOption \
   532    548   	my Assert {$myiscmdline && !$myisordered} \
   533    549   	{Non-option parameter "@" cannot have presence-only}
   534    550   
   535    551       forward C9_ForbiddenPresence \
   536    552   	my Assert {(!$myhasdefault && ![llength $mygenerate] && ![llength $myvalidate]) || !$myonlypresence} \
   537         -	{Customized option cannot be presence-only}
          553  +	{Customized option "@" cannot be presence-only}
   538    554   
   539    555       forward C9_PresenceDefaultConflict \
   540    556   	my Assert {!$myonlypresence} \
   541         -	{Presence-only option cannot have custom default value}
          557  +	{Presence-only option "@" cannot have custom default value}
   542    558   
   543    559       forward C9_PresenceGeneratorConflict \
   544    560   	my Assert {!$myonlypresence} \
   545         -	{Presence-only option cannot have custom generator command}
          561  +	{Presence-only option "@" cannot have custom generator command}
   546    562   
   547    563       forward C9_PresenceValidateConflict \
   548    564   	my Assert {!$myonlypresence} \
   549         -	{Presence-only option cannot have custom validation type}
          565  +	{Presence-only option "@" cannot have custom validation type}
          566  +
          567  +    forward C10_ForbiddenInvertedAlias \
          568  +	my Assert {
          569  +	    ($myiscmdline && !$myisordered &&
          570  +	    ($myvalidate ne "::cmdr::validate::boolean")) ||
          571  +	    $myhasinverted
          572  +	} \
          573  +	{Non-boolean option "@" cannot have negated alias}
          574  +
          575  +    forward C11_ForbiddenInvertedAlias \
          576  +	my Assert {
          577  +	    ($myiscmdline && !$myisordered && $myonlypresence) ||
          578  +	    $myhasinverted
          579  +	} \
          580  +	{Presence option "@" cannot have negated alias}
   550    581   
   551    582       # # ## ### ##### ######## #############
   552    583       ## Internal: DSL support. Syntax constraints.
   553    584   
   554    585       forward Alias_Option \
   555    586   	my Assert {$myiscmdline && !$myisordered} \
   556    587   	{Non-option parameter "@" cannot have alias}
................................................................................
   669    700   	    set alternate [string range $myname 3 end]
   670    701   	} else {
   671    702   	    # The primary option is not inverted, make an alias which is.
   672    703   	    set alternate no-$myname
   673    704   	}
   674    705   
   675    706   	dict set myflags [my Option $alternate] inverted
          707  +	set myhasinverted yes
   676    708   	return
   677    709       }
   678    710   
   679    711       method Option {name} {
   680    712   	# Short options (single character) get a single-dash '-'.
   681    713   	# Long options use a double-dash '--'.
   682    714   	if {[string length $name] == 1} {
................................................................................
   859    891   	    # Look for and process boolean special forms.
   860    892   
   861    893   	    # Insert implied boolean flag value.
   862    894   	    #
   863    895   	    # --foo    non-boolean-value ==> --foo YES non-boolean-value
   864    896   	    # --no-foo non-boolean-value ==> --foo NO  non-boolean-value
   865    897   
   866         -	    # Invert meaning of option.
          898  +	    # Invert meaning of option (inverted aliases, std, and user).
   867    899   	    # --no-foo YES ==> --foo NO
   868    900   	    # --no-foo NO  ==> --foo YES
   869    901   
   870    902   	    # Take implied or explicit value.
   871    903   	    if {![$queue size] || ![string is boolean -strict [$queue peek]]} {
   872    904   		set value yes
   873    905   	    } else {
   874    906   		# queue size && boolean
   875    907   		set value [$queue get]
   876    908   	    }
   877    909   
   878    910   	    # Invert meaning, if so requested.
   879         -	    if {[string match --no-* $flag]} {
          911  +	    if {[dict get $myflags $flag] eq "inverted"} {
   880    912   		set value [expr {!$value}]
   881    913   	    }
   882    914   	} else {
   883    915   	    # Everything else has no special forms. The option's value
   884    916   	    # is required here.
   885    917   	    if {![$queue size]} { config missingOptionValue $flag }
   886    918   	    set value [$queue get]
................................................................................
  1257   1289       variable myname mylabel myarglabel mydescription \
  1258   1290   	myisordered myiscmdline myislist myisrequired \
  1259   1291   	myinteractive myprompt mydefault myhasdefault \
  1260   1292   	mywhencomplete mywhenset mygenerate myvalidate \
  1261   1293   	myflags mythreshold myhasstring mystring \
  1262   1294   	myhasvalue myvalue mylocker mystopinteraction \
  1263   1295   	myisdocumented myonlypresence myisdefered \
  1264         -	myisundefined mynopromote
         1296  +	myisundefined mynopromote myhasinverted
  1265   1297   
  1266   1298       # # ## ### ##### ######## #############
  1267   1299   }
  1268   1300   
  1269   1301   # # ## ### ##### ######## ############# #####################
  1270   1302   ## Ready
  1271   1303   package provide cmdr::parameter 1.4

Changes to tests/parameter.tests.

    44     44           map -A --> (-A)
    45     45           map -X --> (-X)
    46     46           para (A) {
    47     47               description: '-'
    48     48               unordered, cmdline, single, optional, silent, immediate
    49     49               default: 'no'
    50     50               flags [--no-A -A -X]
           51  +                no-A inverted
           52  +                A primary
           53  +                X alias
    51     54               ge ()
    52     55               va (::cmdr::validate::boolean)
    53     56               wd ()
    54     57           }
    55     58       }
    56     59   }
    57     60   
................................................................................
    75     78           map -A --> (-A)
    76     79           map -X --> (-X)
    77     80           para (no-A) {
    78     81               description: '-'
    79     82               unordered, cmdline, single, optional, silent, immediate
    80     83               default: 'no'
    81     84               flags [--no-A -A -X]
           85  +                no-A primary
           86  +                A inverted
           87  +                X alias
           88  +            ge ()
           89  +            va (::cmdr::validate::boolean)
           90  +            wd ()
           91  +        }
           92  +    }
           93  +}
           94  +
           95  +test cmdr-parameter-1.6 {parameter DSL, option, negative alias} -body {
           96  +    NiceParamSpec option { neg-alias X }
           97  +} -result {
           98  +    foo bar = {
           99  +        description: ''
          100  +        option (--no-A) = A
          101  +        option (-A) = A
          102  +        option (-X) = A
          103  +        map --n --> (--no-A)
          104  +        map --no --> (--no-A)
          105  +        map --no- --> (--no-A)
          106  +        map --no-A --> (--no-A)
          107  +        map -A --> (-A)
          108  +        map -X --> (-X)
          109  +        para (A) {
          110  +            description: '-'
          111  +            unordered, cmdline, single, optional, silent, immediate
          112  +            default: 'no'
          113  +            flags [--no-A -A -X]
          114  +                no-A primary
          115  +                A inverted
          116  +                X inverted
    82    117               ge ()
    83    118               va (::cmdr::validate::boolean)
    84    119               wd ()
    85    120           }
    86    121       }
    87    122   }
          123  +
          124  +test cmdr-parameter-1.7 {parameter DSL, option, non-boolean, negative alias} -body {
          125  +    BadParamSpec option { default 2 ; neg-alias X }
          126  +} -returnCodes error \
          127  +    -result {Non-boolean option "A" cannot have negated alias}
          128  +
          129  +test cmdr-parameter-1.8 {parameter DSL, option, presence, negative alias} -body {
          130  +    BadParamSpec option { presence ; neg-alias X }
          131  +} -returnCodes error \
          132  +    -result {Presence option "A" cannot have negated alias}
    88    133   
    89    134   # # ## ### ##### ######## ############# #####################
    90    135   ## Parameter DSL: 'default' across parameters (input, option, state)
    91    136   
    92    137   test cmdr-parameter-2.0 {parameter DSL, default, wrong num args, not enough} -body {
    93    138       BadParamSpec input { default }
    94    139   } -returnCodes error \

Changes to tests/support.tcl.

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