Cobj is a minimal object system inspired by [Gadgets] and [LOST].  It provides class inheritance. 
----
  #! /usr/local/bin/tclsh8.3

  namespace eval ::cobj {}
  namespace eval ::cobj::obj {}

  proc ::cobj::obj {type args} {
  variable _cobj_methods 

  set methods {}
  set alength [llength $args]

	if {$alength >= 2} {
		for {set i 0} {$i < [expr {$alength - 1}]} {incr i} {
		append methods "\n$_cobj_methods([lindex $args $i])"
		}
	append methods "\n[lindex $args [expr {$alength - 1}]]" ;#(1)
	}

	if {$alength == 1} {
	set methods [lindex $args 0]
	}

  set _cobj_methods($type) $methods

	namespace eval ::$type {}
	
	proc ::$type {args} "
	#puts \$args
	
		switch -- \$args {
		$methods
		}

	"

  namespace export obj
  }

----
To use it do something like this:

  cobj::obj toys::ball {
  fun {return "This is fun!"}
  testing {return "This is only a test!"}
  }

  puts [toys::ball fun]
  puts [toys::ball testing]

  #toys::bat inherits toys::ball
  cobj::obj toys::bat toys::ball {

  homerun {return "You won the game!"}
  }

  puts [toys::bat homerun]
  puts [toys::bat fun]
----
'''RS''': Really nice. If you discount blank lines and comments, the whole system fits in 24 lines of code. The point marked ;#(1) above seems to be equally expressed with ''lindex $argv end'', isn't it?

