[MG] Sep 29th 2005 - Below is a set of 4 procs for working with named arguments, probably of more use for widgets (or megawidgets) than it is with doing named args for other procs. (Please note the "technical terms" here are made up, so if there actually are proper ones, please let me know:) ---- First of all, you create a '''group''' of options (with ::args::init). Each group contains a set of '''classes''', and each class has one or more '''options''' associated with it. Each class has a default value, and a setting which tells it whether the args associated with that class take a value, or are simply booleans (set/not set). ::args::init $group class1 options1 hasArg1 default1 ?classN optionsN hasArgN defaultN? $group is the name of an array which will be created, while holds information about this group of options. ''class1'' is the name of the class. ''options1'' is a Tcl list of the options associated with this class. ''hasArg1' should be either 1 (the options take an argument) or 0 (they do not). ''default1'' is the default value - if the options take an argument (ie, hasArg1 is 1), this can be any string. If hasArg1 is 0, it should be 1 or 0, and will default to that value when the option is not given (and be set to the opposite when it is given). For example, ::args::init myWidget Foreground [list -foreground -fg] 1 black Background [list -background -bg] 1 white \ Foobar -foobar 0 0 creates an array, $myWidget, holding info about several options: the -foreground and -fg options refer to the same value, which defaults to "black". The -background and -bg options refer to another value, this one defaulting to white. And the -foobar option (which takes no arg, and is a boolean) refers to another value, and defaults to 0, but will be set to 1 if the -foobar option is set. You would create a '''group''' for, for example, every type of widget you have, in this case the "myWidget" widget. ---- When you've created a group, you must then create an '''instance''' of the group. You would create an instance of the "myWidget" object set every time a "myWidget" widget is created: ::args::instance $instance $prefix $group $instance refers to an array which will hold information about this instance. All vars created in the array will begin with the $prefix prefix, which allows you to use one array to store info on all instances of a particular group. For instance, if a "myWidget" widget named .bar was created, you might use: % ::args::instance myWidgetOptions .bar, myWidget to set the default options for it. ---- After an instance has been created, you can edit it at any time using the setopts command: ::args::setopts $instance $prefix args It uses an $instance and $prefix the same as the "instance" command. ''args'' is a list of arguments to set. For instance: % ::args::setopts myWidgetOptions .bar, -fg red -background "sky blue" would edit the Foreground and Background options. This would be the backend to ''.bar configure $args'' ---- You can also query the options at any time, using the "query" comand. Again, it takes an $instance and $prefix from the "instance" command, along with an argument to query: % ::args::query $instance $prefix option full If ''full'' is 0 (default), the current value of the ''option'' option is returned. Otherwise, a Tcl list containing the option name, it's class, it's default value and it's current value is returned. This is the difference between ''$widget cget -option'' and ''$widget configure -option'' in most Tk widgets. % ::args::query MyWidgetOptions .bar, -fg red % ::args::query MyWidgetOptions .bar, -fg 1 -fg Foreground black red ---- And finally, the code itself: namespace eval ::args {} proc ::args::init {_group args} { upvar 1 $_group group foreach {class options hasarg default} $args { foreach x $options { set group(opt,$x) $class } if { $hasarg != "0" && $hasarg != "1" } { return -code error "invalid 'hasarg' \"$hasarg\""; } set group(hasarg,$class) $hasarg if { $hasarg == "0" } { set default [expr {$default ? "1" : "0"}] } set group(val,$class) $default } };# init proc ::args::instance {_inst prefix _group} { upvar 1 $_inst inst $_group group set inst(${prefix}group) $_group foreach x [array names group val,*] { set inst($prefix$x) $group($x) } };# instance proc ::args::setopts {_inst prefix args} { upvar 1 $_inst inst upvar 1 $inst(${prefix}group) group while { [llength $args] } { set this [lindex $args 0] if { ![info exists group(opt,$this)] } { return -code error "unknown option \"$this\""; } set args [lrange $args 1 end] set class $group(opt,$this) if { $group(hasarg,$class) == "0" } { set inst(${prefix}val,$class) [expr {!$group(val,$class)}] } else { if { [llength $args] > 0 } { set val [lindex $args 0] set args [lrange $args 1 end] set inst(${prefix}val,$class) $val } else { return -code error "no argument specified for \"$this\"" } } } };# setopts proc ::args::query {_inst prefix this {full 0}} { upvar 1 $_inst inst upvar 1 $inst(${prefix}group) group if { ![info exists group(opt,$this)] } { return -code error "unknown option \"$this\""; } set class $group(opt,$this) if { $full } { return [list $this $class $group(val,$class) $inst(${prefix}val,$class)]; } else { return $inst(${prefix}val,$class); } };# query ---- Any comments, questions, criticisms, etc, are welcomed. ---- See also: [Named Arguments]