diff options
Diffstat (limited to 'otherlibs/labltk/builtin/builtinf_bind.ml')
| -rw-r--r-- | otherlibs/labltk/builtin/builtinf_bind.ml | 42 |
1 files changed, 19 insertions, 23 deletions
diff --git a/otherlibs/labltk/builtin/builtinf_bind.ml b/otherlibs/labltk/builtin/builtinf_bind.ml index 7a3e1e770..7f39b0798 100644 --- a/otherlibs/labltk/builtin/builtinf_bind.ml +++ b/otherlibs/labltk/builtin/builtinf_bind.ml @@ -1,26 +1,24 @@ 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 - ignore begin - tkEval - [| 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 - |] - end + 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 @@ -34,6 +32,4 @@ FUNCTION /FUNCTION *) let break = function () -> - ignore begin - tkEval [| TkToken "set" ; TkToken "BreakBindingsSequence" ; TkToken "1" |] - end + tkCommand [| TkToken "set" ; TkToken "BreakBindingsSequence" ; TkToken "1" |] |