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