Here's some code I've been working on to try to do a Tk-like configure and cget using TclOO. (You might want to look at how option works to understand a few bits of this code.)
A development of this resulted in TIP 558, oo::configurable, which does a more general approach and presents a class consumer API more like fconfigure.
oo::class create Configurable { # Returns a SORTED DICTIONARY. Keys are full option names. Values are 4-element lists: # 1. backing instance variable name # 2. Tk option DB info (two elements, name and class; name begins with lower case, class with upper) # 3. main default value; assumed to be valid # 4. validator callback, or empty for no validation method ConfigDescriptor {} { throw {TKOO MEGA NO_CONFIG} "no configuration descriptor defined" } method GetDefault {widget itemdescriptor} { lassign $itemdescriptor varname optionDBinfo default validator # This is the ONLY truly Tk-specific code in here if {[winfo exists $widget] && $optionDBinfo ne "{} {}"} { return [list [option get $widget {*}$optionDBinfo] $default] } else { return [list $default] } } # Sets up defaults; intended for use in a constructor method SetInitValues {widget} { set descriptor [my ConfigDescriptor] dict for {option desc} $descriptor { lassign $desc varname optionDBinfo default validator upvar 0 [my varname $varname] var set didset false set defaults [my GetDefault $widget $desc] foreach default $defaults { if {$default ne "" && [llength $validator]} { catch { {*}$validator $option $default set var $default set didset true } } if {$didset} break } if {!$didset} { set var [lindex $defaults end] } } } # A traditional configure; you'll *ALSO* want to call this from a constructor for Tk style method configure {args} { set descriptor [my ConfigDescriptor] if {[llength $args] == 0} { set result {} dict for {option desc} $descriptor { lassign $desc varname optionDBinfo default validator upvar 0 [my varname $varname] var lappend result [list $option {*}$optionDBinfo $default $var] } return $result } elseif {[llength $args] == 1} { set option [lindex $args 0] if {[dict exists $descriptor $option]} { set desc [dict get $descriptor $option] } else { set opt [::tcl::prefix match [dict keys $descriptor] $option] set desc [dict get $descriptor $opt] } lassign $desc varname optionDBinfo default validator upvar 0 [my varname $varname] var return [list $option {*}$optionDBinfo $default $var] } elseif {[llength $args] & 1} { # Ought to fill this out better return -code error "wrong num args..." } else { foreach {option value} $args { if {[dict exists $descriptor $option]} { set desc [dict get $descriptor $option] } else { set opt [::tcl::prefix match [dict keys $descriptor] $option] set desc [dict get $descriptor $opt] } lassign $desc varname optionDBinfo default validator upvar 0 [my varname $varname] var if {[llength $validator]} { {*}$validator $option $value } set var $value } return } } # Traditional cget method method cget {option} { set descriptor [my ConfigDescriptor] if {[dict exists $descriptor $option]} { set desc [dict get $descriptor $option] } else { set opt [::tcl::prefix match [dict keys $descriptor] $option] set desc [dict get $descriptor $opt] } lassign $desc varname optionDBinfo default validator upvar 0 [my varname $varname] var return $var } # Sample validator for booleans method ValidBoolean {option value} { if {![string is boolean -strict $value]} { return -code error "bad boolean for $option \"$value\"" } } }
Example usage:
oo::class create FooBarMegawidget { # There are other bits of being a megawidget; I'll not cover them here superclass Widget Configurable variable cmd enable method ConfigDescriptor {} { return { -command {cmd {command Command} "" {}} -enabled {enable {enabled Enabled} 0 {my ValidBoolean}} } } constructor {widget args} { next ...; # Other stuff for setting up trace add variable enable write [namespace code {my SetEnable}] my SetInitValues $widget my configure {*}$args } method SetEnable args { puts "-enabled is now set to $enable" } method invoke {} { if {$cmd ne ""} { uplevel "#0" $cmd } } }