JeffL - (Thanks to Gerald L for setting me straight on my oo::define method problems)
A simple TclOO basic Class scaffolding procedure. For when you need dead-simple classes with basic attributes, and don't want to build any Methods. Saves a lot of typing!
Inspired by the Object::Tiny module in the Perl world.
Attributes are set at object creation time in a very Tcl-ish fashion. Also, provides a bit of attribute validation.
Because the Classes are oo::class, you can add in any other required features like Methods, Superclass, Mixins, etc.
package require Tcl 8.6
proc tinyclass {classname args} {
# create the named class
oo::class create $classname
# add our attributes(variables) to the class
oo::define $classname variable -append {*}$args
# define the constructor to handle Tcl-ish named attributes
oo::define $classname constructor {args} {
if {[llength $args] && [expr [llength $args] % 2]} {
puts stderr "incorrect number of arguments"
[self] destroy
}
set opts [dict create {*}$args]
foreach optk [dict keys $opts] {
set key [regsub {^-} $optk ""]
if {[lsearch [info class variables [self class]] $key] == -1} {
puts stderr "invalid attribute '$optk'"
[self] destroy
}
# set the named instance variable accordingly
set $key [dict get $opts $optk]
}
}
set mblock {
if {[llength $args]} {
set %1$s [lindex $args 0]
}
return $%1$s
}
# add get/set method names that correspond to attributes
foreach mname $args {
oo::define $classname method $mname {args} [format $mblock $mname]
}
return 0
}Usage and testing
% source tinyclass.tcl # define a named class, and provide some attribute names. # Usage: tinyclass ClassName ?attributes...? % tinyclass Widget model color # create a new Widget object, with Tcl-ish attributes % set o [Widget new -model 13A -color blue] ::oo::Obj12 # what happens when invalid attributes are specified? % Widget new -shape cylinder invalid attribute '-shape' object deleted in constructor # check if attributes were set properly at build time % puts $::oo::Obj12::model 13A # use our attribute SET method % puts [$o model 14A] 14A # use our attribute GET method % puts [$o model] 14A
arjen - 2015-04-30 11:58:38
Instead of [format] you could use the command [string map]. It is less flexible perhaps, but the template (mblock) is a bit clearer.