Posted to tcl by pooryorick at Fri May 02 22:52:23 GMT 2014view raw

  1. proc object id {
  2. if {[string first :: $id] != 0} {
  3. set id [string trimright [uplevel namespace current] :]::$id
  4. }
  5. namespace eval $id {
  6. namespace ensemble create
  7. namespace export -clear
  8. namespace ensemble configure [namespace current] -unknown [
  9. list apply [list args {
  10. return [lindex $args 0]::[lindex $args 1]
  11. } [namespace current]]
  12. ]
  13. }
  14. namespace eval $id [list namespace import [namespace current]::*]
  15. return $id
  16. }
  17.  
  18. proc method {name argspec attributes body} {
  19. set script [string map [list {{{attributes}}} [list $attributes]] {
  20. set id [namespace qualifiers [lindex [info level 0] 0]]
  21. foreach varname [set attributes {{attributes}}] {
  22. upvar 0 ${id}::$varname $varname
  23. }
  24. }]
  25. proc $name $argspec $script$body
  26. }
  27.