Posted to tcl by hypnotoad at Mon Jun 01 15:58:42 GMT 2015view raw

  1. package require oo::meta
  2.  
  3. oo::class create small_class {
  4. constructor {} {}
  5. method hello {} {puts hello}
  6. }
  7.  
  8. oo::class create large_class {
  9. property deputy first {class small_class}
  10. property deputy second {class small_class}
  11.  
  12. constructor {} {
  13. foreach {name desc} [my meta get deputy] {
  14. set class [dict get $desc class]
  15. set obj [$class create $name]
  16. oo::objdefine [self] forward $name $obj
  17. oo::objdefine $obj forward parent [self]
  18. }
  19.  
  20. method hello {} {
  21. foreach obj [my meta keys deputy] {
  22. $obj hello
  23. }
  24. }
  25. }
  26.  
  27. large_class create myLargeObject
  28. myLargeObject hello
  29. myLargeObject first hello
  30. myLargeObject second hello