What seems to be missing is arguments for methods. Maybe by changing the object proc template like this (The name ''type'' in the above source would be clearer if called ''instance'', I suppose):
 proc ::$instance {{method {}} args} {
      switch -- \$method {
      $methods
      }
Another note: in the for loop, expr is redundant. The second arg to ''for'' will be evaluated by ''expr'' anyway, so make that
		for {set i 0} {$i < ($alength - 1)} {incr i} {

'''GPS''': Thanks.  I wish that I had known about expr being redundant in a for loop.
----

'''MS''': a system with similar properties is

  namespace eval ::cobj2 {
      proc obj2 {type args} {
  	set type [uplevel namespace current]::$type
  	if {[llength $args] >= 2} {
  	    foreach parent [lrange $args 0 end-1] {
  		set imports [uplevel namespace parent $parent]::[namespace tail $parent]::*
   		append toEval "catch {namespace import $imports}\n"
  	    }
  	}
  	foreach {procName argLst body} [lindex $args end] {
  	    append toEval "proc $procName \{$argLst\} \{$body\}\n"
  	}
   	namespace eval ::$type [append toEval {namespace export *}]
      }
      namespace export obj2
  }
  

'''Remark:''' there is a slight change in syntax: you now call
  toys::ball::fun
instead of 
  toys::ball fun


'''Properties:'''

   * Method inheritance, just like cobj - remark that only methods defined at creation time are inherited (wouldn't it be nice to have a dynamic way to import commands from other namespaces? "namespace inherit" or similar ...)
   * Updatable methods: if you change a method, it is automatically changed in all classes/objects that inherit from it - cobj does not have this property.
   * Objects are created in the "correct" namespaces, i.e., in the scope of the caller.

--
--
--

To test this system, type

  cobj2::obj2 toys::ball {
      fun {} {return "This is fun"}
      testing {} {return "This is only a test!"}
  }
  puts [toys::ball::fun]
  puts [toys::ball::testing]
  
  #toys::bat inherits toys::ball
  cobj2::obj2 toys::bat toys::ball {
      homerun {} {return "You won the game!"}
  }
  
  puts [toys::bat::homerun]
  puts [toys::bat::fun]
  
  cobj2::obj2 toys::new ::toys::bat {
      scream {} {return "I'm screaming!"}
  }
  puts [toys::new::scream]
  puts [toys::new::fun]
  puts [toys::new::homerun]

----
'''GPS''': Here is a complete rewrite of cobj:

  #! /usr/local/bin/tclsh8.3

  namespace eval ::cobj3::obj {}

  proc ::cobj3::obj {type inherits args} {

	namespace eval ::$type {}
		proc ::$type {args} {	
		set com [lindex $args 0]
		set args [lindex $args 1]
		
			switch $com {
		
				children {
				return [namespace children [lindex [info level 0] 0]]
				}
					
				destroy {
				
					foreach m $args {
					catch {namespace delete "[lindex [info level 0] 0]::$m"}
					catch {[rename "[lindex [info level 0] 0]::$m" ""]}
					}
				}

				help {
				return "Valid messages are destroy, and children."
				}
			} 				
		}

  set methods [lindex $args 0]
  set methlen [llength $methods]


	for {set i 0} {$i < $methlen} {incr i 3} { 
	set subproc ":: $type :: [lindex $methods 0]"

	regsub -all { } $subproc "" subproc
	namespace eval $subproc {}
	
		proc $subproc "[lindex $methods 1]" "
		[lindex $methods 2]
		"
	set methods [lrange $methods 3 end]	
	}

	if {[llength $inherits] != 0} {

		foreach im $inherits {
		set ns ":: $type :: [namespace tail ::$im]"
		regsub -all { } $ns {} ns
		interp alias {} $ns {} $im
		
		set nschildren [namespace children ::$im]
		#puts $nschildren
			
			foreach child $nschildren {
			set nschild ":: $type :: [namespace tail $child]"
			regsub -all { } $nschild {} nschild
			interp alias {} $nschild {} $child
			}
		}

	}


  namespace export obj
  }


----
Example usage: 

  cobj3::obj toys::kazoo {} {
  hello {} {return kazoo}
  }


  cobj3::obj toys::frisbee {toys::kazoo} {

  throw {rate} {return "throw $rate"}
  catch {} {return "catch"}
  sweat {amount} {return $amount} 
  }

  puts [::toys::frisbee::throw fast]
  puts [::toys::frisbee::catch]
  puts [::toys::frisbee::sweat "I'm sweating like a pig!  Well, not really, just for effect."]
  puts [::toys::kazoo::hello]

  #The toys::kazoo::hello proc has been inherited upon creation of toys::frisbee.
  puts [::toys::frisbee::hello]
			
  #puts [info body ::toys::frisbee::sweat]

  ::toys::frisbee destroy hello			
  #This shouldn't work if the above worked:
  #puts [::toys::frisbee::hello]

  puts [::toys::frisbee children]
  #puts [::toys::frisbee help]
----
[George Peter Staplin] - Well, I've been at it again.  I wrote a new version that works like Itcl's class command, has instance variables, and supports class level inheritance.  It's interesting to me looking back at how this has progressed.

  #! /usr/local/bin/tclsh8.3

  namespace eval ::cobj {
  variable _cobj_methods
  variable _cobj_vars
	proc obj {type vars methods} {
	variable _cobj_methods
	variable _cobj_vars
	set _cobj_methods($type) $methods
	set _cobj_vars($type) $vars
	set _variables {}
		foreach v $vars {
		append _variables "variable $v;"
		}

		namespace eval ::$type {}
		proc ::$type {object} "
			namespace eval ::\$object {
			$_variables
			}
			proc ::\$object {args} {
			$_variables
			set self \[namespace current\]
				while {1} {
				set flag \[lindex \$args 0\]
				set value \[lindex \$args 1\]
					switch -- \$flag {
					$methods
					}
				set args \[lrange \$args 2 end\]
					if {\[llength \$args\] == 0} {
					break
					}				
				}
			}			
		"
	}

	proc inherit {type type2} {
	variable _cobj_methods		
	variable _cobj_vars
		
	set new_methods $_cobj_methods($type2)
	set existing_methods $_cobj_methods($type)

	set methods "$new_methods \n $existing_methods"

	set new_vars $_cobj_vars($type2)
	set existing_vars $_cobj_vars($type)

	set vars "$new_vars $existing_vars"

	set _variables {}
		foreach v $vars {
		append _variables "variable $v;"
		}
		
		namespace eval ::$type {}
		proc ::$type {object} "
			namespace eval ::\$object {
			$_variables
			}
			proc ::\$object {args} {
			$_variables
			set self \[namespace current\]
				while {1} {
				set flag \[lindex \$args 0\]
				set value \[lindex \$args 1\]
					switch -- \$flag {
					$methods
					}
				set args \[lrange \$args 2 end\]
					if {\[llength \$args\] == 0} {
					break
					}				
				}
			}			
		"
	}

  namespace export obj 
  namespace export inherit
  } 

  cobj::obj toys::ball {brand intensity} {
  brand: {set brand $value} 
  kick: {set intensity $value}
  what {return "kick $brand $intensity"}
  }

  toys::ball fun

  fun brand: ballo kick: hard
  puts [fun what]

  toys::ball moderate::fun

  moderate::fun brand: {smallo ballo}
  moderate::fun kick: softly
  puts [moderate::fun what]


  cobj::obj toys::football {color} {
  color {set color $value}
  }

  cobj::inherit toys::football toys::ball

  toys::football tfootb

  tfootb brand: {shino ballo}
  puts [tfootb what]
  tfootb color: red
  puts [tfootb what_color]
----
[George Peter Staplin] - I decided to make a simpler object system that just supports instance variables and messages.

  proc cobj {cname vars messages} {
  regsub -all {(\$)} $messages {\\\1} messages
  set strSelf "set self \\\[lindex \\\[info level 0\\\] 0\\\]"
  append messages " default {return -code error {unknown message}}"
	proc $cname {iname} "
	foreach v {$vars} {
	append varList \"variable ::\${iname}::\$v; \"
	}
	namespace eval \$iname {}
		proc \$iname {mesg args} \"
		\$varList
		$strSelf
			switch -- \\\$mesg {
			$messages
			}
		\"
	"
  }

#Test code:
  cobj cWorkers {age position} {setAge {set age [lindex $args 0]} age {return $age} setPosition {set position [lindex $args 0]} position {return $position}}

  cWorkers joe
  joe setAge 31
  joe setPosition chemist

  cWorkers bob
  bob setAge 22
  bob setPosition drifter
  puts "Bob is [bob age] years old and works as a [bob position].  Joe is [joe age] years old and works as a [joe position]."

----