let var_frame (name : string) : unit =
button_list := [];
let root_var = Toplevel.create ~borderwidth:1 ~relief:`Groove root in
Wm.title_set root_var ("Variables of "^name);
let frame_var = Frame.create ~borderwidth:1 ~relief:`Sunken root_var in
let frame_button = Frame.create ~borderwidth:1 ~relief:`Ridge root_var in
let label_blank_top= Label.create ~width:32 ~height:1 root_var in
let label_blank_middle= Label.create ~width:32 ~height:1 root_var in
let label_blank_bottom= Label.create ~width:32 ~height:1 root_var in
List.iter
(fun a ->
let tv = Textvariable.create () in
if (List.mem a (Hashtbl.find_all var_in_monitor name)) then Textvariable.set tv "1" else Textvariable.set tv "0";
button_list := (tv,(
Checkbutton.create ~text:a ~width:26 ~height:2 ~borderwidth:1 ~indicatoron:false ~selectcolor:clicol
~onvalue:"1" ~offvalue:"0" ~variable:tv
~command:(fun () ->
let l_var = Hashtbl.find_all var_in_monitor name in
if (List.mem a l_var)
then (
List.iter (fun _ -> Hashtbl.remove var_in_monitor name) l_var;
List.iter
(fun t -> (Hashtbl.add var_in_monitor name t))
(List.rev (remove a l_var))
)
else (Hashtbl.add var_in_monitor name a)
) frame_var))::(!button_list)
)
(Hashtbl.find_all role_var_monitoring name);
let button_unselect_all = Button.create ~text:"Unelect all"
~command:(fun () -> List.iter
(fun (tv,w) -> if(Textvariable.get tv="1") then (Checkbutton.invoke w))
(!button_list)
)
~width:25 ~height:1 ~borderwidth:1 ~relief:`Groove frame_button
in
let button_select_all = Button.create ~text:"Select all"
~command:(fun () -> List.iter
(fun (tv,w) -> if(Textvariable.get tv="0") then ( Checkbutton.invoke w))
(!button_list)
)
~width:25 ~height:1 ~borderwidth:1 ~relief:`Groove frame_button
in
let button_ok = Button.create ~text:"OK"
~command:(fun () -> ignore(
List.iter (fun (_,obj) -> destroy obj)(!button_list);
destroy frame_var;
destroy button_unselect_all;
destroy button_select_all;
destroy frame_button;
destroy root_var;
draw_role_click_zone name
)
)
~width:25 ~height:1 ~borderwidth:1 ~relief:`Groove frame_button
in
pack ~side:`Top ~fill:`Y [label_blank_top];
pack ~side:`Top ~fill:`Y [frame_var];
pack ~side:`Top ~fill:`Y [label_blank_middle];
pack ~side:`Top ~fill:`Y [frame_button];
pack ~side:`Top ~fill:`Y [label_blank_bottom];
List.iter
(fun (_,check_button) -> pack ~side:`Top ~fill:`Y [check_button])
(!button_list);
pack ~side:`Top ~fill:`Y [button_unselect_all];
pack ~side:`Top ~fill:`Y [button_select_all];
pack ~side:`Top ~fill:`Y [button_ok]