1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
|
#$Id: s.observer.xotcl 1.4 01/03/23 22:24:35+01:00 neumann@somewhere.wu-wien.ac.at $
Class Observer -superclass Class
Observer metadata add description
@ @File {
description {
Simple observer pattern meta-class taken from the paper
'Filters as a Language Support for Design Patterns in
Object-Oriented Scripting Languages'.
}
}
Class Observer::Subject -superclass Class
Observer::Subject instproc notificationFilter {args} {
set procName [self calledproc]
[self] instvar preObservers postObservers
if {[info exists preObservers($procName)]} {
foreach obj $preObservers($procName) { $obj update [self] $args }
}
set result [[self] next]
if {[info exists postObservers($procName)]} {
foreach obj $postObservers($procName) { $obj update [self] $args }
}
return $result
}
Class Observer::SubjectMgt
Observer::SubjectMgt instproc attach {hook objs} {
upvar $hook observers
foreach obj $objs {
if {![info exists observers] || [lsearch $observers $obj] == -1} {
lappend observers $obj
}
}
}
Observer::SubjectMgt instproc detach {hook objs} {
upvar $hook observers
if {[info exists observers]} {
foreach obj $objs {
set p [lsearch $observers $obj]
set observers [lreplace $observers $p $p]
}
}
}
Observer::SubjectMgt instproc attachPre {procName args} {
[self] instvar preObservers
[self] attach preObservers($procName) $args
}
Observer::SubjectMgt instproc attachPost {procName args} {
[self] instvar postObservers
[self] attach postObservers($procName) $args
}
Observer::SubjectMgt instproc detachPre {procName args} {
[self] instvar preObservers
[self] detach preObservers($procName) $args
}
Observer::SubjectMgt instproc detachPost {procName args} {
[self] instvar postObservers
[self] detach postObservers($procName) $args
}
Observer::Subject instproc init args {
[self] next
[self] superclass [list Observer::SubjectMgt [[self] info superclass]]
[self] filter [self class]::notificationFilter
}
Observer instproc timeout t {
[self] set timeout $t
}
Observer instproc update {subject args} {
#addTimeOut [[self] set timeout] "[self] update $subject $args"
#$subject getResponse
# do something with the response
puts [self]---update
}
Observer instproc init args {
[self] next
}
|
