======
# 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
        }
    }
}
======
----
'''[AK] - 2012-09-13 16:57:59'''

This might be a candidate for inclusion into
http://tcllib.cvs.sourceforge.net/viewvc/tcllib/tcllib/modules/ooutil/

----

[dkf] suggested these as substitutes for my public and private method modifiers, but I get an error when I try them out:

[jbr] later - [dkf] points out on [TclOO Tricks] that this may be fixed in HEAD
 
======
proc oo::define::public { method name args body } {   ; # [dkf] - 2012-09-14
      uplevel 1 [list method $name $args $body]
      uplevel 1 [list export $name]
}
proc oo::define::private { method name args body } {
      uplevel 1 [list method $name $args $body]
      uplevel 1 [list unexport $name]
}

        oo::class create X {
            public method XXX {} { puts XXX }
        }

        X create a
        a XXX


======

Produces:

======
john@home : tclkit8.6 tcloo.tcl 
this command may only be called from within the context of an ::oo::define or ::oo::objdefine command
    while executing
"method XXX {} { puts XXX }"
    ("uplevel" body line 1)
    invoked from within
"uplevel 1 [list method $name $args $body]"
    (procedure "public" line 2)
    invoked from within
"public method XXX {} { puts XXX }"
    (in definition script for object "::X" line 2)
    invoked from within
"oo::class create X {
            public method XXX {} { puts XXX }
        }"
======

[DKF]: That was a bug caused by using the wrong context namespace for lookups in one function inside TclOO's guts (fixed in [https://core.tcl.tk/tcl/info/ac61ee395893ab793e426d97e8fa37554b4f8ed7%|%this commit] in case you care). Update to 8.6b3 (or TclOO 0.7 if you're using Tcl 8.5). Or even 8.6b2/0.6.2; it's been fixed for quite a while now…

<<categories>> Object Orientation