Posted to tcl by aspect at Fri Nov 06 08:33:21 GMT 2015view pretty
proc check {obj} { set obj [uplevel 1 [list namespace which $obj]] puts "$obj is:" foreach what {object class metaclass} { puts "\t$what: [info object isa $what $obj]" } } ::oo::class create Namedclass { self method create {name args} { tailcall my createWithNamespace $name $name {*}$args } } Namedclass create xx { superclass ::oo::class } check xx [info object namespace ::oo::class]::my createWithNamespace yy { superclass ::oo::class } check yy [info object namespace ::oo::class]::my createWithNamespace zz zz oo::define zz { superclass ::oo::class } check zz # ::xx is: # object: 1 # class: 0 # metaclass: 0 # ::yy is: # object: 1 # class: 1 # metaclass: 0 # ::zz is: # object: 1 # class: 1 # metaclass: 1