A General Filter Mechanism

George Peter Staplin Jan 10, 2006 - A filter in this case is a plugin procedure that users write to alter the behavior of a program or receive notification of some code path being reached. They may also be used in cases other than plugins, such as a code path that requires several procedures to process an event and/or modify the actual event data with upvar.

The code that follows is an abstract way of invoking filters, adding filters for events, and removing filters. It ends with a simple demonstration.

 # By George Peter Staplin
 # 
 # This code implements a general filter mechanism.
  
 #
 # args is the data for the callback.
 #
 proc filter {name args} {
  global filters
 
  if {![info exists filters($name)]} {
   #
   # There are no filters for $name.
   #
   return
  }
 
  foreach script $filters($name) {
   if {[catch {uplevel 1 [concat $script $args]} err]} {
    puts stderr "filter error: $err"
   }
  }
 }
 
 
 #
 # args is the callback.
 #
 proc remove.filter {name args} {
  global filters
 
  set i [lsearch -exact $filters($name) $args]
  set filters($name) [lreplace $filters(name) $i $i]
 }
 
 #
 # args is the callback
 #
 proc add.filter {name args} {
  global filters
 
  lappend filters($name) $args
 }
 #
 # This is some example test code that uses filters.
 #
 proc message.filter msg_var {
  upvar $msg_var msg
  set msg hello
 }
 
 proc person.filter person_var {
  upvar $person_var person
  
  #
  # This is a more sophisticated filter that sets a random name.
  #
  set map [list george joe bob]
  set person [lindex $map [expr {int(rand() * [llength $map])}]]
 }
 
 add.filter MESSAGE message.filter
 add.filter PERSON person.filter
 
 proc main {} {
  #
  # These are the defaults that a plugin may override.
  #
  set msg greetings
  set person earthling 

  #
  # This passes the msg string to every filter in the filter list.
  # Therefore each filter may modify the msg via upvar.
  # Depending on your usage you may want to throw an error in add.filter
  # if an existing filter exists.  I however plan to use the filter
  # mechanism for read-only tasks that pass multiple variables to upvar to
  # read the state of those variables, in addition to the write filters.
  #
  filter MESSAGE msg
  filter PERSON person
 
  puts "$msg $person"
 }
 main