#$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
}

