[AMG]: [[argparse]] is a feature-heavy argument parser. Documentation and test suite to come. For now, look at the big comment at the start of the implementation. **Examples** ====== proc lsort_ {args} { puts [argparse -inline { {-ascii -key sort -value ascii} {-dictionary -key sort -value dictionary} {-integer -key sort -value integer} {-real -key sort -value real} {-command= -forbid {ascii dictionary integer real}} {-increasing -key order -value increasing} {-decreasing -key order -value decreasing} -indices -index= -stride= -nocase -unique list }] } proc lsearch_ {args} { puts [argparse -inline { {-exact -key match -value exact} {-glob -key match -value glob} {-regexp -key match -value regexp} {-sorted -forbid {glob regexp}} -all -inline -not -start= {-ascii -key format -value text} {-dictionary -key format -value dictionary} {-integer -key format -value integer} {-nocase -key format -value nocase} {-real -key format -value real} {-decreasing -key order -value decreasing -require sorted} {-increasing -key order -value increasing -require sorted} {-bisect -imply -sorted -forbid {all not}} -index= {-subindices -require index} list pattern }] } proc dummy {args} { puts [argparse -inline {a? b c* d e?}] } lsort_ -increasing -real {2.0 1.0} lsearch_ -inline -start 1 -exact -bisect {a b c} b dummy 1 2 dummy 1 2 3 dummy 1 2 3 4 dummy 1 2 3 4 5 dummy 1 2 3 4 5 6 ====== The above prints: ======none order increasing sort real list {2.0 1.0} inline {} start 1 match exact bisect {} sorted {} list {a b c} pattern b b 1 d 2 c {} a 1 b 2 d 3 c {} a 1 b 2 d 3 e 4 c {} a 1 b 2 c 3 d 4 e 5 a 1 b 2 c {3 4} d 5 e 6 ====== One feature not shown by the examples is setting or linking variables. I'm just using the -inline mode for display purposes. **Implementation** ====== # argparse -- # Parses an argument list according to a definition list. The result may be # stored into caller variables or returned as a dict. # # The [argparse] command accepts the following switches: # # -inline Return the result dict rather than setting caller variables # -exact Require exact switch name matches, and do not accept prefixes # -mixed Allow switches to appear after parameters # -long Recognize "--switch" long option alternative syntax # -equalarg Recognize "-switch=arg" inline argument alternative syntax # -normalize Normalize switch syntax in pass-through result keys # -reciprocal Every element's -require constraints are reciprocal # -level LEVEL Every -upvar element's [upvar] level; defaults to 1 # -template TMP Transform default element names using a substitution template # -pass KEY Pass unrecognized elements through to a result key # -- Force next argument to be interpreted as the definition list # # After the above switches comes the definition list argument, then finally the # optional argument list argument. If the argument list is omitted, it is taken # from the caller's args variable. # # Each element of the definition list is itself a list containing a unique, # non-empty name element consisting of alphanumerics, underscores, and minus # (not as the first character), then zero or more of the following switches: # # -switch Element is a switch; conflicts with -parameter # -parameter Element is a parameter; conflicts with -switch # -alias ALIAS Alias name; requires -switch # -ignore Element is omitted from result; conflicts with -key and -pass # -key KEY Override key name; not affected by -template # -pass KEY Pass through to result key; not affected by -template # -default VAL Value if omitted; conflicts with -required # -value VAL Value if present; requires -switch; conflicts with -argument # -argument Value is next argument following switch; requires -switch # -optional Switch value is optional, or parameter is optional # -required Switch is required, or stop -catchall from implying -optional # -catchall Value is list of all otherwise unassigned arguments # -upvar Links caller variable; conflicts with -inline and -catchall # -level LEVEL This element's [upvar] level; requires -upvar # -standalone If element is present, ignore -required, -require, and -forbid # -require LIST If element is present, other elements that must be present # -forbid LIST If element is present, other elements that must not be present # -imply LIST If element is present, extra switch arguments; requires -switch # -reciprocal This element's -require constraints are reciprocal # # If neither -switch nor -parameter are used, a shorthand form is permitted. If # the name is preceded by "-", it is a switch; otherwise, it is a parameter. An # alias may be written after "-", then followed by "|" and the switch name. The # element name may be followed by any number of flag characters: # # "=" Same as -argument; only valid for switches # "?" Same as -optional # "!" Same as -required # "*" Same as -catchall # "^" Same as -upvar # # -default specifies the value to assign to element keys when the element is # omitted. If -default is not used, keys for omitted switches and parameters # are omitted from the result, unless -catchall is used, in which case the # default value for -default is empty string. # # -optional, -required, and -catchall imply -argument when used with -switch. # # At most one parameter may use -catchall. # # If multiple elements share the same -key value, they automatically are given # -forbid constraints to prevent them from being used simultaneously. # # -value specifies the value to assign to switch keys when the switch is # present. -value defaults to empty string. -value may not be used with # -argument, -optional, -required, or -catchall. # # If -argument is used, the value assigned to the switch's key is normally the # next argument following the switch. With -catchall, the value assigned to the # switch's key is instead the list of all remaining arguments. With -optional, # the following processing is applied: # # - If the switch is not present, the switch's key is omitted from the result, # unless -default is used, in which case its value is specified by -default. # - If the switch appears before the final argument, its value is a two-element # list containing empty string followed by the argument after the switch. # - If the switch appears as the final argument, the value of the switch's key # is empty string. # # By default, switches are optional and parameters are required. Switches can # be made required with -required, and parameters can be made optional with # -optional. -catchall also makes parameters optional, unless -required is # used, in which case at least one argument must be assigned to the parameter. # Otherwise, using -required with -parameter has no effect. -switch -optional # -catchall and -parameter -optional -required are disallowed combinations. # -switch -optional -required means the switch must be present but may be the # final argument. # # Unambiguous prefixes of switch names are acceptable, unless the -exact switch # is used. Switches in the argument list normally begin with a single "-" but # can also begin with "--" if the -long switch is used. Arguments to switches # normally appear as the list element following the switch, but if -equalarg is # used, they may be supplied within the switch element itself, delimited with an # "=" character, e.g. "-switch=arg". # # The per-element -pass switch causes the element argument or arguments to be # appended to the value of the indicated pass-through result key. Many elements # may use the same pass-through key. If -normalize is used, switch arguments # are normalized to not use aliases, abbreviations, the "--" prefix, or the "=" # argument delimiter; otherwise, switches will be expressed the same way they # appear in the original input. If -mixed is used, pass-through keys will list # all switches first before listing any parameters. If no arguments are # assigned to a pass-through key, its value will be empty string. # # The [argparse] -pass switch may be used to collect unrecognized arguments into # a pass-through key, rather than failing with an error. Normalization and # unmixing will not be applied to these arguments because it is not possible to # reliably determine if they are switches or parameters; in particular, it is # not known if an undefined switch expects an argument. # # [argparse] produces a set of keys and values. The keys are the names of # caller variables into which the values are stored, unless -inline is used, in # which case the key-value pairs are returned as a dict. The element names # default to the key names, unless overridden by -key, -pass, or -template. If # both -key and -pass are used, two keys are defined: one having the element # value, the other having the pass-through elements. # # -template applies to elements using neither -key nor -pass. Its value is a # substitution template applied to element names to determine key names. "%" in # the template is replaced with the element name. To protect "%" or "\" from # replacement, precede it with "\". One use for -template is to put the result # in an array, e.g. with "-template arrayName(%)". # # Elements with -upvar are special. Rather than having normal values, they are # bound to caller variables using the [upvar] command. -upvar conflicts with # -inline because it is not possible to map a dict value to a variable. Due to # limitations of arrays and [upvar], -upvar cannot be used with keys whose names # resemble array elements. -upvar conflicts with -catchall because the value # must be a variable name, not a list. The combination -upvar -switch -optional # is disallowed for the same reason. If -upvar is used with switches or with # optional parameters, [info exists KEY] returns 1 both when the element is not # present and when its value is the name of a nonexistent variable. To tell the # difference, check if [info vars KEY] returns an empty list; if so, the element # is not present. Note that the argument to [info vars] is a [string match] # pattern, so it may be necessary to precede *?[]\ characters with backslashes. # # Argument processing is performed in three stages: switch processing, parameter # allocation, and parameter assignment. All aspects of argument processing are # performed left-to-right, through in multiple stages adn passes. # # All switches must normally appear in the argument list before any parameters. # Switch processing terminates with the first argument (besides arguments to # switches) that does not start with "-" (or "--", if -long is used). The # special switch "--" can be used to force switch termination if the first # parameter happens to start with "-". If no switches are defined, the first # argument is known to be a parameter even if it starts with "-". # # When the -mixed switch is used, switch processing continues after encountering # arguments that do not start with "-" or "--". This is convenient but may be # ambiguous in cases where parameters look like switches. To resolve ambiguity, # the special "--" switch terminates switch processing and forces all remaining # arguments to be parameters. # # After switch processing, parameter allocation determines how many arguments to # assign to each parameter. Arguments assigned to switches are not used in # parameter processing. First, arguments are allocated to required parameters; # second, to optional, non-catchall parameters; and last to catchall parameters. # Finally, each parameter is assigned the allocated number of arguments. proc argparse {args} { # Process switches and locate the definition argument. set level 1 for {set i 0} {$i < [llength $args]} {incr i} { if {[lindex $args $i] eq "--"} { # Stop after "--". incr i break } elseif {[catch { regsub {^-} [tcl::prefix match -message switch { -equalarg -exact -inline -level -long -mixed -normalize -pass -reciprocal -template } [lindex $args $i]] {} switch }]} { # Stop at the first non-switch argument. break } elseif {$switch ni {level pass template}} { # Process switches with no arguments. set $switch {} } elseif {$i == [llength $args] - 1} { return -code error "-$switch requires an argument" } else { # Process switches with arguments. set $switch [lindex $args [incr i]] } } # Extract the definition and args parameters from the argument list, pulling # from the caller's args variable if the args parameter is omitted. switch [expr {[llength $args] - $i}] { 0 { return -code error "missing required parameter: definition" } 1 { set definition [lindex $args end] set argv [uplevel 1 {set args}] } 2 { set definition [lindex $args end-1] set argv [lindex $args end] } default { return -code error "too many arguments" }} # Parse element definition list. set def {} set aliases {} set order {} set switches {} set upvars {} foreach elem $definition { # Read element definition switches. set opt {} for {set i 1} {$i < [llength $elem]} {incr i} { if {[set switch [regsub {^-} [tcl::prefix match { -alias -argument -catchall -default -forbid -ignore -imply -key -level -optional -parameter -pass -reciprocal -require -required -standalone -switch -upvar -value } [lindex $elem $i]] {}]] ni { alias default forbid imply key pass require value }} { # Process switches without arguments. dict set opt $switch {} } elseif {$i == [llength $elem] - 1} { return -code error "-$switch requires an argument" } else { # Process switches with arguments. incr i dict set opt $switch [lindex $elem $i] } } # Process the first element of the element definition. if {![llength $elem]} { return -code error "element definition cannot be empty" } elseif {[dict exists $opt switch] && [dict exists $opt parameter]} { return -code error "-switch and -parameter conflict" } elseif {![dict exists $opt switch] && ![dict exists $opt parameter]} { # If -switch and -parameter are not used, parse shorthand syntax. if {![regexp -expanded { ^(?:(-) # Leading switch "-" (?:(\w[\w-]*)\|)?)? # Optional switch alias (\w[\w-]*) # Switch or parameter name ([=?!*^]*)$ # Optional flags } [lindex $elem 0] _ minus alias name flags]} { return -code error "bad element shorthand: [lindex $elem 0]" } if {$minus ne {}} { dict set opt switch {} } else { dict set opt parameter {} } if {$alias ne {}} { dict set opt alias $alias } foreach flag [split $flags {}] { dict set opt [dict get { = argument ? optional ! required * catchall ^ upvar } $flag] {} } } elseif {![regexp {^\w[\w-]*$} [lindex $elem 0]]} { return -code error "bad element name: [lindex $elem 0]" } else { # If exactly one of -switch or -parameter is used, the first element # of the definition is the element name, with no processing applied. set name [lindex $elem 0] } if {[dict exists $opt switch]} { # For switches, -optional, -required, and -catchall imply -argument. foreach switch {optional required catchall} { if {[dict exists $opt $switch]} { dict set opt argument {} } } } else { # Parameters are required unless -catchall or -optional are used. if {[dict exists $opt catchall] || [dict exists $opt optional]} { dict set opt optional {} } else { dict set opt required {} } } # Check requirements and conflicts. foreach {switch others} { parameter {alias value argument imply} ignore {key pass} required default argument value upvar {inline catchall} } { if {[dict exists $opt $switch]} { foreach other $others { if {[dict exists $opt $other]} { return -code error "-$switch and -$other conflict" } } } } if {[dict exists $opt upvar] && [info exists inline]} { return -code error "-upvar and -inline conflict" } if {[dict exists $opt level] && ![dict exists $opt upvar]} { return -code error "-level requires -upvar" } # Check for disallowed combinations. foreach combination { {switch optional catchall} {switch optional upvar} {parameter optional required} } { foreach switch [list {*}$combination {}] { if {$switch eq {}} { return -code error "[join [lmap switch $combination { string cat - $switch }]] is a disallowed combination" } elseif {![dict exists $opt $switch]} { break } } } # Check for collisions. if {[dict exists $def $name]} { return -code error "element name collision: $name" } # Compute default output key if -ignore, -key, and -pass aren't used. if {![dict exists $opt ignore] && ![dict exists $opt key] && ![dict exists $opt pass]} { if {[info exists template]} { dict set opt key [string map\ [list \\\\ \\ \\% % % $name] $template] } else { dict set opt key $name } } if {[dict exists $opt parameter]} { # Keep track of parameter order. lappend order $name # Forbid more than one catchall parameter. if {[dict exists $opt catchall]} { if {[info exists catchall]} { return -code error "multiple catchall parameters:\ $catchall and $name" } else { set catchall $name } } } elseif {![dict exists $opt alias]} { # Build list of switches. lappend switches -$name } elseif {![regexp {^\w[\w-]*$} [dict get $opt alias]]} { return -code error "bad alias: [dict get $opt alias]" } elseif {[dict exists $aliases [dict get $opt alias]]} { return -code error "element alias collision: [dict get $opt alias]" } else { # Build list of switches (with aliases), and link switch aliases. dict set aliases [dict get $opt alias] $name lappend switches -[dict get $opt alias]|$name } # Map from upvar keys back to element names, and forbid collisions. if {[dict exists $opt upvar] && [dict exists $opt key]} { if {[dict exists $upvars [dict get $opt key]]} { return -code error "multiple upvars to the same variable:\ [dict get $upvars [dict get $opt key]] $name" } dict set upvars [dict get $opt key] $name } # Save element definition. dict set def $name $opt } # Process constraints. dict for {name opt} $def { # Verify constraint references. foreach constraint {require forbid} { if {[dict exists $opt $constraint]} { foreach otherName [dict get $opt $constraint] { if {![dict exists $def $otherName]} { return -code error "$name -$constraint references\ undefined element: $otherName" } } } } # Create reciprocal requirements. if {([info exists reciprocal] || [dict exists $opt reciprocal]) && [dict exists $opt require]} { foreach other [dict get $opt require] { dict update def $other otherOpt { dict lappend otherOpt require $name } } } # Create forbid constraints on shared keys. if {[dict exists $opt key]} { dict for {otherName otherOpt} $def { if {$name ne $otherName && [dict exists $otherOpt key] && [dict get $otherOpt key] eq [dict get $opt key] && (![dict exists $otherOpt forbid] || $name ni [dict get $otherOpt forbid])} { dict update def $otherName otherOpt { dict lappend otherOpt forbid $name } } } } } # Handle default pass-through switch by creating a dummy element. if {[info exists pass]} { dict set def {} pass $pass } # Perform switch logic before doing anything with parameters. set result {} set missing {} if {[llength $switches]} { # Build regular expression to match switches. set re ^- if {[info exists long]} { append re -? } append re {(\w[\w-]*)} if {[info exists equalarg]} { append re (?:(=)(.*))? } else { append re ()() } append re $ # Process switches, and build the list of parameter arguments. set params {} while {[llength $argv]} { # Check if this argument appears to be a switch. set argv [lassign $argv arg] if {[regexp $re $arg _ name equal val]} { # This appears to be a switch. Fall through to the handler. } elseif {$arg eq "--"} { # If this is the special "--" switch to end all switches, all # remaining arguments are parameters. set params $argv break } elseif {[info exists mixed]} { # If -mixed is used and this is not a switch, it is a parameter. # Add it to the parameter list, then go to the next argument. lappend params $arg continue } else { # If this is not a switch, terminate switch processing, and # process this and all remaining arguments as parameters. set params [linsert $argv 0 $arg] break } # Process switch aliases. if {[dict exists $aliases $name]} { set name [dict get $aliases $name] } # Preliminary guess for the normalized switch name. set normal -$name # Perform switch name lookup. if {[dict exists $def $name switch]} { # Exact match. No additional lookup needed. } elseif {![info exists exact] && ![catch { tcl::prefix match -message switch [lmap {key data} $def { if {[dict exists $data switch]} { set key } else { continue } }] $name } name]} { # Use the switch found unambigous prefix matching. set normal -$name } elseif {[dict exists $def {}]} { # Use default pass-through if defined. set name {} } else { # Fail if this is an invalid switch. set switches [lsort $switches] if {[llength $switches] > 1} { lset switches end "or [lindex $switches end]" } set switches [join $switches\ {*}[if {[llength $switches] > 2} {list ", "}]] return -code error "bad switch \"$arg\": must be $switches" } # If the switch is standalone, ignore all constraints. if {[dict exists $def $name standalone]} { foreach other [dict keys $def] { dict unset def $other required dict unset def $other require dict unset def $other forbid if {[dict exists $def $other parameter]} { dict set def $other optional {} } } } # Keep track of which elements are present. dict set def $name present {} # If the switch value was set using -switch=value notation, insert # the value into the argument list to be handled below. if {$equal eq "="} { set argv [linsert $argv 0 $val] } # Load key and pass into local variables for easy access. unset -nocomplain key pass foreach var {key pass} { if {[dict exists $def $name $var]} { set $var [dict get $def $name $var] } } # Store the switch value into the caller's variable. if {[dict exists $def $name catchall]} { # The switch is catchall, so store all remaining arguments. if {[info exists key]} { dict set result $key $argv } if {[info exists pass]} { if {[info exists normalize]} { dict lappend result $pass $normal {*}$argv } else { dict lappend result $pass $arg {*}$argv } } break } elseif {![dict exists $def $name argument]} { # The switch expects no arguments. if {$equal eq "="} { return -code error "$normal doesn't allow an argument" } if {[info exists key]} { if {[dict exists $def $name value]} { dict set result $key [dict get $def $name value] } else { dict set result $key {} } } if {[info exists pass]} { if {[info exists normalize]} { dict lappend result $pass $normal } else { dict lappend result $pass $arg } } } elseif {[llength $argv]} { # The switch was given the expected argument. if {[info exists key]} { if {[dict exists $def $name optional]} { dict set result $key [list {} [lindex $argv 0]] } else { dict set result $key [lindex $argv 0] } } if {[info exists pass]} { if {[info exists normalize]} { dict lappend result $pass $normal [lindex $argv 0] } elseif {$equal eq "="} { dict lappend result $pass $arg } else { dict lappend result $pass $arg [lindex $argv 0] } } set argv [lrange $argv 1 end] } else { # The switch was not given the expected argument. if {![dict exists $def $name optional]} { return -code error "$normal requires an argument" } if {[info exists key]} { if {[dict exists $def $name default]} { dict set result $key [dict get $def $name default] } else { dict set result $key {} } } if {[info exists pass]} { if {[info exists normalize]} { dict lappend result $pass $normal } else { dict lappend result $pass $arg } } } # Prepend argument list with this switch's implied arguments. if {[dict exists $def $name imply]} { set argv [concat [dict get $def $name imply] $argv] dict unset def $name imply } } # Build list of missing required switches. dict for {name opt} $def { if {[dict exists $opt switch] && ![dict exists $opt present] && [dict exists $opt required]} { if {[dict exists $opt alias]} { lappend missing -[dict get $opt alias]|$name } else { lappend missing -$name } } } # Fail if at least one required switch is missing. if {[llength $missing]} { set missing [lsort $missing] if {[llength $missing] > 1} { lset missing end "and [lindex $missing end]" } set missing [join $missing\ {*}[if {[llength $missing] > 2} {list ", "}]] return -code error [string cat "missing required switch"\ {*}[if {[llength $missing] > 1} {list es}] ": " $missing] } } else { # If no switches are defined, bypass the switch logic and process all # arguments using the parameter logic. set params $argv } # Allocate one argument to each required parameter, including catchalls. set alloc {} set count [llength $params] set i 0 foreach name $order { if {[dict exists $def $name required]} { if {$count} { dict set alloc $name 1 incr count -1 } else { lappend missing $name } } incr i } # Fail if at least one required parameter is missing. if {[llength $missing]} { if {[llength $missing] > 1} { lset missing end "and [lindex $missing end]" } return -code error [string cat "missing required parameter"\ {*}[if {[llength $missing] > 1} {list s}] ": "\ [join $missing {*}[if {[llength $missing] > 2} {list ", "}]]] } # Try to allocate one argument to each optional, non-catchall parameter, # until there are no arguments left. if {$count} { foreach name $order { if {![dict exists $def $name required] && ![dict exists $def $name catchall]} { dict set alloc $name 1 if {![incr count -1]} { break } } } } # Process excess arguments. if {$count} { if {[info exists catchall]} { # Allocate remaining arguments to the catchall parameter. dict incr alloc $catchall $count } elseif {[dict exists $def {}]} { # If there is no catchall parameter, instead allocate to the default # pass-through result key. lappend order {} dict set alloc {} $count } else { return -code error "too many arguments" } } # Check constraints. dict for {name opt} $def { if {[dict exists $opt present]} { foreach {match condition description} { 1 require requires 0 forbid "conflicts with" } { if {[dict exists $opt $condition]} { foreach otherName [dict get $opt $condition] { if {[dict exists $def $otherName present] != $match} { foreach var {name otherName} { if {[dict exists $def [set $var] switch]} { set $var -[set $var] } } return -code error "$name $description $otherName" } } } } } } # Store parameters in result dict. set i 0 foreach name $order { if {[dict exists $alloc $name]} { if {![dict exists $def $name catchall] && $name ne {}} { set val [lindex $params $i] if {[dict exists $def $name pass]} { dict lappend result [dict get $def $name pass] $val } incr i } else { set step [dict get $alloc $name] set val [lrange $params $i [expr {$i + $step - 1}]] if {[dict exists $def $name pass]} { dict lappend result [dict get $def $name pass] {*}$val } incr i $step } if {[dict exists $def $name key]} { dict set result [dict get $def $name key] $val } } } # Create default values for missing elements. dict for {name opt} $def { if {[dict exists $opt key] && ![dict exists $result [dict get $opt key]]} { if {[dict exists $opt default]} { dict set result [dict get $opt key] [dict get $opt default] } elseif {[dict exists $opt catchall]} { dict set result [dict get $opt key] {} } } if {[dict exists $opt pass] && ![dict exists $result [dict get $opt pass]]} { dict set result [dict get $opt pass] {} } } # Return result dict or store into caller variables. if {[info exists inline]} { return $result } else { dict for {key val} $result { if {![dict exists $upvars $key]} { uplevel 1 [list set $key $val] } else { if {[dict exists $def [dict get $upvars $key] level]} { set thisLevel [dict get $def [dict get $upvars $key] level] } else { set thisLevel $level } uplevel 1 [list upvar $level $val $key] } } } } ====== **Compatibility** This code is written for Tcl 8.6 and newer. If you want to use this with Tcl 8.5, you will need: * [lmap forward compatibility] * [string cat] forward compatibility * [Forward-compatible tcl::prefix] * [Forward-compatible try and throw] For Tcl 8.4, you will need: * [forward-compatible dict] * [[[eval]]] instead of [{*}] (invasive change) <> Command