Posted to tcl by dizach at Thu Jan 21 14:27:22 GMT 2010view raw

  1. proc ooRecreateMethod {class meth} {
  2. if {$meth in {create new} } return
  3. set fwd {}
  4. # catch "definition not available for this kind of method"
  5. if {[catch {
  6. set defs [info class definition $class $meth]
  7. } err]} {
  8. # see if this is because it's a forward
  9. if {[catch {info class forward $class $meth} fwd]} { set fwd {} }
  10. set defs [list {} {}]
  11. }
  12. foreach {arg scr} $defs {
  13. if {$fwd ne {}} {
  14. append txt "\tforward $meth $fwd\n"
  15. } else {
  16. append txt "\tmethod $meth [methodArgs $arg] {$scr}\n"
  17. }
  18. }
  19. return $txt
  20. }