TclOO Tiny Class Scaffolding

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.