Posted to tcl by pooryorick at Fri May 02 22:52:23 GMT 2014view pretty

proc object id {
    if {[string first :: $id] != 0} {
        set id [string trimright [uplevel namespace current] :]::$id
    }
    namespace eval $id {
        namespace ensemble create
        namespace export -clear
        namespace ensemble configure [namespace current] -unknown [
            list apply [list args {
                return [lindex $args 0]::[lindex $args 1]
            } [namespace current]]
        ]
    }
    namespace eval $id [list namespace import [namespace current]::*]
    return $id
}

proc method {name argspec attributes body} {
    set script [string map [list {{{attributes}}} [list $attributes]] {
        set id [namespace qualifiers [lindex [info level 0] 0]]
        foreach varname [set attributes {{attributes}}] {
            upvar 0 ${id}::$varname $varname
        }
    }]
    proc $name $argspec $script$body
}