1 files changed, 263 insertions, 197 deletions

diff --git a/ide/utils/configwin_ihm.ml b/ide/utils/configwin_ihm.ml
index 3833acfa..9ddc90ef 100644
--- a/ide/utils/configwin_ihm.ml
+++ b/ide/utils/configwin_ihm.ml
@@ -29,6 +29,12 @@ open Configwin_types
 
 module O = Config_file
 
+class type widget =
+  object
+    method box : GObj.widget
+    method apply : unit -> unit
+  end
+
 let file_html_config = Filename.concat Configwin_messages.home ".configwin_html"
 
 let debug = false
@@ -320,17 +326,17 @@ class ['a] list_selection_box
       in
       let _ = dbg "list_selection_box: connecting wb_add" in
       (* connect the functions to the buttons *)
-      ignore (wb_add#connect#clicked f_add);
+      ignore (wb_add#connect#clicked ~callback:f_add);
       let _ = dbg "list_selection_box: connecting wb_remove" in
-      ignore (wb_remove#connect#clicked f_remove);
+      ignore (wb_remove#connect#clicked ~callback:f_remove);
       let _ = dbg "list_selection_box: connecting wb_up" in
-      ignore (wb_up#connect#clicked (fun () -> self#up_selected));
+      ignore (wb_up#connect#clicked ~callback:(fun () -> self#up_selected));
       (
        match f_edit_opt with
 	 None -> ()
        | Some f ->
 	   let _ = dbg "list_selection_box: connecting wb_edit" in
-	   ignore (wb_edit#connect#clicked (fun () -> self#edit_selected f))
+	   ignore (wb_edit#connect#clicked ~callback:(fun () -> self#edit_selected f))
       );
       (* connect the selection and deselection of items in the clist *)
       let f_select ~row ~column ~event =
@@ -350,9 +356,9 @@ class ['a] list_selection_box
       in
       (* connect the select and deselect events *)
       let _ = dbg "list_selection_box: connecting select_row" in
-      ignore(wlist#connect#select_row f_select);
+      ignore(wlist#connect#select_row ~callback:f_select);
       let _ = dbg "list_selection_box: connecting unselect_row" in
-      ignore(wlist#connect#unselect_row f_unselect);
+      ignore(wlist#connect#unselect_row ~callback:f_unselect);
 
       (* initialize the clist with the listref *)
       self#update !listref
@@ -393,38 +399,50 @@ class string_param_box param (tt:GData.tooltips) =
 
 (** This class is used to build a box for a combo parameter.*)
 class combo_param_box param (tt:GData.tooltips) =
-  let _ = dbg "combo_param_box" in
-  let hbox = GPack.hbox () in
-  let wev = GBin.event_box ~packing: (hbox#pack ~expand: false ~padding: 2) () in
-  let _wl = GMisc.label ~text: param.combo_label ~packing: wev#add () in
-  let wc = GEdit.combo
-      ~popdown_strings: param.combo_choices
-      ~value_in_list: (not param.combo_new_allowed)
-      (* ~allow_empty: param.combo_blank_allowed *)
-      ~packing: (hbox#pack ~expand: param.combo_expand ~padding: 2)
-      ()
-  in
-  let _ =
-    match param.combo_help with
-      None -> ()
-    | Some help ->
-	tt#set_tip ~text: help ~privat: help wev#coerce
-  in
-  let _ = wc#entry#set_editable param.combo_editable in
-  let _ = wc#entry#set_text param.combo_value in
-
-  object (self)
-    (** This method returns the main box ready to be packed. *)
-    method box = hbox#coerce
+    let _ = dbg "combo_param_box" in
+    let hbox = GPack.hbox () in
+    let wev = GBin.event_box ~packing: (hbox#pack ~expand: false ~padding: 2) () in
+    let _wl = GMisc.label ~text: param.combo_label ~packing: wev#add () in
+    let _ =
+      match param.combo_help with
+	  None -> ()
+	| Some help ->
+	    tt#set_tip ~text: help ~privat: help wev#coerce
+    in
+    let get_value = if not param.combo_new_allowed then
+      let wc = GEdit.combo_box_text
+	~strings: param.combo_choices
+	?active:(let rec aux i = function
+		   |[] -> None
+		   |h::_ when h = param.combo_value -> Some i
+		   |_::t -> aux (succ i) t
+		 in aux 0 param.combo_choices)
+	~packing: (hbox#pack ~expand: param.combo_expand ~padding: 2)
+	()
+      in
+	fun () -> match GEdit.text_combo_get_active wc with |None -> "" |Some s -> s
+    else
+      let (wc,_) = GEdit.combo_box_entry_text
+	~strings: param.combo_choices
+	~packing: (hbox#pack ~expand: param.combo_expand ~padding: 2)
+	()
+      in
+      let _ = wc#entry#set_editable param.combo_editable in
+      let _ = wc#entry#set_text param.combo_value in
+	fun () -> wc#entry#text
+    in
+object (self)
+  (** This method returns the main box ready to be packed. *)
+  method box = hbox#coerce
     (** This method applies the new value of the parameter. *)
-    method apply =
-      let new_value = wc#entry#text in
+  method apply =
+    let new_value = get_value () in
       if new_value <> param.combo_value then
 	let _ = param.combo_f_apply new_value in
-	param.combo_value <- new_value
+	  param.combo_value <- new_value
       else
 	()
-  end ;;
+end ;;
 
 (** Class used to pack a custom box. *)
 class custom_param_box param (tt:GData.tooltips) =
@@ -488,9 +506,9 @@ class color_param_box param (tt:GData.tooltips) =
     in
     let wb_ok = dialog#ok_button in
     let wb_cancel = dialog#cancel_button in
-    let _ = dialog#connect#destroy GMain.Main.quit in
+    let _ = dialog#connect#destroy ~callback:GMain.Main.quit in
     let _ = wb_ok#connect#clicked
-	(fun () ->
+	~callback:(fun () ->
 (*	  let color = dialog#colorsel#color in
 	  let r = (Gdk.Color.red color) in
 	  let g = (Gdk.Color.green color)in
@@ -505,11 +523,11 @@ class color_param_box param (tt:GData.tooltips) =
 	  dialog#destroy ()
 	)
     in
-    let _ = wb_cancel#connect#clicked dialog#destroy in
+    let _ = wb_cancel#connect#clicked ~callback:dialog#destroy in
     GMain.Main.main ()
   in
   let _ =
-    if param.color_editable then ignore (wb#connect#clicked f_sel)
+    if param.color_editable then ignore (wb#connect#clicked ~callback:f_sel)
   in
 
   object (self)
@@ -525,7 +543,7 @@ class color_param_box param (tt:GData.tooltips) =
 	()
 
     initializer
-      ignore (we#connect#changed (fun () -> set_color we#text));
+      ignore (we#connect#changed ~callback:(fun () -> set_color we#text));
 
   end ;;
 
@@ -573,19 +591,19 @@ class font_param_box param (tt:GData.tooltips) =
     dialog#selection#set_font_name !v;
     let wb_ok = dialog#ok_button in
     let wb_cancel = dialog#cancel_button in
-    let _ = dialog#connect#destroy GMain.Main.quit in
+    let _ = dialog#connect#destroy ~callback:GMain.Main.quit in
     let _ = wb_ok#connect#clicked
-	(fun () ->
+	~callback:(fun () ->
 	  let font = dialog#selection#font_name in
 	  we#set_text font ;
 	  set_entry_font (Some font);
 	  dialog#destroy ()
 	)
     in
-    let _ = wb_cancel#connect#clicked dialog#destroy in
+    let _ = wb_cancel#connect#clicked ~callback:dialog#destroy in
     GMain.Main.main ()
   in
-  let _ = if param.font_editable then ignore (wb#connect#clicked f_sel) in
+  let _ = if param.font_editable then ignore (wb#connect#clicked ~callback:f_sel) in
 
   object (self)
     (** This method returns the main box ready to be packed. *)
@@ -730,7 +748,7 @@ class filename_param_box param (tt:GData.tooltips) =
   in
   let _ =
     if param.string_editable then
-      let _ = wb#connect#clicked f_click in
+      let _ = wb#connect#clicked ~callback:f_click in
       ()
     else
       ()
@@ -782,7 +800,7 @@ class hotkey_param_box param (tt:GData.tooltips) =
   in
   let _ =
     if param.hk_editable then
-      ignore (we#event#connect#key_press capture)
+      ignore (we#event#connect#key_press ~callback:capture)
     else
       ()
   in
@@ -811,7 +829,7 @@ class modifiers_param_box param =
                                   ~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
+                                ~callback:(fun _ -> if but#active then value := modifier::!value
                                  else value := List.filter ((<>) modifier) !value)))
             param.md_allow
   in
@@ -867,7 +885,7 @@ class date_param_box param (tt:GData.tooltips) =
   in
   let _ =
     if param.date_editable then
-      let _ = wb#connect#clicked f_click in
+      let _ = wb#connect#clicked ~callback:f_click in
       ()
     else
       ()
@@ -910,106 +928,179 @@ class ['a] list_param_box (param : 'a list_param) (tt:GData.tooltips) =
       param.list_value <- !listref
   end ;;
 
-(** This class is used to build a box from a configuration structure
-   and adds the page to the given notebook. *)
-class configuration_box (tt:GData.tooltips) conf_struct (notebook : GPack.notebook) =
-  (* we build different widgets, according to the conf_struct parameter *)
-  let main_box = GPack.vbox () in
-  let (label, child_boxes) =
+(** This class creates a configuration box from a configuration structure *)
+class configuration_box (tt : GData.tooltips) conf_struct =
+
+  let main_box = GPack.hbox () in
+
+  let columns = new GTree.column_list in
+  let icon_col = columns#add GtkStock.conv in
+  let label_col = columns#add Gobject.Data.string in
+  let box_col = columns#add Gobject.Data.caml in
+  let () = columns#lock () in
+
+  let pane = GPack.paned `HORIZONTAL ~packing:main_box#add () in
+
+  (* Tree view part *)
+  let scroll = GBin.scrolled_window ~hpolicy:`NEVER ~packing:pane#pack1 () in
+  let tree = GTree.tree_store columns in
+  let view = GTree.view ~model:tree ~headers_visible:false ~packing:scroll#add_with_viewport () in
+  let selection = view#selection in
+  let _ = selection#set_mode `SINGLE in
+
+  let menu_box = GPack.vbox ~packing:pane#pack2 () in
+
+  let renderer = (GTree.cell_renderer_pixbuf [], ["stock-id", icon_col]) in
+  let col = GTree.view_column ~renderer () in
+  let _ = view#append_column col in
+
+  let renderer = (GTree.cell_renderer_text [], ["text", label_col]) in
+  let col = GTree.view_column ~renderer () in
+  let _ = view#append_column col in
+
+  let make_param (main_box : #GPack.box) = function
+  | String_param p ->
+    let box = new string_param_box p tt in
+    let _ = main_box#pack ~expand: false ~padding: 2 box#box in
+    box
+  | Combo_param p ->
+    let box = new combo_param_box p tt in
+    let _ = main_box#pack ~expand: false ~padding: 2 box#box in
+    box
+  | Text_param p ->
+    let box = new text_param_box p tt in
+    let _ = main_box#pack ~expand: p.string_expand ~padding: 2 box#box in
+    box
+  | Bool_param p ->
+    let box = new bool_param_box p tt in
+    let _ = main_box#pack ~expand: false ~padding: 2 box#box in
+    box
+  | Filename_param p ->
+    let box = new filename_param_box p tt in
+    let _ = main_box#pack ~expand: false ~padding: 2 box#box in
+    box
+  | List_param f ->
+    let box = f tt in
+    let _ = main_box#pack ~expand: true ~padding: 2 box#box in
+    box
+  | Custom_param p ->
+    let box = new custom_param_box p tt in
+    let _ = main_box#pack ~expand: p.custom_expand ~padding: 2 box#box in
+    box
+  | Color_param p ->
+    let box = new color_param_box p tt in
+    let _ = main_box#pack ~expand: false ~padding: 2 box#box in
+    box
+  | Font_param p ->
+    let box = new font_param_box p tt in
+    let _ = main_box#pack ~expand: false ~padding: 2 box#box in
+    box
+  | Date_param p ->
+    let box = new date_param_box p tt in
+    let _ = main_box#pack ~expand: false ~padding: 2 box#box in
+    box
+  | Hotkey_param p ->
+    let box = new hotkey_param_box p tt in
+    let _ = main_box#pack ~expand: false ~padding: 2 box#box in
+    box
+  | Modifiers_param p ->
+    let box = new modifiers_param_box p in
+    let _ = main_box#pack ~expand: false ~padding: 2 box#box in
+    box
+  | Html_param p ->
+    let box = new html_param_box p tt in
+    let _ = main_box#pack ~expand: p.string_expand ~padding: 2 box#box in
+    box
+  in
+
+  let set_icon iter = function
+  | None -> ()
+  | Some icon -> tree#set iter icon_col icon
+  in
+
+  (* Populate the tree *)
+
+  let rec make_tree iter conf_struct =
+    (* box is not shown at first *)
+    let box = GPack.vbox ~packing:menu_box#add ~show:false () in
+    let new_iter = match iter with
+    | None -> tree#append ()
+    | Some parent -> tree#append ~parent ()
+    in
     match conf_struct with
-      Section (label, param_list) ->
-	let f parameter =
-	  match parameter with
-	    String_param p ->
-	      let box = new string_param_box p tt in
-	      let _ = main_box#pack ~expand: false ~padding: 2 box#box in
-	      box
-	  | Combo_param p ->
-	      let box = new combo_param_box p tt in
-	      let _ = main_box#pack ~expand: false ~padding: 2 box#box in
-	      box
-	  | Text_param p ->
-	      let box = new text_param_box p tt in
-	      let _ = main_box#pack ~expand: p.string_expand ~padding: 2 box#box in
-	      box
-	  | Bool_param p ->
-	      let box = new bool_param_box p tt in
-	      let _ = main_box#pack ~expand: false ~padding: 2 box#box in
-	      box
-	  | Filename_param p ->
-	      let box = new filename_param_box p tt in
-	      let _ = main_box#pack ~expand: false ~padding: 2 box#box in
-	      box
-	  | List_param f ->
-	      let box = f tt in
-	      let _ = main_box#pack ~expand: true ~padding: 2 box#box in
-	      box
-	  | Custom_param p ->
-	      let box = new custom_param_box p tt in
-	      let _ = main_box#pack ~expand: p.custom_expand ~padding: 2 box#box in
-	      box
-	  | Color_param p ->
-	      let box = new color_param_box p tt in
-	      let _ = main_box#pack ~expand: false ~padding: 2 box#box in
-	      box
-	  | Font_param p ->
-	      let box = new font_param_box p tt in
-	      let _ = main_box#pack ~expand: false ~padding: 2 box#box in
-	      box
-	  | Date_param p ->
-	      let box = new date_param_box p tt in
-	      let _ = main_box#pack ~expand: false ~padding: 2 box#box in
-	      box
-	  | Hotkey_param p ->
-	      let box = new hotkey_param_box p tt in
-	      let _ = main_box#pack ~expand: false ~padding: 2 box#box in
-	      box
-	  | Modifiers_param p ->
-	      let box = new modifiers_param_box p in
-	      let _ = main_box#pack ~expand: false ~padding: 2 box#box in
-		box
-	  | Html_param p ->
-	      let box = new html_param_box p tt in
-	      let _ = main_box#pack ~expand: p.string_expand ~padding: 2 box#box in
-	      box
-	in
-	let list_children_boxes = List.map f param_list in
-
-	(label, list_children_boxes)
-
-    | Section_list (label, struct_list) ->
-	let wnote = GPack.notebook
-            (*homogeneous_tabs: true*)
-	    ~scrollable: true
-	    ~show_tabs: true
-	    ~tab_border: 3
-	    ~packing: (main_box#pack ~expand: true)
-	    ()
-	in
-	(* we create all the children boxes *)
-	let f structure =
-	  let new_box = new configuration_box tt structure wnote in
-	  new_box
-	in
-	let list_child_boxes = List.map f struct_list in
-	(label, list_child_boxes)
+    | Section (label, icon, param_list) ->
+      let params = List.map (make_param box) param_list in
+      let widget =
+        object
+          method box = box#coerce
+          method apply () = List.iter (fun param -> param#apply) params
+        end
+      in
+      let () = tree#set new_iter label_col label in
+      let () = set_icon new_iter icon in
+      let () = tree#set new_iter box_col widget in
+      ()
+    | Section_list (label, icon, struct_list) ->
+      let widget =
+        object
+      (* Section_list does not contain any effect widget, so we do not have to
+         apply anything. *)
+          method apply () = ()
+          method box = box#coerce
+        end
+      in
+      let () = tree#set new_iter label_col label in
+      let () = set_icon new_iter icon in
+      let () = tree#set new_iter box_col widget in
+      List.iter (make_tree (Some new_iter)) struct_list
+  in
+
+  let () = List.iter (make_tree None) conf_struct in
+
+  (* Dealing with signals *)
+
+  let current_prop : widget option ref = ref None in
+
+  let select_iter iter =
+    let () = match !current_prop with
+    | None -> ()
+    | Some box -> box#box#misc#hide ()
+    in
+    let box = tree#get ~row:iter ~column:box_col in
+    let () = box#box#misc#show () in
+    current_prop := Some box
+  in
 
+  let when_selected () =
+    let rows = selection#get_selected_rows in
+    match rows with
+    | [] -> ()
+    | row :: _ ->
+      let iter = tree#get_iter row in
+      select_iter iter
   in
-  let page_label = GMisc.label ~text: label () in
-  let _ = notebook#append_page
-      ~tab_label: page_label#coerce
-      main_box#coerce
+
+  (* Focus on a box when selected *)
+
+  let _ = selection#connect#changed ~callback:when_selected in
+
+  let _ = match tree#get_iter_first with
+  | None -> ()
+  | Some iter -> select_iter iter
   in
 
-  object (self)
-    (** This method returns the main box ready to be packed. *)
-    method box = main_box#coerce
-    (** This method make the new values of the paramters applied, recursively in
-       all boxes.*)
+  object
+
+    method box = main_box
+
     method apply =
-      List.iter (fun box -> box#apply) child_boxes
+      let foreach _ iter =
+        let widget = tree#get ~row:iter ~column:box_col in
+        widget#apply(); false
+      in
+      tree#foreach foreach
+
   end
-;;
 
 (** Create a vbox with the list of given configuration structure list,
    and the given list of buttons (defined by their label and callback).
@@ -1017,24 +1108,12 @@ class configuration_box (tt:GData.tooltips) conf_struct (notebook : GPack.notebo
    of each parameter is called.
 *)
 let tabbed_box conf_struct_list buttons tooltips =
-  let vbox = GPack.vbox () in
-  let wnote = GPack.notebook
-      (*homogeneous_tabs: true*)
-      ~scrollable: true
-      ~show_tabs: true
-      ~tab_border: 3
-      ~packing: (vbox#pack ~expand: true)
-      ()
+  let param_box =
+       new configuration_box tooltips conf_struct_list
   in
-  let list_param_box =
-    List.map
-      (fun conf_struct -> new configuration_box tooltips conf_struct wnote)
-      conf_struct_list
+  let f_apply () = param_box#apply
   in
-  let f_apply () =
-    List.iter (fun param_box -> param_box#apply) list_param_box  ;
-  in
-  let hbox_buttons = GPack.hbox ~packing: (vbox#pack ~expand: false ~padding: 4) () in
+  let hbox_buttons = GPack.hbox ~packing: (param_box#box#pack ~expand: false ~padding: 4) () in
   let rec iter_buttons ?(grab=false) = function
       [] ->
         ()
@@ -1051,14 +1130,14 @@ let tabbed_box conf_struct_list buttons tooltips =
   in
   iter_buttons ~grab: true buttons;
 
-  vbox
+  param_box#box
 
 (** This function takes a configuration structure list and creates a window
    to configure the various parameters. *)
 let edit ?(with_apply=true)
     ?(apply=(fun () -> ()))
     title ?(width=400) ?(height=400)
-    conf_struct_list =
+    conf_struct =
   let dialog = GWindow.dialog
     ~position:`CENTER
     ~modal: true ~title: title
@@ -1066,47 +1145,34 @@ let edit ?(with_apply=true)
     ()
   in
   let tooltips = GData.tooltips () in
-  let wnote = GPack.notebook
-    (*homogeneous_tabs: true*)
-    ~scrollable: true
-    ~show_tabs: true
-    ~tab_border: 3
-    ~packing: (dialog#vbox#pack ~expand: true)
-    ()
-  in
-  let list_param_box =
-    List.map
-      (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;
+  let config_box = new configuration_box tooltips conf_struct in
 
-    dialog#add_button Configwin_messages.mOk `OK;
-    dialog#add_button Configwin_messages.mCancel `CANCEL;
+  let _ = dialog#vbox#add config_box#box#coerce in
 
-    let f_apply () =
-      List.iter (fun param_box -> param_box#apply) list_param_box  ;
-      apply ()
-    in
-    let destroy () =
-      tooltips#destroy () ;
-      dialog#destroy ();
-    in
-    let rec iter rep =
-      try
-	match dialog#run () with
-	  | `APPLY  -> f_apply (); iter Return_apply
-	  | `OK -> f_apply (); destroy (); Return_ok
-	  | _ -> destroy (); rep
-      with
-	  Failure s ->
-	    GToolbox.message_box "Error" s; iter rep
-	| e ->
-	    GToolbox.message_box "Error" (Printexc.to_string e); iter rep
-    in
-      iter Return_cancel
+  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 destroy () =
+    tooltips#destroy () ;
+    dialog#destroy ();
+  in
+  let rec iter rep =
+    try
+      match dialog#run () with
+        | `APPLY  -> config_box#apply; iter Return_apply
+        | `OK -> config_box#apply; destroy (); Return_ok
+        | _ -> destroy (); rep
+    with
+        Failure s ->
+          GToolbox.message_box ~title:"Error" s; iter rep
+      | e ->
+          GToolbox.message_box ~title:"Error" (Printexc.to_string e); iter rep
+  in
+    iter Return_cancel
 
 (** Create a vbox with the list of given parameters. *)
 let box param_list tt =
@@ -1205,9 +1271,9 @@ let simple_edit ?(with_apply=true)
       | _ -> destroy (); rep
     with
       Failure s ->
-	GToolbox.message_box "Error" s; iter rep
+	GToolbox.message_box ~title:"Error" s; iter rep
     | e ->
-	GToolbox.message_box "Error" (Printexc.to_string e); iter rep
+	GToolbox.message_box ~title:"Error" (Printexc.to_string e); iter rep
   in
   iter Return_cancel