#$Id: mixinStrategy.xotcl,v 1.1.1.1 2004/05/23 22:50:39 neumann Exp $ package provide xotcl::mixinStrategy 0.8 @ @File { description { These methods provide support for managing "strategies", i.e. mixin-classes, where only one kind of a family of conformant mixins should be registered. <@p> Naming convertions for strategies: All strategies must follow the naming convention 'kind=implementation'. Examples are the persistency strategy 'eager' specfied as 'persistent=eager' or the persistency strategy 'lazy' (specified as 'persistent=lazy') }} @ Object instproc mixinStrategy {strategy "Strategy to be added" } { description { This method adds or replaces a new strategy from the mixin list. Strategies are named following the converntion mentioned above. } return "old strategy" } Object instproc mixinStrategy {strategy} { ::regexp {^([^:]+)=} $strategy _ kind ::set mixins "" ::set oldStrategy "" foreach mixin [my info mixin] { if {[::string match ::$kind=* $mixin]} { ::lappend mixins $strategy ::set oldStrategy $mixin } else { ::lappend mixins $mixin } } if {$oldStrategy == ""} { ::lappend mixins $strategy } my mixin $mixins return $oldStrategy } @ Object instproc mixinQueryStrategy {kind "strategy kind"} { description { This method searches the mixin list for a mixin of this kind (starting with $kind=) } return "returns the maching strategy" } Object instproc mixinQueryStrategy {kind} { set m [my info mixin] return [::lindex $m [::lsearch -glob $m $kind=*]] } @ Object instproc add {construct "(inst) 'filter' or 'mixin'" args "to be added"} { description "add the specified (inst) 'filters' or 'mixins'" return "empty" } Object instproc add {kind args} { if {$kind != {instfilter} && $kind != {instmixin} && $kind != {filter} && $kind != {mixin}} { error "Usage: [self proc] ..." } ::set classes [my info $kind] eval ::lappend classes $args my $kind $classes #puts stderr "$kind of [self] are now: ´[my info $kind]´" } @ Object instproc remove {construct "(inst) 'filter' or 'mixin'" args "to be removed"} { description "remove the specified (inst) 'filters' or 'mixins'" return "empty" } Object instproc remove {kind args} { if {$kind != {instfilter} && $kind != {instmixin} && $kind != {filter} && $kind != {mixin}} { error "Usage: [self proc] ..." } ::set classes [my info $kind] foreach c $args { ::set pos [::lsearch $classes $c] if {$pos == -1} { error "$kind ´$c´ could not be removed" } else { set $classes [::lreplace $classes $pos $pos] } } my $kind $classes # puts stderr "$kind of [self] are now: ´[my info $kind]´" }