[SELF] is a prototype based OO language that uses objects that only have slots. For a references and discussion regarding [SELF] see [SELF]. This page describes the Self extension.
----
[MJ] - In a recent (oct-2006) [OO] frenzy on the [Tcl chatroom] resulting in code gems like [neo] and [eos], I decided to write a  [SELF] like extension for Tcl. 

The resulting C extension can be downloaded from [http://marknet.tk/downloads/self.zip].

After loading the extension one object (Object) is known and the three commands (self, next and super) are imported. Every other object in the system will be cloned from Object or it's clones and will have slots defined containing values or methods.

'''Object'''

The generic prototype Object can be used to create new objects with clone. The generic object contains the following slots:

   * clone new: creates a new object with name $new
   * slot name value: create a value slot which will return $value if called without arguments and set the value if called with one argument
   * slot name args body: will create a method slot
   * slots: returns a list of all the defined slots on the object
   * destroy: will destroy the object
   * parents*: contains a list with all the parents of the object. This information is used for method dispatch. Object initially has no parents.

'''Cloning'''

clone will create a new object with only the parents* slot defined. The parents* slot will contain the name of the  receiver of the clone message. The parents* slot will be used in slot dispatch resulting in inheritance and can be updated during runtime, allowing for mixin like behaviour.

''cloned object''
    * parents* {receiver of the clone message}    

'''Command dispatch'''

Slots are executed by sending messages to the object. A depth-first search of the object and the parents* list will be done to find the implementation of a slot. When a slot is found the slot is executed in the context of the object receiving the message. If no implementation of a slot is found, the dispatcher tries to call an unknown slot with the slotname and arguments as args. If that also fails, a standard error is returned.
During evaluation of a slot, three additional commands are available:

   * self slot args: will call slot $slot on the receiver of the initial message. Without arguments it will return the name of the receiver.
   * next: will call the same slot with the same args as currently executing, but the dispatcher will start looking for the slot only in the parents of the implementor of the currently executing slot, which is not the same as self for inherited slots.   
   * super slotname args: will call a different slot $slotname on the parents of the implementor of the currently executing slot.

'''Examples'''

 package require self
 
 # create a Point object.
 Object clone Point
 
 # add a to_s slot to display information of the object
 Object slot to_s {} {
  return "[self]"
 }

 # add x and y slots for the point, notice that these slots cannot be called for now.
 Point slot x {args} {error "abstract slot, override in clone"}
 Point slot y {args} {error "abstract slot, override in clone"} 

 # extend default behavior from parent (Object)
 Point slot to_s {} {
  return "id: [next] ([self x],[self y])"
  # Here next will search for a slot named to_s in the parents of the implementor of the current method (Point)
  # finding the Object slot to_s and the execute it in the context of the receiver (which will be a clone of Point) 
 }

 # define a point factory
 Point slot create {name x y} {
  self clone $name
  $name slot x $x
  $name slot y $y
 }

 # clone a Point
 Point clone p1

 # to_s will fail because the x and y slots in Point are called
 catch {p1 to_s} err
 puts $err

 # use the Point factory which will define x and y slots
 Point create p1 0 0
 
 # to_s will now work
 puts [p1 to_s]

'''Intercepting slot calls for debugging purposes'''
 
 Object clone A
 A slot test args {return}
 
 A clone a
 a test

 A clone debug
 debug slot test {args} {puts "called test with $args"; next}
 
 a parents* {debug}
 a test 1 2 3

'''Demonstrating unknown to create a read-only text widget''' 

 # example demostrating how to override a widget
 package require self
 package require Tk

 proc debugtext name {
	text $name
	rename $name _$name
	Object clone $name
	$name slot unknown args {
	   puts "[self] $args"
	   _[self] {expand}$args
	}
	$name slot destroy {} {
		destroy _[self]
		rename _[self] {}
		next
	}
	return $name
 }

 debugtext .t 

 pack .t -expand 1 -fill both
 
 button .b -text "Make readonly" -command make_ro
 pack .b
 
 proc make_ro {} {
  # allows on the fly redefining of behaviour
  .t slot insert args {puts stderr "readonly"}
  .t slot delete args {puts stderr "readonly"}
 }

----
[Category Package] - [Category Object Orientation]