blob: 2a8923333ac6c751b2c1c4253795c939502e116d (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
|
let bind widget :tag events:eventsequence :action =
tkEval [| cCAMLtoTKwidget widget;
TkToken "bind";
cCAMLtoTKtagOrId 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 |];
()
|