diff options
Diffstat (limited to 'otherlibs/labltk/builtin/canvas_bind.ml')
| -rw-r--r-- | otherlibs/labltk/builtin/canvas_bind.ml | 21 |
1 files changed, 21 insertions, 0 deletions
diff --git a/otherlibs/labltk/builtin/canvas_bind.ml b/otherlibs/labltk/builtin/canvas_bind.ml new file mode 100644 index 0000000000..2a8923333a --- /dev/null +++ b/otherlibs/labltk/builtin/canvas_bind.ml @@ -0,0 +1,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 |]; + () |