##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