[Fabricio Rocha] - 06 Apr 2010 - While working on a personal project, I found myself in the situation of creating a Tcl command with a "configure" subcommand just like the one we find in Tk and some Tcl commands. It rapidly became clear that parsing options passed to a command is not exactly a simple thing. They often appear in a random order; an unknown option can be among the valid ones; there can be options without values (if, in a "configure"-like subcommand, the user wants to receive the current value of an option); there can be values hanging in the list without a preceding option... and I still have not thought about the validity of the passed values!!

After reading a bit in [Argument Parsing, a discussion] and [command options], I took the road of separating the format checking from the values validation, and I found the existent procedures and libraries a little bit too much for what I wanted:

   * Format-checking only. I just wanted a procedure which would give me valid option/value pairs from a list of options in the very traditional and common Tcl/Tk format like "-color blue -hsize 120 -vsize 60". Without validation, it would be up to the caller procedure to do whatever it wanted with the values; and part of the parsing could be common to any other command/megawidget which works with options lists.

   * Tell the caller about options without values assigned to them, so they can be interpreted as a request for the current value of the option(s).

   * Discard invalid/unknown options if a list of valid options is provided.

   * Ignore values which are not assigned to any specific option

   * Optionally generate errors through the advanced [return] command options (I had studied this quite a bit and wrote about it in [Errors management]), so the caller could be warned about unexpected situations and correct them (or just pass the error away).

With those requirements in mind I created the following command for Tcl8.5, which seems to work very fine after some tests, so I wanted to share it here, in the hope it will be useful to someone in the same situation as mine...

