36 lines
1.1 KiB
OCaml
36 lines
1.1 KiB
OCaml
let bind_class ~events ?(extend = false) ?(breakable = false) ?(fields = [])
|
|
?action ?on:widget name =
|
|
let widget = match widget with None -> Widget.dummy | Some w -> coe w in
|
|
tkCommand
|
|
[| TkToken "bind";
|
|
TkToken name;
|
|
cCAMLtoTKeventSequence events;
|
|
begin match action with None -> TkToken ""
|
|
| Some f ->
|
|
let cbId =
|
|
register_callback widget ~callback: (wrapeventInfo f fields) in
|
|
let cb = if extend then "+camlcb " else "camlcb " in
|
|
let cb = cb ^ cbId ^ writeeventField fields in
|
|
let cb =
|
|
if breakable then
|
|
cb ^ " ; if { $BreakBindingsSequence == 1 } then { break ;}"
|
|
^ " ; set BreakBindingsSequence 0"
|
|
else cb in
|
|
TkToken cb
|
|
end
|
|
|]
|
|
|
|
let bind ~events ?extend ?breakable ?fields ?action widget =
|
|
bind_class ~events ?extend ?breakable ?fields ?action ~on:widget
|
|
(Widget.name widget)
|
|
|
|
let bind_tag = bind_class
|
|
|
|
(*
|
|
FUNCTION
|
|
val break : unit -> unit
|
|
/FUNCTION
|
|
*)
|
|
let break = function () ->
|
|
tkCommand [| TkToken "set" ; TkToken "BreakBindingsSequence" ; TkToken "1" |]
|