I liked [NEM] on [Traits] so I said to myself this could be put on top of my favourite tcl object extension. By the way, on the public-private issue being talked about on [http://wiki.tcl.tk/14754] my point of view is close to (perhaps not identical) to that of [Artur Trzewik]. I would not go for having the possibility of hidding things away further than having them put on the right namespace. ---- Some notes on the code. * I really like tcl but perhaps I am leaping too far at giving names to things, I know I don't use the usual coding standard. I actually am trying to develop a coding standard of my own where every identifier (apart from those coming from other codes or language reserved keywords) has a built-in grammar. * Here, on naming issues, I differ a lot from [Artur Trzewik] :) So I use: * To as a prefix to denote function. * Ab as a prefix to denote Class. * Ar as a prefix to denote argument. * Gl as a prefix to denote global variable. * My as a prefix to denote member attribute. * Th as a prefix to denote local variable. ---- The code (at a very early stage): #< #~ **Traits.tcl**. # #Trying to implement traits on top of **Xotcl**. #> package require XOTcl namespace import -force ::xotcl::* #< #~~ Class **AbTraitable**. # #Classes that want to have traits have to belong to this metaclass. # #I don't know if the desirable order of calls is achieved this way. # #But I believe it is so. # #An alternative is to use the superclass scheme in order to guarantee that: # #* Class methods take precedence over trait methods. # #* Trait methods take precedence over superclass methods. #> Class AbTraitable -superclass Class #< #~~~ Method **ToUseTrait**. # #Given the name of a trait the traitable class will adopt it. # #It will do so unless there is a conflict. # #Then something must be done (to do). # #User will have to resolv the conflict. #> AbTraitable instproc ToUseTrait { ArTraitName } { #Invokation of ToCheckTraitComposition to do. #If everything goes fine. #Remember that [self] here is a class. foreach ThMethodName [$ArTraitName set MyMethodS] { [self] instforward $ThMethodName -objscope $ThMethodName } } #< #~~~ Method **ToRemTrait**. # #Given the name of a trait the traitable class will remove it. #> AbTraitable instproc ToRemTrait { ArTraitName } { set ThPos [lsearch -exact [my set MyTraitS] $ArTraitName] if {[expr {$ThPos >= 0}]} { #Remember that [self] here is a class. foreach ThMethodName [$ArTraitName set MyMethodS] { [self] instforward $ThMethodName } lreplace [my set MyTraitS] $ThPos $ThPos } } #< #~~ Class **AbTrait**. # #Here we go. #> Class AbTrait #< #~~~ Constructor. #> AbTrait instproc init { } { my set MyMethodS [list] } #< #~~~ Method **ToAddMethod**. # #Given a method name add it to the trait. # #It will do so unless there is a conflict. # #Then an error method will be used in place. # #User will have to resolv the conflict. #> AbTrait instproc ToAddMethod { ArMethodName } { set ThPos [lsearch -exact [my set MyMethodS] $ArMethodName] if {[expr {$ThPos < 0}]} { my lappend MyMethodS $ArMethodName } else { my ToAddError_Method $ArMethodName } } #< #~~~ Method **ToAddError_Method**. # #Given a method name add a corresponding error method to the trait. # #User will have to resolv the conflict. #> AbTrait instproc ToAddError_Method { ArMethodName } { #To do. } #< #~~~ Method **ToSubMethod**. # #Given a method name subtract it from the trait if it exists. #> AbTrait instproc ToSubMethod { ArMethodName } { set ThPos [lsearch -exact [my set MyMethodS] $ArMethodName] if {[expr {$ThPos >= 0}]} { lreplace [my set MyMethodS] $ThPos $ThPos } } #< #~~~ Method **ToCompose5Trait**. # #Given a trait name compose the methods of self with those of the object. # #It will do so unless there is a conflict. # #Then an error method will be used in place. # #User will have to resolv the conflict. #> AbTrait instproc ToCompose5Trait { ArTraitName } { #To do. } #< #~~ Example. #> AbTraitable AbCircle\ -parameter {{MyCentre {100}}}\ -parameter {{MyRadius {100}}}\ -parameter {{MyColour {black}}} proc ToRenameColour { ArColour } { my set MyColour $ArColour } proc ToPutColour { } { puts "[self] is [my set MyColour] coloured." } AbTrait GlCircleTrait GlCircleTrait ToAddMethod ToRenameColour GlCircleTrait ToAddMethod ToPutColour AbCircle ToUseTrait GlCircleTrait AbCircle GlCircle GlCircle ToPutColour GlCircle ToRenameColour magenta GlCircle ToPutColour