module O = Config_file
type button = {
mutable but_label : string ;
mutable but_pixmap : string ;
mutable but_command : string ;
}
let button com label xpm =
{ but_label = label ;
but_pixmap = xpm ;
but_command = com ;
}
let value_to_button v =
match v with
O.Raw.Tuple [O.Raw.String label ; O.Raw.String xpm; O.Raw.String com ] ->
{ but_label = label ;
but_pixmap = xpm ;
but_command = com ;
}
| _ ->
prerr_endline "value_to_button";
raise Not_found
let button_to_value b =
O.Raw.Tuple [ O.Raw.String b.but_label ;
O.Raw.String b.but_pixmap;
O.Raw.String b.but_command ]
let button_cp_wrapper =
{ O.to_raw = button_to_value ;
O.of_raw = value_to_button ;
}
let pix f = Filename.concat Cam_installation.pixmaps_dir f
let buttons = new O.list_cp button_cp_wrapper
~group: Cam_rc.gui_ini
["buttons"]
[
button "external topcameleon" "topcameleon" (pix "topcameleon.xpm") ;
]
""
module C = Configwin
let params_for_button but =
let param_pixmap = C.filename
~f:(fun s -> but.but_pixmap <- Cam_misc.remove_char s ';')
Cam_messages.icon_file
but.but_pixmap
in
let param_label = C.string
~f: (fun s -> but.but_label <- Cam_misc.remove_char s ';')
Cam_messages.label but.but_label
in
let param_command = C.string
~f: (fun s -> but.but_command <- Cam_misc.remove_char s ';')
Cam_messages.command but.but_command
in
[ param_pixmap ; param_label ; param_command ]
class bbar_config_box f_update () =
let hbox = GPack.hbox () in
let wscroll = GBin.scrolled_window
~vpolicy: `AUTOMATIC
~hpolicy: `AUTOMATIC
~packing: (hbox#pack ~expand: true) ()
in
let wlist = GList.clist
~titles: [ Cam_messages.icon ;
Cam_messages.label ;
Cam_messages.command ;
]
~titles_show: true
~selection_mode: `SINGLE
~packing: wscroll#add
()
in
let vbox = GPack.vbox ~packing: (hbox#pack ~expand: false ~padding: 4) () in
let wb_add = GButton.button ~label: Cam_messages.add
~packing: (vbox#pack ~expand: false ~padding: 2) ()
in
let wb_edit = GButton.button ~label: Cam_messages.edit
~packing: (vbox#pack ~expand: false ~padding: 2) ()
in
let wb_up = GButton.button ~label: Cam_messages.up
~packing: (vbox#pack ~expand: false ~padding: 2) ()
in
let wb_remove = GButton.button ~label: Cam_messages.remove
~packing: (vbox#pack ~expand: false ~padding: 2) ()
in
object (self)
val mutable buttons_list = buttons#get
val mutable selection = (None : button option)
method set_buttons l = buttons_list <- l
method box = hbox
method apply () : unit =
buttons#set buttons_list;
Cam_rc.save_gui ();
f_update ()
method update =
wlist#clear () ;
wlist#freeze () ;
let f but =
let _ = wlist#append
[ but.but_pixmap ;
but.but_label ;
but.but_command ;
]
in
try
let gdk_pix = GDraw.pixmap_from_xpm
~file: but.but_pixmap
~colormap: (Gdk.Color.get_system_colormap ())
()
in
ignore (wlist#set_cell ~pixmap: gdk_pix (wlist#rows -1) 0)
with
_ ->
ignore (wlist#set_row ~foreground: (`NAME "Red") (wlist#rows -1))
in
List.iter f buttons_list;
GToolbox.autosize_clist wlist ;
wlist#thaw ()
method up_selected =
match selection with
None -> ()
| Some but ->
let rec f = function
ele1 :: ele2 :: q ->
if ele2 == but then
ele2 :: ele1 :: q
else
ele1 :: (f (ele2 :: q))
| l -> l
in
self#set_buttons (f buttons_list) ;
self#update
method edit_selected =
match selection with
None -> ()
| Some but ->
match C.simple_get Cam_messages.edit
(params_for_button but)
with
C.Return_cancel -> ()
| C.Return_apply -> ()
| C.Return_ok -> self#update
method remove_selected =
match selection with
None -> ()
| Some but ->
self#set_buttons
(List.filter
(fun ct2 -> ct2.but_command <> but.but_command)
buttons_list) ;
self#update
method add =
let but = {
but_pixmap = "" ;
but_label = "" ;
but_command = "" ;
}
in
match C.simple_get Cam_messages.add
(params_for_button but)
with
C.Return_cancel -> ()
| C.Return_apply -> ()
| C.Return_ok ->
self#set_buttons (buttons_list @ [but]) ;
self#update
initializer
let f_select ~row ~column ~event =
try selection <- Some (List.nth buttons_list row)
with Failure _ -> selection <- None
in
let f_unselect ~row ~column ~event = selection <- None in
let _ = wlist#connect#select_row f_select in
let _ = wlist#connect#unselect_row f_unselect in
let _ = wb_add#connect#clicked (fun () -> self#add) in
let _ = wb_edit#connect#clicked (fun () -> self#edit_selected) in
let _ = wb_up#connect#clicked (fun () -> self#up_selected) in
let _ = wb_remove#connect#clicked (fun () -> self#remove_selected) in
self#set_buttons buttons#get ;
self#update
end
let main_bbar = ref None
let update w =
main_bbar := Some w;
(match w#children with
c :: _ -> w#remove c
| _ -> ());
let toolbar = GButton.toolbar
~border_width: 2
~orientation: `HORIZONTAL
~style: `ICONS
~packing: w#add ()
in
List.iter
(fun b ->
try
let gdk_pix = GDraw.pixmap_from_xpm
~file: b.but_pixmap
~colormap: (Gdk.Color.get_system_colormap ())
()
in
let pix = GMisc.pixmap gdk_pix () in
let wb = toolbar#insert_button
~text: b.but_label
~tooltip: b.but_label
~icon: pix#coerce
()
in
ignore (wb#connect#clicked (fun () -> Cam_commands.eval_command b.but_command))
with
_ -> ()
)
buttons#get
let _configure_bbar args =
match !main_bbar with
None -> ()
| Some bbar ->
let box = new bbar_config_box (fun () -> update bbar) () in
let p = C.custom box#box box#apply true in
ignore (C.simple_get "Button bar config" [p])
let _ = Cam_commands.register
{ Cam_commands.com_name = Cam_constant.com_configure_bbar ;
Cam_commands.com_args = [| |] ;
Cam_commands.com_more_args = None ;
Cam_commands.com_f = _configure_bbar;
}