======
# optionscheck
#
# Original by Fabricio Rocha - 06 Apr 2010
#
#        Creates a dictionary from a given sequence (list) of options like 
# the ones received by Tcl/Tk commands. Does not really perform parsing
# and validation of the given values, but verifies whether each option
# is valid (if a list of valid options is given) and whether each option
# is matched by one single value as usual. It can work "silently", simply
# creating special keys in the dictionary which hold the unexpected
# options and values, or can generate errors in these cases (and still
# return the dictionary). The caller can use "catch" and these errorcodes
# for providing special features, like options which don't need a value
# (like the "-nocomplain" option found in some Tcl commands).
# ARGUMENTS: "passedopts" is the list options to parse.
#        "validopts" is a list of valid options (they must be single
#        words starting with "-"); it can be an empty list if any word
#        starting with "-" can be recognized as a valid option.
#        "mode" must be -error (default if omitted) or -silent, and it means
#        how the procedure will behave if the passed options list contains
#        unusual elements.
# RESULTS: Returns a dictionary with the options and values passed in the
#        options list. Abnormal findings -- options not found in the valid
#        options list, values without a preceding option, options without
#        values following them -- are stored in the dictionary in lists under
#        the keys INVALID_OPTIONS, VALUES_WITHOUT_OPTIONS and OPTIONS_WITHOUT_
#        VALUES respectively. If the "mode" was omitted or set to "-error", 
#        the procedure will return the dictionary under the "-result" key in
#        the dictionary retrieved by the variable placed as the third argument
#        in the "catch" command.
proc optionscheck { passedopts {validopts {}} {mode {-error}} } {
        set optsdic {}
        set openkey {}
        set compareopts 1
        set invalidopts {}
        set orphanvals {}
        set optsnoval {}
        
        # Test the mode
        if { ![string length $mode] || $mode ni {-error -silent} } { 
                # mode was set to empty or an invalid value: error
                return -code 1 -errorcode {GENERAL optionscheck ABORT \
                        INVALID_ARG} "Wrong \"mode\" argument: must be -error or -silent"
        }
        
        # Simple test for the list of valid options
        if { ![llength $validopts] } {
                # If we don't have a list of valid options to compare the passed
                # options against, we won't do comparison; set the flag
                set compareopts 0
        }
        
        set listsize [llength $passedopts]
        if { $listsize < 1 } {
                # What are we going to parse, dude?
                return -code 1 -errorcode {GENERAL optionscheck ABORT NOOPTS} \
                        "List of options to check is empty"
        }
        
        # Loop begin: through the passed options list
        for {set i 0} {$i < $listsize} {incr i} {
                # Retrieve an item in the passed list
                set item [lindex $passedopts $i]
                
                # Let's guess what the item is...
                set itemtype {VAL}
                
                # If the item starts with "-" and is not a negative number,
                # it will be considered an option
                if {[string index $item 0] == "-" && [catch {expr "$item"}]} {
                        set itemtype {OPT}
                }
                
                # A value item is valid only if there is an option waiting for it
                if { $itemtype eq "VAL" } {
                        if { [string length $openkey] } {
                                dict set optsdic $openkey $item
                                set openkey ""
                        } else {
                                # Value thrown in the list without a preceding option
                                lappend orphanvals $item
                        }
                        # We can proceed to the next item
                        continue
                } else {
                        # Item was recognized as an option.
                        if { [string length $openkey] } {
                                # If there was an option waiting for a value, it got none
                                lappend optsnoval $openkey
                                # The previous option should have been given an empty
                                # value by default, so we don't need to touch it; but we
                                # must close it
                                set openkey ""
                        }
                        
                        if { $compareopts && $item ni $validopts } {
                                # Item is an invalid option: we won't add it to the dict
                                # as a key. Proceed to the next item.
                                lappend invalidopts $item
                                continue
                        }
                        # If we got here, the option can be added to the dict as a
                        # key and wait for a value in the next item 
                        dict set optsdic $item {}
                        set openkey $item
                }
        }; # loop end
                
        # After the loop, a valid option may have been left waiting for a
        # value which never came: in such case, add it to the respective list.
        if { [string length $openkey] } {
                lappend optsnoval $openkey
        }
                
        # Now include in the dictionary the unexpected results we got, and
        # generate errors if the alert flag was set
        set errlist {GENERAL OptionsFilter}
        
        if { [set lsize [llength $invalidopts]] } {
                dict set optsdic INVALID_OPTIONS [list $invalidopts]
                if { $mode eq "-error" } {        
                        if { $lsize > 1 } {
                                set errmsg "Invalid options found"
                        } else {
                                set errmsg "Invalid option found"
                        }
                        lappend errlist INVALID_OPTIONS
                        return -code 1 -errorcode [list $errlist] \
                                -options "-result [list $optsdic]" $errmsg
                }
        }
        
        if { [set lsize [llength $orphanvals]] } {
                dict set optsdic VALUES_WITHOUT_OPTIONS [list $orphanvals]
                if { $mode eq "-error" } {        
                        if { $lsize > 1 } {
                                set errmsg "Values without preceding options"
                        } else {
                                set errmsg "Value without preceding option"
                        }
                        lappend errlist VALUES_WITHOUT_OPTIONS
                        return -code 1 -errorcode [list $errlist] \
                                -options "-result [list $optsdic]" $errmsg
                }
        }
        
        if { [set lsize [llength $optsnoval]] } {
                dict set optsdic OPTIONS_WITHOUT_VALUES [list $optsnoval]
                if { $mode eq "-error" } {        
                        if { $lsize > 1 } {
                                set errmsg "Options without values"
                        } else {
                                set errmsg "Option without a value"
                        }
                        lappend errlist OPTIONS_WITHOUT_VALUES
                        return -code 1 -errorcode [list $errlist] \
                                -options "-result [list $optsdic]" $errmsg
                }
        }
        
        # If we got here, we are in silent mode: just return
        return ${optsdic}
}
======

Excuse me for being so highly verbose - this lot of comments help myself to think better about what I'm doing... Observe that the lists assigned to `-errorcode` options in the `return` commands have a format which suits my project's needs; adapt them to the format you use in your application or library.

Here is a simple and silly usage example (requires some adaptation if you really want to run it):

======
array set MyOptions {-color blue -height 120 -width 60 -font courier}
set valids {-color -height -width -font}
# ....

if { [catch "optionscheck $args $valids -error" retval retdict] } {
    # Ooops, there was something uncommon in this list.
    set whathappened [lindex [dict get $retdict "-errorcode"] end]
    set optionsdict [dict get $retdict "-return"]
    if { $whathappened eq "OPTIONS_WITHOUT_VALUES" } {
        # hmm, the user wants to retrieve the values of some options
        foreach opt [dict get $optionsdict OPTIONS_WITHOUT_VALUES] {
            dict set querydict $opt MyOptions($opt)
        }
        return $querydict
    }
    # Let's use other method now:
    if { [dict exists $retdict INVALID_OPTIONS] } {
        # just forward the error message
        return -code 1 $retval
    }
} else {
    # Very usual options list, the user defined new values for some or all options
    # If an error didn't happen, retval contains the options dictionary
    dict for {opt val} $retval {
        set MyOptions($opt) $val
    }
    return [array get MyOptions]
}

======


<<categories>>Enter Category Here