[Richard Suchenwirth] - Things (something like objects, or classes) change. In [On things], a dirt simple OO API was described, and an initial implementation in [Doing things]. It worked, but didn't satisfy me. So I decided to do it more orthogonally - which involved slight (and not bad) changes in the API, e.g.
 thing new human    ;# instead of: thing human
 human new Socrates ;# instead of: thing Socrates is-a human (*)
 thing names        ;# instead of: thing -names
 Socrates legs      ;# equivalent to: Socrates set legs
 Socrates which legs ;# new: tells where a property/way came from
 Socrates           ;# new: returns a pairlist of all properties
 Socrates clone Diogenes ;# makes an identical thing, except for name
and with namespaces (after all, those were introduced for OO). Now ''::thing'' holds the whole system. For a thing foo, a sub-namespace ''::thing::foo'' is created (and has to be explicitly deleted). Basic ''ways'' (methods) are introduced for an initial thing ''::thing::thing'' and inherited by all other things if not overridden. Ways are implemented as namespace procs (so I need not
treat default arguments, ''args'' myself.. - and they are compiled), but can still be thrown around like real lambdas: 
 [philosopher new Plato] wayto sing [Socrates wayto sing]
Each way receives the thing's name as first argument (might be called "self", or "-" if ignored).

'''(*) Note on the is-a list:''' This is every thing's backbone, take care not to break it! A usable is-a list starts with the thing's name, then possibly has the superthings, and finally the thing 'thing'':
  T2 set is-a {T2 SmartToaster Toaster thing}
Thanks to Miguel Sofer for pointing out!

So here's the current (and still pretty minimal) framework for Things:
 catch {namespace delete ::thing} ;# good for repeated sourcing in tests
 namespace eval thing {
 variable names [list] ;# initially, no things around
 proc dispatch {name {way ""} args} {
  # This is the core of the "things" engine
  foreach i [set ${name}::is-a] {
   if [llength [info command ${i}::$way]] {
    return [eval ${i}::$way $name $args]
   }
   if [info exists ${i}::$way] {return [set ${i}::$way]}
  }
  error "$way? Use one of: [join [Info $name command] {, }]"
 }
 #----------------------------- some helpers for introspection
 proc Info {name what} {
  # retrieve all own and inherited procs/properties of 'name'
  set res [list]
  foreach i [set ${name}::is-a] {
   foreach j [info $what ::thing::${i}::*] {
    regsub ::thing::${i}:: $j "" j2
    ladd res $j2
   }
  }
  lsort $res
 }
 proc lambda {name way} {
  # retrieve [list argl body] for way of thing name
  foreach i [set ${name}::is-a] {
   if [llength [set proc [info command ${i}::$way]]] {
    set res "{"; set space ""
       foreach i [info args $proc] {
     if [info default $proc $i value] {
         append res "$space{$i [list $value]}"
     } else {append res "$space$i"}
     set space " "
       }
       return [append res "} {[info body $proc]}"]
   }
  }
  error "$way? No way for $name"
 }
 }
Now we create and instrument the initial thing, but before that we have to create a way how to create (constructor, some call it):
 namespace eval thing::thing {
    proc new {self name args} {
 #way to create a new thing 'name' that is-a 'self'
 if [llength [info command $name]] {
  error "can't create thing $name: command exists"
 }
 if [llength $self] {
    set t [concat $name [set ::thing::${self}::is-a]]
 } else {
  set t $name
 }
 namespace eval ::thing::$name variable is-a [list $t]
 regsub @name {uplevel 1 thing::dispatch @name $args} $name body
 proc ::$name args $body ;#--------- so it can be called by name
 regsub @name {rename @name "" ;#} $name trace
 trace var ::thing::${name}::is-a u $trace
 lappend ::thing::names $name
 foreach {key value} $args {$name set $key $value}
 ::set name
   }
   new {} thing ;#----------------- first "thing" to do

   proc clone {self name args} {
  $self new $name
  foreach {key value} [concat [$self] $args] {
   if {$key!="is-a"} {$name set $key $value}
  }
  namespace eval ::thing::${name} {
   ::set is-a [lreplace ${is-a} 1 1]
  }
  ::set name
   }
   proc {} {self} {
  # empty way: pairlist of all property names and values
  ::set res [list]
  foreach i [lsort [info var ::thing::${self}::*]] {
   regsub ::thing::${self}:: $i "" i2
   lappend res $i2 [::set $i]
  }
  ::set res 
   }
   proc set {self {name ""} args} {
        #way to set, retrieve, or list properties
 if {$name==""} {return [::thing::Info $self vars]}
 switch [llength $args] {
  0 {}
  1 {::set ::thing::${self}::$name [lindex $args 0]}
  default {error "Usage: $self set ?name ?value??"}
 }
 if [catch {::thing::dispatch $self $name} res] {
  error "$name? No such property for $self"
 }
 ::set res
   }
   proc unset {self args} {
  foreach i $args {::unset ::thing::${self}::$i}
   }
   proc delete {self} {
             lremove ::thing::names $self
             namespace delete ::thing::$self
   }
   proc wayto {self {way _None_} args} {
      # way to define a, retrieve a, or list every way available
 if {$way=="_None_"} {return [::thing::Info $self command]}
 switch [llength $args] {
  0 {return [::thing::lambda $self $way]}
  1 {eval proc ::thing::${self}::$way [lindex $args 0]}
  default {error "Usage: $self wayto ?name ?lambda??"}
 }
 ::set args
   }
   proc which {self name} {
 # way to know where a property or way came from
 #::set path [concat $self [::set ::thing::${self}::is-a]]
 foreach i [::set ::thing::${self}::is-a] {
  if [llength [info command ::thing::${i}::$name]] {
   return $i
  }
  if [info exists ::thing::${i}::$name] {
   return $i
  }
 }
 error "no $name for $self known"
   }
 }
 proc lremove {_list what} {
   upvar $_list list
   set where [lsearch -exact $list $what]
   set list [lreplace $list $where $where] ;# no harm when where=-1
 }
 
 #----------------------------------------------- now testing...
 proc test {} {
 set test {
  thing new human legs 2 mortal 1
  human new philosopher
  philosopher new Socrates hair white
  Socrates mortal
  Socrates legs
  Socrates set legs
  Socrates set legs 3
  Socrates legs
  Socrates unset legs
  Socrates legs
  Socrates set beard long
  Socrates set
  human wayto sing {{- text} {subst $text,$text,lala.}}
  Socrates sing Kalimera
  Socrates wayto sing {{- text} {subst $text-haha}}
  Socrates sing Kalimera
  [thing new Plato] wayto sing [Socrates wayto sing]
  Plato sing Kalispera
  [human new Joe] sing hey 
  Socrates
 }
 set n 0
 foreach i [split $test \n] {
  puts -nonewline [incr n]$i=>
  puts [uplevel $i]
 }
 puts OK
 }
 time test 
# On my P200/W95 box at home, the test suite took 490..600 msec.
----
Richard - pretty nifty -K6-2/475,W98 - 110msec
''so'' 11/27/2000 -went back and unloaded the system - time dropped
to 50-60msec
----
For a comparison with Itcl, see [Toasters and things]

----
[Arts and crafts of Tcl-Tk programming]

----
See [Chaining things] for a modified version that allows method chaining (among other slight changes).