[SS]: An interesting object oriented programming language, basic ideas comes from [SmallTalk] but SELF is
more flexible and powerful, and probably even more ''pure''.

SELF was used as test-bed for new ideas about compilation and virtual machines of
very high level programming languages. More info at [http://research.sun.com/self/language.html]
and [http://www.objs.com/x3h7/self.htm].

It should be possible to build an object-system for TCL that uses ideas from SELF, maybe
it was already implemented. Please if you know more, or have some code to show, write it here.

[RS] wrote [On things], which might interest you.

[SS] - great! it is pretty similar to SELF, I like the design [RS] used to add it to TCL.

[Artur Trzewik] - Some of SELF ideas are also included in [XOTcl], that are mixins.
Also in XOTcl the object has relative more importance than class. 
Classes are also objects and the relationship between objects and classes is
dynamic.
Self is prototype-based OO language but some of programing technigues one can good
simulated with XOTcl mixins and filters.
The manier how to program with SELF, is also implemented in [XOTclIDE].
That is interatively extent or change runing, "living" system. The same way
Smalltalker are programming.

[SS]: I see a fundamental difference between [SELF] and [XOTcl] btw: [SELF] is simple, there is
even no difference between a method and instance variable, everything is a slot, and there are
many other semplifications like no classes at all. On the exact contrary [XOTcl] has a lot
of concepts, so I think the essence is very different, while of course with every kind of
OO-related feature you can fake the coding way of prototype based systems, class based systems
and so on.
----
[MJ] -- Basic implementation of a self like OO system in plain Tcl. Supports [[super]], [[self]] and [[slot]] in slot bodies.

 set Object(parent*) {{} {return}}

 set Object(slot) {
    {name args body} {
	set ::[self]($name) [list $args $body]
	return $name
    }
 }

 # NOTE: if you clone Object and add the parents of an object to parent* you essentially have $super of the object 

 proc self {} {
        uplevel 2 {set self}
 }

 proc slot {} {
    uplevel 2 {set slot}
 }

 proc super {args} {
    set currObj [uplevel 2 {set obj}]
    set slot [uplevel 2 {set slot}]

    Object clone _tmp
    _tmp valueSlot parent* [$currObj parent*]
    set err [catch {_tmp $slot {expand}$args} res]
    _tmp destroy
    if {$err} {
	error $res
    } else {
	return $res
    }
 }

 proc Object {args} {
    set self [lindex [info level 0] 0]  
    set slot [lindex $args 0]
    # every object has the parent* slot
    set parents [apply [set ::${self}(parent*)]]

    if {$slot=="parent*" } {
	return $parents       
    }

    set ancestors $self
    set visited {}

    while {true} {
	set obj [lindex $ancestors 0]
	if {$obj eq ""} {break}
	# keep a visited objects list to prevent circular lookups
	if {[lsearch -exact $visited $obj]>-1} {
	    set ancestors [lrange $ancestors 1 end]
	    continue
	}
	lappend visited $obj
	set ancestors [list {expand}[lrange $ancestors 1 end] {expand}[::$obj parent*]]
	if {[info exists ::${obj}($slot)]} {
	    return [apply [set ::${obj}($slot)] {expand}[lrange $args 1 end]]
	}
    }
    error "slot \"$slot\" not defined for $self"
 }


 Object slot clone new { 
    set ::${new}(parent*)  [list {} "return [self]"]
    proc $new args [info body [self]]
    return $new
 }

 Object slot destroy {} {
    unset ::[self]
    rename ::[self] {}
 }

 Object slot slots {} {
    return [array names ::[self]]
 }

 Object slot valueSlot {name value} {
    [self] slot $name {args} [list if {[llength $args] == 0} [list return $value] else {[self] valueSlot [slot] $args}]
    return $value
 }
 
 package provide self 0.1

'''examples'''

 source ./self.tcl

 Object clone Point

 Point slot create {name x y} {
    [self] clone $name
    $name valueSlot x $x
    $name valueSlot y $y
    return $name
 } 

 Object clone Line
 Line slot xlength {} {
    expr {[[[self] p2] x] - [[[self] p1] x]}  
 }


 Line clone l
 Point create p1 0 0
 Point create p2 1 1
 
 l valueSlot p1 p1
 l valueSlot p2 p2
 
 puts [l xlength]


----
[Category Language] | [Category Object Orientation]