diff options
Diffstat (limited to 'otherlibs/labltk/builtin/text_tag_bind.ml')
-rw-r--r-- | otherlibs/labltk/builtin/text_tag_bind.ml | 22 |
1 files changed, 22 insertions, 0 deletions
diff --git a/otherlibs/labltk/builtin/text_tag_bind.ml b/otherlibs/labltk/builtin/text_tag_bind.ml new file mode 100644 index 0000000000..79b2e6cb3f --- /dev/null +++ b/otherlibs/labltk/builtin/text_tag_bind.ml @@ -0,0 +1,22 @@ +let tag_bind widget :tag events:eventsequence :action = + tkEval [| cCAMLtoTKwidget widget; + TkToken "tag"; + TkToken "bind"; + cCAMLtoTKtextTag 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 + |]; + () |