TclOO private variables

The following code gives you private variables with TclOO. It does not make changes inside of the TclOO distribution.

Declaration of private variables is done by extending the "variable" keyword with additional switches.

-private or -privateappend will append the declared variable to the list of used private variables
-privateclear will clear the list of private variables
-privateset will set the list of private variables

Access to private variables is with calling the "my _zz_method" function.

Private variables reside inside the current object namespace. For each object superclass is here a separate namespace. There is no conflict to normal TclOO variables.

namespace eval ::zz {
  ##    Extended versions of oo::define commands.
  proc define {class args} {
    switch -- [lindex $args 0] {
      constructor {::oo::define $class {*}[lrange $args 0 1] "my _zz_method\n[lindex $args 2]"}
      destructor {::oo::define $class [lindex $args 0] "my _zz_method\n[lindex $args 1]"}
      method {::oo::define $class {*}[lrange $args 0 2] "my _zz_method\n[lindex $args 3]"}
      variable {
        switch -- [lindex $args 1] {
          -private - -privateappend {
            foreach myVar [lrange $args 2 end] {
              if {[lsearch [set ${class}::(vars)] $myVar] == -1} {
                lappend ${class}::(vars) $myVar $myVar
              }
            }
          }
          -privateclear {
            set ${class}::(vars) {}
          }
          -privateset {
            set ${class}::(vars) {}
            foreach myVar [lrange $args 2 end] {
              lappend ${class}::(vars) $myVar $myVar
            }                                                                    
          }                                                                      
          default {::oo::define $class variable {*}$args}                        
        }                                                                        
      }                                                                          
      default {tailcall ::oo::define $class {*}$args}
    }
  }
}

##      Customized oo::class command.
::oo::class create ::zz::class {
  superclass ::oo::class
  self export createWithNamespace

  ##    Always create new classes with namespace.
  #     See "oo::class create" command.
  self method create {args} {
    return [uplevel 1 [list [self] createWithNamespace [lindex $args 0] {*}$args]]
  }

  ##    Build new class using ::zz::class with additional commands.
  constructor {args} {
    # Current class name.
    set myCls [self object]
    # Make ::zz::* methods in class definition available.
    foreach myName {constructor destructor method variable} {
      interp alias {} [self namespace]::$myName {} ::zz::define $myCls $myName
    }
    # Make ::oo::define methods available.
    foreach myName {renamemethod deletemethod forward unexport mixin superclass export filter} {
      interp alias {} [self namespace]::$myName {} ::oo::define $myCls $myName
    }
    # Internal class informations.
    array set ${myCls}:: [list vars {}]
    # Method to access private variables.
    ::oo::define $myCls method _zz_method {} {
      set myCls [uplevel 1 self class]
      set myNs  [my varname { }]$myCls
      namespace eval $myNs {}
      uplevel 1 [list namespace upvar $myNs {*}[set ${myCls}::(vars)]]
    }
    # Read and evaluate the class definition.
    my eval {*}$args
  }
}

# Test
zz::class create z1 {
  variable x
  variable -private y
  constructor {} {lappend x z1;lappend y z1}
  method p {} {puts "z1: x='$x' y='$y'"}
}
zz::class create z2 {
  superclass z1
  variable x
  variable -private y
  constructor {} {next;lappend x z2;lappend y z2}
  method p {} {puts "z2: x='$x' y='$y'";next}
}
set o [z2 new]
$o p

TclOO