Hi Sheik,
sorry for the late response. I attach a sligtly different variant of your filter program that should run. Look for "XXX" comments to see what I had to change.
Cheers,
Uwe
#################################################################
#create SimpleDelegation as a meta-class
Class SimpleDelegation -superclass Class SimpleDelegation instproc sdFilter args { set method [self calledproc] if {[[self] exists delegate]} { set del [[self] set delegate] puts "Filter $del $method"
#if delegate has method then dispatch it. if {[$del procsearch $method] != ""} { # # XXX: # # eval [eval [$del $method $args]] does not work # return [eval $del $method $args] } return [next]; }
# # XXX: # you have forgotten this "next". Remember the filter is # called on every call. Also on "[self] set delegate $d" in init. # if you do not pass such calls through, the delegate must # be set before the filter is appended. # next }
SimpleDelegation instproc init args { [self] filterappend [self class]::sdFilter next [self] instproc setDelegate {d} { [self] set delegate $d } }
SimpleDelegation A -parameter delegate SimpleDelegation B -parameter delegate
A instproc m {x} { puts "[self] [self class] [self proc] $x" return [next] }
B instproc m {x} { puts "[self] [self class] [self proc] $x" next return [expr {$x*2 + [[self] set v]}] }
Class C
#method "m" renamed to "m2" here. C instproc m2 {x} { puts "[self] [self class] [self proc] $x" next return [expr {$x*3 + [[self] set v]}] } A a B b
a setDelegate b b set v 100 C c b setDelegate c c set v 100
# # XXX: # here, it said "a m 123", but you require some indiretion so that # the filter knows that it should call m2 instead of m # # to make the example run, i just call m2 directly ... # puts "result = [a m2 123]"
#################################################################
On Sunday 08 July 2001 19:10, Sheik Yussuff wrote:
Just over 6 months ago,Catherine Letondal raised
the issue of implementing "simple delegation".
Professor G. Neumann replied with some code showing
how it can be done as well as suggesting that one may
use a filter to filter all methods or an instmixin
to target specific methods for delegation.
I am now learning Tcl and XOTcl (a week or so now)at the
same time and have decided to try the filter approach.
The Experiment:
Create a meta-class SimpleDelegation
add a filter sdFilter to this meta-class
add an instproc setDelegate
Create classes A and B using SimpleDelegate
Create class C using Class
A has as delegate(instvar) an object of class B;
B has as delegate an object of class C
- A,B and C has a method "m" defined
The Problem: (Using Windows binary ver 0.85)
I extended Prof. Neumann's code to handle above
and it works.(see Code1 below)
My experiment(Code 2) works only for the following
cases(that I tested):
A,B and C has a method "m".
The instvar delegate removed from B
It does not work when I rename the method
"m" in class C to "m2".
In this case I expect an object of class B to
execute "m" but instead I get an object of class
A executing "m" instead.
I would be grateful for any pointers to resolve
this problem.
Also I want to try to implement delegation as
described by Prof. Lieberman(OOPSLA 1986 paper).
Will be grateful for any pointers on this also.
................
Code1: Prof Neumann's code inelegantly extended
Class A -parameter delegate
A instproc handleDelegation {result} {
if {[[self] exists delegate]} {
set context [::info level -1]
#look for method in delegated object
if {[[[self] set delegate] procsearch [lindex $context 0]] != "" } {
::upvar $result y
set y [eval [[self] set delegate] $context]
return 1
}
}
return 0
}
A instproc m {x} {
if {[[self] handleDelegation r]} {
return $r
} else {
puts "[self] [self class] [self proc] $x";
return [next]
}
}
Class B -parameter delegate
B instproc handleDelegation {result} {
if {[[self] exists delegate]} {
set context [::info level -1]
#look for method in delegated object
if {[[[self] set delegate] procsearch [lindex $context 0]] != "" } {
::upvar $result y
set y [eval [[self] set delegate] $context]
return 1
}
}
return 0
}
B instproc m {x} {
if {[[self] handleDelegation r]} {
return $r
} else {
puts "[self] [self class] [self proc] $x";
return [next]
}
}
Class D
D instproc m2 {x} {
puts "[self] [self class] [self proc] $x"
next
return [expr {$x*2 + [[self] set v]}]
}
D d1
d1 set v 100
B b1 -delegate d1
A a1 -delegate b1
puts "result = [a1 m 123]"
................................................
Code2: My Try using filters
#create SimpleDelegation as a meta-class
Class SimpleDelegation -superclass Class
SimpleDelegation instproc sdFilter args {
set method [self calledproc]
if {[[self] exists delegate]} {
set del [[self] set delegate]
#if delegate has method then dispatch it.
if {[$del procsearch $method] != ""} {
return [eval [$del $method $args]]
}
return [next];
}
}
SimpleDelegation instproc init args {
[self] filterappend [self class]::sdFilter
next
[self] instproc setDelegate {d} {
[self] set delegate $d
}
}
SimpleDelegation A -parameter delegate
SimpleDelegation B -parameter delegate
A instproc m {x} {
puts "[self] [self class] [self proc] $x"
return [next]
}
B instproc m {x} {
puts "[self] [self class] [self proc] $x"
next
return [expr {$x*2 + [[self] set v]}]
}
Class C
#method "m" renamed to "m2" here.
C instproc m2 {x} {
puts "[self] [self class] [self proc] $x"
next
return [expr {$x*3 + [[self] set v]}]
}
A a
B b
a setDelegate b
b set v 100
C c
b setDelegate c
c set v 100
puts "result = [a m 123]"
...................................................
Regards,
Sheik Yussuff
email: sheik@carib-link.net
---------------------------------------- Content-Type: text/html; charset="iso-8859-1"; name="Attachment: 1" Content-Transfer-Encoding: quoted-printable Content-Description: ----------------------------------------