proc ?set {v_name val} {
 upvar $v_name v
 if {![info exists v]} {
  return -code error "error: variable $v_name doesn't exist."
 }
 set v $val
}

proc get.unique.command.name {} {
 while 1 {
  if {"" eq [info commands [set n cmd[clock clicks]]]} {
   return $n
  }
 }
}

# N E W

set ::_current_class ""

proc class name {
 #puts NAME:$name
 ?set ::_current_class $name
 set ::_${name}_methods [list]
}

proc dispatch {class obj argList} {
 set r {}
 foreach {sel msg} $argList {
  #puts "INVOKE $sel : $msg"
  set r [_${class}_${sel} $obj $msg]
 }
 set r
}

proc endclass {} {
 proc $::_current_class {} {
  set class [lindex [info level 0] 0]
  set obj [get.unique.command.name]
  proc $obj args "dispatch $class $obj \$args"
  return $obj
 }
 ?set ::_current_class ""
}

proc inherit class {
 #puts INH:[set ::_${class}_methods]

 foreach m [set ::_${class}_methods] {
  #check if proc already exists for this class
  if {"" ne [info commands [set cmd _${::_current_class}_$m]]} {
   puts stderr "WARNING: method in $class will override $::_current_class"
  }
  proc _${::_current_class}_$m {self msg} [info body _${class}_${m}]
 }
}

proc method {name body} {
 proc _${::_current_class}_$name {self msg} $body
 lappend ::_[set ::_current_class]_methods $name
}


# T E S T  C O D E

class Object
 method -get {
  set ::__${self}_var_${msg}
 }

 method -set {
  set ::__${self}_var_name $msg
 }

 method -to {
  set ::__${self}_var_[set ::__${self}_var_name] $msg
 }
endclass


class Funzo
 method -fust {
  puts "FUST $msg"
 } 

 method -text {
  puts "oh, if I were a text item, I'd display $msg"
 }
endclass


class Fustigate
 inherit Object
 inherit Funzo 

 method -HIHI {
  puts "HIHI $msg"
 }
endclass


# T E S T S

proc abort msg {
 puts stderr "test failure: $msg"
 exit 1
}

proc find.new.list.items {old new} {
 set r [list]
 foreach n $new {
  if {[lsearch $old $n] < 0} {
   lappend r $n
  }
 }
 return $r
}

proc test_class {} {

 puts "running class test"

 set globals [info globals]
 set cmds [info commands]
 
 class Foo
 
 if {"Foo" ne $::_current_class} {
  abort "failed to set class name"
 }
 
 if {![info exists ::_Foo_methods] || [llength [set ::_Foo_methods]]} {
  abort "failed to initialize method list"
 }

 method -fun {
  return FUN
 }

 if {"" eq [info commands _Foo_-fun]} {
  abort "method creation failed"
 }

 if {"-fun" ne [lindex [set ::_Foo_methods] 0]} {
  abort "failed to set method list for class"
 }

 endclass

 if {"" eq [info commands Foo] || "" ne [set ::_current_class]} {
  abort "endclass failed"
 }

 set newg [find.new.list.items $globals [info globals]]
 if {1 != [llength $newg] || "_Foo_methods" ne [lindex $newg 0]} {
  abort "wrong globals created"
 }

 set newc [lsort -dictionary [find.new.list.items $cmds [info commands]]]
 if {2 != [llength $newc] || "_Foo_-fun" ne [lindex $newc 0] || "Foo" ne [lindex $newc 1]} {
  abort "wrong commands created"
 }
 
 set preinst [info commands]

 set o [Foo]
 if {"FUN" ne [$o -fun]} {
  abort "method return failure"
 }

 set newc [lsort -dictionary [find.new.list.items $preinst [info commands]]]

 if {1 != [llength $newc]} {
  abort "class instantiation failed"
 }

 rename $o {}

 puts "exiting class test successfully"
}

test_class

proc test_Object {} {

}

test_Object

proc main {} {
 set f [Funzo]

 $f -fust Hello -text "Hello World"

 set o [Object]

 $o -set var -to blah
 puts GET:[$o -get var]

 set o2 [Object]
 $o2 -set var -to baoso
 puts GET02:[$o2 -get var]
 puts GET:[$o -get var]
 
 set fus [Fustigate]
 $fus -fust me
}
main