Posted to tcl by aspect at Fri Nov 06 08:33:21 GMT 2015view raw

  1.  
  2. proc check {obj} {
  3. set obj [uplevel 1 [list namespace which $obj]]
  4. puts "$obj is:"
  5. foreach what {object class metaclass} {
  6. puts "\t$what: [info object isa $what $obj]"
  7. }
  8. }
  9.  
  10. ::oo::class create Namedclass {
  11. self method create {name args} {
  12. tailcall my createWithNamespace $name $name {*}$args
  13. }
  14. }
  15.  
  16. Namedclass create xx {
  17. superclass ::oo::class
  18. }
  19.  
  20. check xx
  21.  
  22. [info object namespace ::oo::class]::my createWithNamespace yy {
  23. superclass ::oo::class
  24. }
  25.  
  26. check yy
  27.  
  28.  
  29. [info object namespace ::oo::class]::my createWithNamespace zz zz
  30. oo::define zz {
  31. superclass ::oo::class
  32. }
  33.  
  34. check zz
  35.  
  36. # ::xx is:
  37. # object: 1
  38. # class: 0
  39. # metaclass: 0
  40. # ::yy is:
  41. # object: 1
  42. # class: 1
  43. # metaclass: 0
  44. # ::zz is:
  45. # object: 1
  46. # class: 1
  47. # metaclass: 1
  48.