blob: 5a3dd19a269b384a1b9858323081779c330117ed (
plain)
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
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
|
(*
FUNCTION
val bind:
any widget -> (modifier list * xEvent) list -> bindAction -> unit
/FUNCTION
*)
let bind widget events:eventsequence action:(action : bindAction) =
tkEval [| TkToken "bind";
TkToken (Widget.name widget);
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
|];
()
(*
FUNCTION
(* unsafe *)
val class_bind :
string -> (modifier list * xEvent) list -> bindAction -> unit
(* /unsafe *)
/FUNCTION
class arg is not constrained
*)
let class_bind clas events:eventsequence action:(action : bindAction) =
tkEval [| TkToken "bind";
TkToken clas;
cCAMLtoTKeventSequence eventsequence;
begin match action with
`Remove -> TkToken ""
| `Set (what, f) ->
let cbId = register_callback Widget.dummy
callback: (wrapeventInfo f what) in
TkToken ("camlcb " ^ cbId ^ (writeeventField what))
| `Setbreakable (what, f) ->
let cbId = register_callback Widget.dummy
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.dummy
callback: (wrapeventInfo f what) in
TkToken ("+camlcb " ^ cbId ^ (writeeventField what))
end
|];
()
(*
FUNCTION
(* unsafe *)
val tag_bind :
string -> (modifier list * xEvent) list -> bindAction -> unit
(* /unsafe *)
/FUNCTION
tag name arg is not constrained
*)
let tag_bind = class_bind
(*
FUNCTION
val break : unit -> unit
/FUNCTION
*)
let break = function () ->
tkEval [| TkToken "set" ; TkToken "BreakBindingsSequence" ; TkToken "1" |];
()
|
