Posted to tcl by dkf at Mon Jul 13 08:01:02 GMT 2009view raw
- proc oo::define::Variable args {
- set existing [uplevel 1 [list info class variables $currentclass]]
- switch [lindex $args 0] {
- -append {
- set vars $existing
- lappend vars {*}[lrange $args 1 end]
- }
- -prepend {
- set vars [lrange $args 1 end]
- lappend vars {*}$existing
- }
- -remove {
- set vars $existing
- foreach var [lrange $args 1 end] {
- set idx [lsearch -exact $vars $var]
- if {$idx >= 0} {
- set vars [lreplace $vars $idx $idx]
- }
- }
- }
- -set - default {
- set vars [lrange $args 1 end]
- }
- }
- uplevel 1 [list variables {*}$vars]
- return
- }
Comments
Posted by dkf at Mon Jul 13 08:02:57 GMT 2009 [text] [code]
The problem is determining $currentclass
Posted by dkf at Mon Jul 13 08:06:53 GMT 2009 [text] [code]
Use this: set currentclass [lindex [info level 1] 1] (It's not suitable for per-object declarations due to problems with self-decls, but will work for class declarations)