Posted to tcl by dkf at Mon Jul 13 08:01:02 GMT 2009view raw

  1. proc oo::define::Variable args {
  2. set existing [uplevel 1 [list info class variables $currentclass]]
  3. switch [lindex $args 0] {
  4. -append {
  5. set vars $existing
  6. lappend vars {*}[lrange $args 1 end]
  7. }
  8. -prepend {
  9. set vars [lrange $args 1 end]
  10. lappend vars {*}$existing
  11. }
  12. -remove {
  13. set vars $existing
  14. foreach var [lrange $args 1 end] {
  15. set idx [lsearch -exact $vars $var]
  16. if {$idx >= 0} {
  17. set vars [lreplace $vars $idx $idx]
  18. }
  19. }
  20. }
  21. -set - default {
  22. set vars [lrange $args 1 end]
  23. }
  24. }
  25. uplevel 1 [list variables {*}$vars]
  26. return
  27. }
  28.  
  29.  

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)