#$Id: observer.xotcl,v 1.1 2004/05/23 22:50:39 neumann Exp $
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]
  my instvar preObservers postObservers

  if {[info exists preObservers($procName)]} {
    foreach obj $preObservers($procName) { $obj update [self] $args }
  }

  set result [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} {
  my instvar preObservers 
  my attach  preObservers($procName) $args
} 
Observer::SubjectMgt instproc attachPost {procName args} {
  my instvar postObservers 
  my attach  postObservers($procName) $args
} 
Observer::SubjectMgt instproc detachPre {procName args} {
  my instvar preObservers
  my detach  preObservers($procName) $args
}
Observer::SubjectMgt instproc detachPost {procName args} {
  my instvar postObservers
  my detach  postObservers($procName) $args
}

Observer::Subject instproc init args {
    next
    my superclass [list Observer::SubjectMgt [my info superclass]]
    my instfilter notificationFilter
}

Observer instproc timeout t {
  my set timeout $t
}

Observer instproc update {subject args} {
  #addTimeOut [my set timeout] "[self] update $subject $args"
  #$subject getResponse
  # do something with the response
  puts [self]---update
}

Observer instproc init args {
  next
}

