TclOO Accessors

I've tried adding a feature similar to the attr_accessor method found in Ruby to TclOO.

I have to admit that this is hacky at best, and not useful when not all your variables should be accessors, but it might serve as a starting point for others.

One thing I learned about TclOO is that it's very hard to add new methods to oo::define. After reading the source a bit I found that it uses a special stack frame.

This way it tries to restrict usage of its commands within a single stack level, which is impossible to use with uplevel.

I'm very skeptical about the need for such a restriction, given that it will lead to hacks similar to this one. It's definitely possible right now to execute oo::define commands within the oo::define script, so the restriction is weak at best. What would be needed for easy Pure-Tcl extensions of TclOO is availability of the class name or allowing uplevel into the stack frame.

PYK 2013-04-18: edited code syntax to improve robustness, and added [uplevel] command, which may be exactly what dkf's comment below was referring to

#! /bin/env tclsh

package require TclOO

proc oo::define::accessor args {
  set class [lindex [uplevel info level 0] 1]

  ::oo::define $class variable {*}$args
  foreach {name} $args {
    ::oo::define $class method $name {} [string map [list \$name $name] {return [set $name]}]
    ::oo::define $class method $name= {new} [string map [list \$name $name] {return [set $name $new]}]
  }
}


oo::class create Person {
  accessor first last

  method name {} {
        return [list [my first] [my last]]
  }
}


set person [Person new]
$person first= John
$person last= Doe
puts [$person name] ;# => John Doe

DKF: The restriction on oo::define's magic is because the context (i.e., the class being modified) is stored as a special field in the stack frame. This is a little odd in some senses, but means that nesting one oo::define inside another (referring to different classes) will work exactly as expected, with zero surprises. And it's probably easier to use “uplevel 1 [list method ...]” instead of what you're doing here.

Another way to write accessors. Builds on the above, but a little more concise:

proc oo::define::attr {access args} {
    set class [lindex [info level -1] 1]
    ::oo::define $class variable {*}$args
    if {"reader" in $access} {
        foreach name $args {
            ::oo::define $class method $name {} [format {set %s} $name]
        }
    }
    if {"writer" in $access} {
        foreach name $args {
            ::oo::define $class method $name= v [format {set %s $v} $name]
        }
    }
}

interp alias {} ::oo::define::attr_reader {} ::oo::define::attr reader
interp alias {} ::oo::define::attr_writer {} ::oo::define::attr writer
interp alias {} ::oo::define::attr_accessor {} ::oo::define::attr {reader writer}

GeoffM: Here is my simple baseclass which makes all variables of an object derived from baseclass accessible. Provided you know its name.

package require TclOO

oo::class create baseclass {
   constructor {} {}
   
   method set {name {value "-1.234e1234"}} {
      # access and set member variables.
      my variable $name ;# variable to be accessed
      if {$value != "-1.234e1234"} {
         set $name $value
      } else {
         set $name
      }
   }
}

 # Example:
oo::class create tile {
   superclass baseclass
   constructor {i m p} {
      my variable v1
      my variable colour
      my variable picture
      set v1 $m
      set colour $p
      set picture $i
   }
}

 # Exercise it:
set a [tile new 1 2 3 ]
set b [tile new 11 12 13 ]
set c [tile new 9 8 7]

$a set v1 ;# return value of v1 in object a
$a set colour ;# etc etc
$b set v1 ;# and so on

$b set v1 123.456 ;# change value of v1 in object b
$b set v1

Note that the method "set" is similar to set for plain variables. That is it sets a value or gets returns its value.

I chose the default string as "-1.234e1234" since it is meaningless, would interpret as a too small to represent number, and is unlikely to occur in any reasonable program.

DKF: Formally, that's a too-large-to-represent number with negative sign. Too small would be 123e-1234. Good choice though.

Category Object Orientation