====== # Declare accessor methods for instance variables # proc oo::define::accessor args { set currentclass [lindex [info level 1] 1] foreach var $args { oo::define $currentclass [subst { method $var args { set $var {*}\$args } }] } } #oo::class create X { # variable a b c # accessor a b # # constructor {} { # set a 34 # } #} # #X create x #puts [x a] #x a 21 #puts [x a] # Control method visibility # proc oo::define::public { method name args body } { set currentclass [lindex [info level 1] 1] oo::define $currentclass [subst { method $name { $args } { $body }; export $name }] } proc oo::define::private { method name args body } { set currentclass [lindex [info level 1] 1] oo::define $currentclass [subst { method $name { $args } { $body }; unexport $name }] } # Create procs in the objects namespace that forward calls to class methods. This # allows methods to be called without [self] or [my]. # proc procs args { foreach proc $args { proc [uplevel 1 { namespace current }]::$proc args [subst { tailcall my $proc {*}\$args }] } } #oo::class create X { # constructor {} { # procs a b c # } # # method a {} { b } # method b {} { puts XXX } #} # #X create x #x a proc ::oo::Helpers::classvar { args } { # http://wiki.tcl.tk/21595 + mods set class [lindex [uplevel 1 {self class}] 0] oo::define $class self export varname foreach { var value } $args { set myvar [uplevel 1 [list my varname $var]] set clvar [$class varname $var] uplevel 1 [list upvar $clvar $myvar] if { ![info exists $clvar] } { set $clvar $value } } } ======