hook is a Tcllib package tht implements the subject/observer (publish/subscribe) pattern.
hook allows subjects, which may be modules, objects, widgets, and so forth, to synchronously call hooks which may be bound to an arbitrary number of subscribers, called observers. A subject may call any number of distinct hooks, and any number of observers can bind callbacks to a particular hook called by a particular subject. Hook bindings can be queried and deleted.
Below is an incomplete but illustrative example from Emiliano Gavilán. The Reader module (code inside a namespace which manages the connection and communication with an instrument) issues
hook call Reader <<Connecting>>
when trying to connect, and
hook call Reader <<Connected>> $conn
upon connection/disconnection, with $conn being 1 on connect and 0 on disconnect:
set connbutton [ttk::button $f.startstop \
-text Connect \
-command [fqcmd connect] \
-image ::img::connect0]
hook bind Reader <<Connecting>> $connbutton [lambda {w} {
$w state disabled
status set-clear "Connecting to reader"
} $connbutton]
hook bind Reader <<Connected>> $connbutton [lambda {w conn} {
$w state !disabled
if {$conn} {
set spec [list Disconnect [fqcmd disconnect] ::img::connect4]
status set-clear "Reader connected"
} else {
set spec [list Connect [fqcmd connect] ::img::connect0]
status set-clear "Reader disconnected"
}
foreach {txt cmd img} $spec {
$w configure -text $txt -command $cmd -image $img
}
} $connbutton]A simple but more complete example. In this case a clock (a TclOO object) is created with just two public methods: start and stop. It provides three hooks: <<ClockRunning>>, <<ClockUpdate>> and <<ClockDestroy>>. Two observers are defined: a simple one which just prints the value and a more elaborated one with gui, all defined inside a namespace.
package require hook
oo::class create Clock {
constructor {interval {shift 0}} {
variable ms $interval
variable sh $shift
variable aid ""
}
method Tick {} {
variable ms
variable sh
variable aid
set aid [after $ms [namespace code {my Tick}]]
set base [clock seconds]
set time [clock format [clock add $base $sh hours] -format "%H:%M:%S"]
hook call [self] <<ClockUpdate>> $time
}
method start {} {
variable aid
if {$aid ne ""} {
after cancel $aid
}
hook call [self] <<ClockRunning>> 1
my Tick
}
method stop {} {
variable aid
if {$aid ne ""} {
after cancel $aid
set aid ""
}
hook call [self] <<ClockRunning>> 0
}
destructor {
my stop
hook call [self] <<ClockDestroy>>
hook forget [self]
}
}
set clock1 [Clock new 200]
# simple observer
set obs [hook bind $clock1 <<ClockUpdate>> {} [list apply {{val} {
puts $val
}}]]
# let's add a second, shifted clock and a gui
namespace eval gui {
proc main {} {
package require Tk
global clock1
set clock(1) $clock1
set clock(2) [Clock new 500 -3]
foreach c {1 2} {
set l [label .l$c -width 12]
set b [button .b$c \
-command [namespace code [list start $clock($c)]] \
-text "Start" -width 10]
set db [button .db$c -text "Destroy" \
-command [list catch [list $clock($c) destroy]]]
grid $b $l $db -sticky news
hook bind $clock($c) <<ClockUpdate>> $l [list apply {{l val} {
$l configure -text $val
}} $l]
hook bind $clock($c) <<ClockDestroy>> $l [list apply {{l} {
$l configure -text ""
}} $l]
bind $l <Destroy> [list hook forget $l]
hook bind $clock($c) <<ClockRunning>> $b [list apply [list {b clock start} {
if {$start} {
$b configure \
-command [namespace code [list stop $clock]] \
-text Stop
} else {
$b configure \
-command [namespace code [list start $clock]] \
-text Start
}
} [namespace current]] $b $clock($c)]
hook bind $clock($c) <<ClockDestroy>> $b [list apply {{b} {
$b configure \
-command {} \
-text "---"
}} $b]
bind $b <Destroy> [list hook forget $b]
}
}
proc start {clock} {
$clock start
}
proc stop {clock} {
$clock stop
}
}
gui::main