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:
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 optionscheck WARN}
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]
}