diff options
author | Stephane Glondu <steph@glondu.net> | 2010-07-21 09:46:51 +0200 |
---|---|---|
committer | Stephane Glondu <steph@glondu.net> | 2010-07-21 09:46:51 +0200 |
commit | 5b7eafd0f00a16d78f99a27f5c7d5a0de77dc7e6 (patch) | |
tree | 631ad791a7685edafeb1fb2e8faeedc8379318ae /ide/utils/configwin_ihm.ml | |
parent | da178a880e3ace820b41d38b191d3785b82991f5 (diff) |
Imported Upstream snapshot 8.3~beta0+13298
Diffstat (limited to 'ide/utils/configwin_ihm.ml')
-rw-r--r-- | ide/utils/configwin_ihm.ml | 126 |
1 files changed, 39 insertions, 87 deletions
diff --git a/ide/utils/configwin_ihm.ml b/ide/utils/configwin_ihm.ml index 3ab3823d..3833acfa 100644 --- a/ide/utils/configwin_ihm.ml +++ b/ide/utils/configwin_ihm.ml @@ -802,41 +802,27 @@ class hotkey_param_box param (tt:GData.tooltips) = class modifiers_param_box param = let hbox = GPack.hbox () in - let wev = GBin.event_box ~packing: (hbox#pack ~expand: false ~padding: 2) () in + let wev = GBin.event_box ~packing: (hbox#pack ~expand:true ~fill:true ~padding: 2) () in let _wl = GMisc.label ~text: param.md_label ~packing: wev#add () in - let we = GEdit.entry - ~editable: false - ~packing: (hbox#pack ~expand: param.md_expand ~padding: 2) - () - in let value = ref param.md_value in - let _ = + let _ = List.map (fun modifier -> + let but = GButton.toggle_button + ~label:(Configwin_types.modifiers_to_string [modifier]) + ~active:(List.mem modifier param.md_value) + ~packing:(hbox#pack ~expand:false) () in + ignore (but#connect#toggled + (fun _ -> if but#active then value := modifier::!value + else value := List.filter ((<>) modifier) !value))) + param.md_allow + in + let _ = match param.md_help with None -> () | Some help -> - let tooltips = GData.tooltips () in - ignore (hbox#connect#destroy ~callback: tooltips#destroy); - tooltips#set_tip wev#coerce ~text: help ~privat: help - in - let _ = we#set_text (Configwin_types.modifiers_to_string param.md_value) in - let mods_we_care = param.md_allow in - let capture ev = - let modifiers = GdkEvent.Key.state ev in - let mods = List.filter - (fun m -> (List.mem m mods_we_care)) - modifiers - in - value := mods; - we#set_text (Configwin_types.modifiers_to_string !value); - false - in - let _ = - if param.md_editable then - ignore (we#event#connect#key_press capture) - else - () + let tooltips = GData.tooltips () in + ignore (hbox#connect#destroy ~callback: tooltips#destroy); + tooltips#set_tip wev#coerce ~text: help ~privat: help in - object (self) (** This method returns the main box ready to be packed. *) method box = hbox#coerce @@ -1093,13 +1079,13 @@ let edit ?(with_apply=true) (fun conf_struct -> new configuration_box tooltips conf_struct wnote) conf_struct_list in - + if with_apply then dialog#add_button Configwin_messages.mApply `APPLY; - + dialog#add_button Configwin_messages.mOk `OK; dialog#add_button Configwin_messages.mCancel `CANCEL; - + let f_apply () = List.iter (fun param_box -> param_box#apply) list_param_box ; apply () @@ -1245,22 +1231,6 @@ let string ?(editable=true) ?(expand=true) ?help ?(f=(fun _ -> ())) label v = string_of_string = (fun x -> x) ; } -(** Create a custom string param. *) -let custom_string ?(editable=true) ?(expand=true) ?help ?(f=(fun _ -> ())) ~to_string ~of_string label v = - String_param - (Configwin_types.mk_custom_text_string_param - { - string_label = label ; - string_help = help ; - string_value = v ; - string_editable = editable ; - string_f_apply = f ; - string_expand = expand ; - string_to_string = to_string; - string_of_string = of_string ; - } - ) - (** Create a bool param. *) let bool ?(editable=true) ?help ?(f=(fun _ -> ())) label v = Bool_param @@ -1282,23 +1252,21 @@ let list ?(editable=true) ?help label (f_strings : 'a -> string list) v = List_param (fun tt -> - Obj.magic - (new list_param_box - { - list_label = label ; - list_help = help ; - list_value = v ; - list_editable = editable ; - list_titles = titles; - list_eq = eq ; - list_strings = f_strings ; - list_color = color ; - list_f_edit = edit ; - list_f_add = add ; - list_f_apply = f ; - } - tt - ) + new list_param_box + { + list_label = label ; + list_help = help ; + list_value = v ; + list_editable = editable ; + list_titles = titles; + list_eq = eq ; + list_strings = f_strings ; + list_color = color ; + list_f_edit = edit ; + list_f_add = add ; + list_f_apply = f ; + } + tt ) (** Create a strings param. *) @@ -1363,22 +1331,6 @@ let text ?(editable=true) ?(expand=true) ?help ?(f=(fun _ -> ())) label v = string_of_string = (fun x -> x) ; } -(** Create a custom text param. *) -let custom_text ?(editable=true) ?(expand=true) ?help ?(f=(fun _ -> ())) ~to_string ~of_string label v = - Text_param - (Configwin_types.mk_custom_text_string_param - { - string_label = label ; - string_help = help ; - string_value = v ; - string_editable = editable ; - string_f_apply = f ; - string_expand = expand ; - string_to_string = to_string; - string_of_string = of_string ; - } - ) - (** Create a html param. *) let html ?(editable=true) ?(expand=true) ?help ?(f=(fun _ -> ())) label v = Html_param @@ -1441,11 +1393,11 @@ let hotkey ?(editable=true) ?(expand=true) ?help ?(f=(fun _ -> ())) label v = hk_expand = expand ; } -let modifiers - ?(editable=true) - ?(expand=true) - ?help - ?(allow=[`CONTROL;`SHIFT;`LOCK;`MOD1;`MOD1;`MOD2;`MOD3;`MOD4;`MOD5]) +let modifiers + ?(editable=true) + ?(expand=true) + ?help + ?(allow=[`CONTROL;`SHIFT;`LOCK;`MOD1;`MOD2;`MOD3;`MOD4;`MOD5]) ?(f=(fun _ -> ())) label v = Modifiers_param { @@ -1456,7 +1408,7 @@ let modifiers md_f_apply = f ; md_expand = expand ; md_allow = allow ; - } + } (** Create a custom param.*) let custom ?label box f expand = |