Updated 2014-06-11 15:20:21 by pooryorick
# 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:
[email protected] : 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 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…