summaryrefslogtreecommitdiff
path: root/otherlibs/labltk/builtin/text_tag_bind.ml
diff options
context:
space:
mode:
Diffstat (limited to 'otherlibs/labltk/builtin/text_tag_bind.ml')
-rw-r--r--otherlibs/labltk/builtin/text_tag_bind.ml22
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
+ |];
+ ()