1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
|
# $Id: hooks.tcl 1149 2007-07-09 12:39:58Z sergei $
namespace eval hook {}
proc hook::add {hook func {seq 50}} {
variable $hook
lappend $hook [list $func $seq]
set $hook [lsort -real -index 1 [lsort -unique [set $hook]]]
}
proc hook::set_flag {hook flag} {
variable F
set idx [lsearch -exact $F(flags,$hook) $flag]
set F(flags,$hook) [lreplace $F(flags,$hook) $idx $idx]
}
proc hook::unset_flag {hook flag} {
variable F
if {![lcontain $F(flags,$hook) $flag]} {
lappend F(flags,$hook) $flag
}
}
proc hook::is_flag {hook flag} {
variable F
return [expr ![lcontain $F(flags,$hook) $flag]]
}
proc hook::run {hook args} {
variable F
variable $hook
if {![info exists $hook]} {
return
}
set F(flags,$hook) {}
foreach func_prio [set $hook] {
set func [lindex $func_prio 0]
set code [catch { eval $func $args } state]
debugmsg hook "$hook: $func -> $state (code $code)"
if {$code} {
::bgerror "Hook $hook failed\nProcedure\
$func returned code $code\n$state"
}
if {(!$code) && ([cequal $state stop])} {
break
}
}
}
|
