[Smalltalk] like object system in pure-Tcl. * Author: [George Peter Staplin] * License: BSD/Tcl * Downloads: http://www.xmission.com/~georgeps/implementation/software/Smalltick/ Projects: [Smalltick Widgets with Inheritance] [Smalltick DrawingEditor] Smalltick is not a typical Tcl object system. It uses instance inheritance, so you aren't limited by the definition of a class. You can add new methods dynamically easily. It '''does not use namespaces''' to store methods and variables, but it also doesn't prevent you from using them. Instance variables are stored in a private array, and each method uses a unique-command-name prefix, so collisions are not a problem. Classes in Smalltick are just [proc]s with commands that associate variables and methods with an object. $ tclsh8.4 % source ./Smalltick.tcl % set obj [new.object] cmd-2108840903 % $obj set {var value} value % $obj get var value % $obj : foo {} { puts FOO } cmd-2108840903->foo % $obj foo FOO % $obj : bar arg { $self set [list var $arg] } cmd-2108840903->bar % $obj bar 123 123 % $obj get var 123 You may notice that the instance variable setting is a little weird. This is due to the generic application of method invocation. For instance ''$obj -foo arg -bar arg'' is generalized to treat the argument to the method as a single list. If you want to pass multiple arguments define a method like so: $obj : mul {a b} {expr {$a + $b}} and then use it in this manner: $obj mul [list 1 2] ---- Redistribution/Licensing: [OLL] #Copyright 2004 George Peter Staplin proc get.unique.command.name {} { while 1 { if {"" == [info commands [set n cmd[clock clicks]]]} { return $n } } } proc instance.handler {obj args} { if {":" == [lindex $args 0]} { proc $obj->[lindex $args 1] \ [lindex $args 2] \ "set self $obj; [lindex $args 3]" return $obj->[lindex $args 1] } else { set r "" foreach {msg arg} $args { switch -- [llength $arg] { 0 { set r [$obj->[set msg]] } 1 { set r [$obj->[set msg] [lindex $arg 0]] } 2 { set r [$obj->[set msg] [lindex $arg 0] [lindex $arg 1]] } 3 { set r [$obj->[set msg] [lindex $arg 0] [lindex $arg 1] [lindex $arg 2]] } 4 { set r [$obj->[set msg] [lindex $arg 0] [lindex $arg 1] [lindex $arg 2] [lindex $arg 3]] } 5 { set r [$obj->[set msg] [lindex $arg 0] [lindex $arg 1] [lindex $arg 2] [lindex $arg 3] [lindex $arg 4]] } } } return $r } } proc new.object {} { set obj [get.unique.command.name] interp alias {} $obj {} instance.handler $obj $obj : ?set {var value} { if {![info exists ::_priv_instances($self,$var)]} { return -code error "expected $var to exist in $self" } set ::_priv_instances($self,$var) $value } $obj : decr var { incr ::_priv_instances($self,$var) -1 } $obj : destroy {} { foreach cmd [info commands [set self]*] { rename $cmd {} } array unset ::_priv_instances [set self],* } $obj : get var { return [set ::_priv_instances($self,$var)] } $obj : incr var { incr ::_priv_instances($self,$var) } $obj : set {var value} { set ::_priv_instances($self,$var) $value } return $obj } ---- ''[escargo] 5 Jul 2004'' - Could you explain what you mean when you say, "It uses instance inheritance...." What other object systems (not just Tcl ones) are like this? Is it like prototype-based systems? [George Peter Staplin]: July 5, 2004 - I mean that methods and instance variables can be added at any time -- in or out of a class. Some object systems only allow adding a method or variable within a class which the object or another class inherits-from/extends-with. ---- [Category Object Orientation] | [Category Package]