summaryrefslogtreecommitdiff
path: root/otherlibs/labltk/builtin/text_tag_bind.ml
blob: 79b2e6cb3ffde8f53525fdee1330a7366565183d (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
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
  |];
  ()