summaryrefslogtreecommitdiff
path: root/ide/utils/configwin_ihm.ml
diff options
context:
space:
mode:
Diffstat (limited to 'ide/utils/configwin_ihm.ml')
-rw-r--r--ide/utils/configwin_ihm.ml126
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 =