##ifdef CAMLTK

let tag_bind widget tag eventsequence action =
  check_class widget widget_text_table;
  tkCommand [|
    cCAMLtoTKwidget widget_text_table widget;
    TkToken "tag";
    TkToken "bind";
    cCAMLtoTKtextTag tag;
    cCAMLtoTKeventSequence eventsequence;
    begin match action with
    | BindRemove -> TkToken ""
    | BindSet (what, f) ->
        let cbId = register_callback widget (wrapeventInfo f what) in
        TkToken ("camlcb " ^ cbId ^ (writeeventField what))
    | BindSetBreakable (what, f) ->
        let cbId = register_callback widget (wrapeventInfo f what) in
        TkToken ("camlcb " ^ cbId ^ (writeeventField what) ^
                 " ; if { $BreakBindingsSequence == 1 } then { break ;} ; \
                   set BreakBindingsSequence 0")
    | BindExtend (what, f) ->
        let cbId = register_callback widget (wrapeventInfo f what) in
        TkToken ("+camlcb " ^ cbId ^ (writeeventField what))
    end
  |]
;;

##else

let tag_bind ~tag ~events ?(extend = false) ?(breakable = false)
    ?(fields = []) ?action widget =
  tkCommand [|
    cCAMLtoTKwidget widget;
    TkToken "tag";
    TkToken "bind";
    cCAMLtoTKtextTag tag;
    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
  |]
;;

##endif