blob: 79b2e6cb3ffde8f53525fdee1330a7366565183d (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
|
let tag_bind widget :tag events:eventsequence :action =
tkEval [| cCAMLtoTKwidget widget;
TkToken "tag";
TkToken "bind";
cCAMLtoTKtextTag tag;
cCAMLtoTKeventSequence eventsequence;
begin match action with
`Remove -> TkToken ""
| `Set (what, f) ->
let cbId = register_callback widget callback:(wrapeventInfo f what) in
TkToken ("camlcb " ^ cbId ^ (writeeventField what))
| `Setbreakable (what, f) ->
let cbId = register_callback widget callback:(wrapeventInfo f what) in
TkToken ("camlcb " ^ cbId ^ (writeeventField what)^
" ; if { $BreakBindingsSequence == 1 } then { break ;} ; set BreakBindingsSequence 0"
)
| `Extend (what, f) ->
let cbId = register_callback widget callback:(wrapeventInfo f what) in
TkToken ("+camlcb " ^ cbId ^ (writeeventField what))
end
|];
()
|