Version 1 of Traits in XOTcl

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 [L1 ] 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