This page describes an upcoming enhancement to TclOO: Property tracking. Please stay tuned.
The concept: Adding information that is tracked by class that allows the developer to embed data inside of classes
New tools:
This method allows access to this class. Arguments that follow are the same as allowed by the "dict" command.
Return a value for a property, or die trying.
Return a value for a property, or an empty list if the value does not exist.
Return true if a property exists
Return a list of keys below the level field ?field...?
Add/modify a property
This method provides objects access to the property database of their class. (Without the hassle of having to look up their class.) At present, it is read only.
Return a value for a property, or die trying.
Return a value for a property, or an empty list if the value does not exist.
Return true if a property exists
Return a list of keys below the level field ?field...?
New Keywords:
The following keywords will be added to oo::define:
Set a property from the class definition.
Usage:
This system was originally intended to provide a Tk option-like database for TclOO objects.
# Dump the entire option dictionary
set option_dict [info object [self] property get option]
# Access a list of options
set option_list [info object [self] property list option]
# Check if an option exists
set exists [info object [self] property exists option color]
# Get the default value for color
set color [info object [self] property getnull option color default]
oo::define oo::class_withopts {
constructor args {
my InitializePublic {*}$args
}
method InitializePublic args {
my variable config
set optiondict [info object [self] property get option]
# Populate config() with defaults
foreach {field info} $optiondict {
if {[info exists config($field)]} continue
if {[dict exists $optiondict $field]} {
set config($field) [dict get $optiondict default]
} else {
set config($field) {}
}
}
foreach {field value} $args {
set key [string trimleft $key -]
if {![dict exists $optiondict $key]} {
error "Bad option: $key, valid: [lsort -dictionary [dict keys $optiondict]]"
}
set config($field) $value
}
}
method configure args {
my variable config
set triggers {}
set optiondict [info object [self] property get option]
foreach {key value} $args {
set key [string trimleft $key -]
if {![dict exists $optiondict $key]} {
error "Bad option: $key, valid: [lsort -dictionary [dict keys $optiondict]]"
}
}
foreach {key value} $args {
set key [string trimleft $key -]
if {$value != $config($key)} {
set config($key) $value
if {[dict exists $optiondict $field trigger]} {
lappend triggers $field $value [dict get $optiondict $field set-script]
}
}
}
foreach {field value script] $triggers {
eval [string map [list %object% [self] %self% [self] %field% $field %value% $value] $script]
}
}
method cget field {
set field [string trimleft $field -]
if {![info object property [self] exists option $field]} {
error "Invalid option $field, Valid [info option property [self] list option]"
}
my variable config
return $config($field)
}
}