summaryrefslogtreecommitdiff
path: root/ide/configwin_ihm.ml
diff options
context:
space:
mode:
Diffstat (limited to 'ide/configwin_ihm.ml')
-rw-r--r--ide/configwin_ihm.ml809
1 files changed, 809 insertions, 0 deletions
diff --git a/ide/configwin_ihm.ml b/ide/configwin_ihm.ml
new file mode 100644
index 00000000..d16efa60
--- /dev/null
+++ b/ide/configwin_ihm.ml
@@ -0,0 +1,809 @@
+(*********************************************************************************)
+(* Cameleon *)
+(* *)
+(* Copyright (C) 2005 Institut National de Recherche en Informatique et *)
+(* en Automatique. All rights reserved. *)
+(* *)
+(* This program is free software; you can redistribute it and/or modify *)
+(* it under the terms of the GNU Library General Public License as *)
+(* published by the Free Software Foundation; either version 2 of the *)
+(* License, or any later version. *)
+(* *)
+(* This program is distributed in the hope that it will be useful, *)
+(* but WITHOUT ANY WARRANTY; without even the implied warranty of *)
+(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *)
+(* GNU Library General Public License for more details. *)
+(* *)
+(* You should have received a copy of the GNU Library General Public *)
+(* License along with this program; if not, write to the Free Software *)
+(* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA *)
+(* 02111-1307 USA *)
+(* *)
+(* Contact: Maxence.Guesdon@inria.fr *)
+(* *)
+(*********************************************************************************)
+
+(** This module contains the gui functions of Configwin.*)
+
+open Configwin_types
+
+let modifiers_to_string m =
+ let rec iter m s =
+ match m with
+ [] -> s
+ | c :: m ->
+ iter m ((
+ match c with
+ `CONTROL -> "<ctrl>"
+ | `SHIFT -> "<shft>"
+ | `LOCK -> "<lock>"
+ | `MOD1 -> "<alt>"
+ | `MOD2 -> "<mod2>"
+ | `MOD3 -> "<mod3>"
+ | `MOD4 -> "<mod4>"
+ | `MOD5 -> "<mod5>"
+ | _ -> raise Not_found
+ ) ^ s)
+ in
+ iter m ""
+
+class type widget =
+ object
+ method box : GObj.widget
+ method apply : unit -> unit
+ end
+
+let debug = false
+let dbg s = if debug then Minilib.log s else ()
+
+(** This class builds a frame with a clist and two buttons :
+ one to add items and one to remove the selected items.
+ The class takes in parameter a function used to add items and
+ a string list ref which is used to store the content of the clist.
+ At last, a title for the frame is also in parameter, so that
+ each instance of the class creates a frame. *)
+class ['a] list_selection_box
+ (listref : 'a list ref)
+ titles_opt
+ help_opt
+ f_edit_opt
+ f_strings
+ f_color
+ (eq : 'a -> 'a -> bool)
+ add_function title editable
+ (tt:GData.tooltips)
+ =
+ let _ = dbg "list_selection_box" in
+ let wev = GBin.event_box () in
+ let wf = GBin.frame ~label: title ~packing: wev#add () in
+ let hbox = GPack.hbox ~packing: wf#add () in
+ (* the scroll window and the clist *)
+ let wscroll = GBin.scrolled_window
+ ~vpolicy: `AUTOMATIC
+ ~hpolicy: `AUTOMATIC
+ ~packing: (hbox#pack ~expand: true) ()
+ in
+ let wlist = match titles_opt with
+ None ->
+ GList.clist ~selection_mode: `MULTIPLE
+ ~titles_show: false
+ ~packing: wscroll#add ()
+ | Some l ->
+ GList.clist ~selection_mode: `MULTIPLE
+ ~titles: l
+ ~titles_show: true
+ ~packing: wscroll#add ()
+ in
+ let _ =
+ match help_opt with
+ None -> ()
+ | Some help ->
+ tt#set_tip ~text: help ~privat: help wev#coerce
+ in (* the vbox for the buttons *)
+ let vbox_buttons = GPack.vbox () in
+ let _ =
+ if editable then
+ let _ = hbox#pack ~expand: false vbox_buttons#coerce in
+ ()
+ else
+ ()
+ in
+ let _ = dbg "list_selection_box: wb_add" in
+ let wb_add = GButton.button
+ ~label: Configwin_messages.mAdd
+ ~packing: (vbox_buttons#pack ~expand:false ~padding:2)
+ ()
+ in
+ let wb_edit = GButton.button
+ ~label: Configwin_messages.mEdit
+ ()
+ in
+ let _ = match f_edit_opt with
+ None -> ()
+ | Some _ -> vbox_buttons#pack ~expand:false ~padding:2 wb_edit#coerce
+ in
+ let wb_up = GButton.button
+ ~label: Configwin_messages.mUp
+ ~packing: (vbox_buttons#pack ~expand:false ~padding:2)
+ ()
+ in
+ let wb_remove = GButton.button
+ ~label: Configwin_messages.mRemove
+ ~packing: (vbox_buttons#pack ~expand:false ~padding:2)
+ ()
+ in
+ let _ = dbg "list_selection_box: object(self)" in
+ object (self)
+ (** the list of selected rows *)
+ val mutable list_select = []
+
+ (** This method returns the frame created. *)
+ method box = wev
+
+ method update l =
+ (* set the new list in the provided listref *)
+ listref := l;
+ (* insert the elements in the clist *)
+ wlist#freeze ();
+ wlist#clear ();
+ List.iter
+ (fun ele ->
+ ignore (wlist#append (f_strings ele));
+ match f_color ele with
+ None -> ()
+ | Some c ->
+ try wlist#set_row ~foreground: (`NAME c) (wlist#rows - 1)
+ with _ -> ()
+ )
+ !listref;
+
+ (match titles_opt with
+ None -> wlist#columns_autosize ()
+ | Some _ -> GToolbox.autosize_clist wlist);
+ wlist#thaw ();
+ (* the list of selectd elements is now empty *)
+ list_select <- []
+
+ (** Move up the selected rows. *)
+ method up_selected =
+ let rec iter n selrows l =
+ match selrows with
+ [] -> (l, [])
+ | m :: qrows ->
+ match l with
+ [] -> ([],[])
+ | [_] -> (l,[])
+ | e1 :: e2 :: q when m = n + 1 ->
+ let newl, newrows = iter (n+1) qrows (e1 :: q) in
+ (e2 :: newl, n :: newrows)
+ | e1 :: q ->
+ let newl, newrows = iter (n+1) selrows q in
+ (e1 :: newl, newrows)
+ in
+ let sorted_select = List.sort compare list_select in
+ let new_list, new_rows = iter 0 sorted_select !listref in
+ self#update new_list;
+ List.iter (fun n -> wlist#select n 0) new_rows
+
+ (** Make the user edit the first selected row. *)
+ method edit_selected f_edit =
+ let sorted_select = List.sort compare list_select in
+ match sorted_select with
+ [] -> ()
+ | n :: _ ->
+ try
+ let ele = List.nth !listref n in
+ let ele2 = f_edit ele in
+ let rec iter m = function
+ [] -> []
+ | e :: q ->
+ if n = m then
+ ele2 :: q
+ else
+ e :: (iter (m+1) q)
+ in
+ self#update (iter 0 !listref);
+ wlist#select n 0
+ with
+ Not_found ->
+ ()
+
+ initializer
+ (** create the functions called when the buttons are clicked *)
+ let f_add () =
+ (* get the files to add with the function provided *)
+ let l = add_function () in
+ (* remove from the list the ones which are already in
+ the listref, using the eq predicate *)
+ let l2 = List.fold_left
+ (fun acc -> fun ele ->
+ if List.exists (eq ele) acc then
+ acc
+ else
+ acc @ [ele])
+ !listref
+ l
+ in
+ self#update l2
+ in
+ let f_remove () =
+ (* remove the selected items from the listref and the clist *)
+ let rec iter n = function
+ [] -> []
+ | h :: q ->
+ if List.mem n list_select then
+ iter (n+1) q
+ else
+ h :: (iter (n+1) q)
+ in
+ let new_list = iter 0 !listref in
+ self#update new_list
+ in
+ let _ = dbg "list_selection_box: connecting wb_add" in
+ (* connect the functions to the buttons *)
+ ignore (wb_add#connect#clicked ~callback:f_add);
+ let _ = dbg "list_selection_box: connecting wb_remove" in
+ ignore (wb_remove#connect#clicked ~callback:f_remove);
+ let _ = dbg "list_selection_box: connecting wb_up" in
+ 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 ~callback:(fun () -> self#edit_selected f))
+ );
+ (* connect the selection and deselection of items in the clist *)
+ let f_select ~row ~column ~event =
+ try
+ list_select <- row :: list_select
+ with
+ Failure _ ->
+ ()
+ in
+ let f_unselect ~row ~column ~event =
+ try
+ let new_list_select = List.filter (fun n -> n <> row) list_select in
+ list_select <- new_list_select
+ with
+ Failure _ ->
+ ()
+ in
+ (* connect the select and deselect events *)
+ let _ = dbg "list_selection_box: connecting select_row" in
+ ignore(wlist#connect#select_row ~callback:f_select);
+ let _ = dbg "list_selection_box: connecting unselect_row" in
+ ignore(wlist#connect#unselect_row ~callback:f_unselect);
+
+ (* initialize the clist with the listref *)
+ self#update !listref
+ end;;
+
+
+(** This class is used to build a box for a string parameter.*)
+class string_param_box param (tt:GData.tooltips) =
+ let _ = dbg "string_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.string_label ~packing: wev#add () in
+ let we = GEdit.entry
+ ~editable: param.string_editable
+ ~packing: (hbox#pack ~expand: param.string_expand ~padding: 2)
+ ()
+ in
+ let _ =
+ match param.string_help with
+ None -> ()
+ | Some help ->
+ tt#set_tip ~text: help ~privat: help wev#coerce
+ in
+ let _ = we#set_text (param.string_to_string param.string_value) 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 = param.string_of_string we#text in
+ if new_value <> param.string_value then
+ let _ = param.string_f_apply new_value in
+ param.string_value <- new_value
+ else
+ ()
+ end ;;
+
+(** 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 _ =
+ 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 = get_value () in
+ if new_value <> param.combo_value then
+ let _ = param.combo_f_apply new_value in
+ param.combo_value <- new_value
+ else
+ ()
+end ;;
+
+(** Class used to pack a custom box. *)
+class custom_param_box param (tt:GData.tooltips) =
+ let _ = dbg "custom_param_box" in
+ let top =
+ match param.custom_framed with
+ None -> param.custom_box#coerce
+ | Some l ->
+ let wf = GBin.frame ~label: l () in
+ wf#add param.custom_box#coerce;
+ wf#coerce
+ in
+ object (self)
+ method box = top
+ method apply = param.custom_f_apply ()
+ end
+
+(** This class is used to build a box for a text parameter.*)
+class text_param_box param (tt:GData.tooltips) =
+ let _ = dbg "text_param_box" in
+ let wf = GBin.frame ~label: param.string_label ~height: 100 () in
+ let wev = GBin.event_box ~packing: wf#add () in
+ let wscroll = GBin.scrolled_window
+ ~vpolicy: `AUTOMATIC
+ ~hpolicy: `AUTOMATIC
+ ~packing: wev#add ()
+ in
+ let wview = GText.view
+ ~editable: param.string_editable
+ ~packing: wscroll#add
+ ()
+ in
+ let _ =
+ match param.string_help with
+ None -> ()
+ | Some help ->
+ tt#set_tip ~text: help ~privat: help wev#coerce
+ in
+ let _ = dbg "text_param_box: buffer creation" in
+ let buffer = GText.buffer () in
+
+ let _ = wview#set_buffer buffer in
+ let _ = buffer#insert (param.string_to_string param.string_value) in
+ let _ = dbg "text_param_box: object(self)" in
+ object (self)
+ val wview = wview
+ (** This method returns the main box ready to be packed. *)
+ method box = wf#coerce
+ (** This method applies the new value of the parameter. *)
+ method apply =
+ let v = param.string_of_string (buffer#get_text ()) in
+ if v <> param.string_value then
+ (
+ dbg "apply new value!";
+ let _ = param.string_f_apply v in
+ param.string_value <- v
+ )
+ else
+ ()
+ end ;;
+
+(** This class is used to build a box for a boolean parameter.*)
+class bool_param_box param (tt:GData.tooltips) =
+ let _ = dbg "bool_param_box" in
+ let wchk = GButton.check_button
+ ~label: param.bool_label
+ ()
+ in
+ let _ =
+ match param.bool_help with
+ None -> ()
+ | Some help -> tt#set_tip ~text: help ~privat: help wchk#coerce
+ in
+ let _ = wchk#set_active param.bool_value in
+ let _ = wchk#misc#set_sensitive param.bool_editable in
+
+ object (self)
+ (** This method returns the check button ready to be packed. *)
+ method box = wchk#coerce
+ (** This method applies the new value of the parameter. *)
+ method apply =
+ let new_value = wchk#active in
+ if new_value <> param.bool_value then
+ let _ = param.bool_f_apply new_value in
+ param.bool_value <- new_value
+ else
+ ()
+ end ;;
+
+class modifiers_param_box param =
+ let hbox = GPack.hbox () 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 value = ref param.md_value in
+ let _ = List.map (fun modifier ->
+ let but = GButton.toggle_button
+ ~label:(modifiers_to_string [modifier])
+ ~active:(List.mem modifier param.md_value)
+ ~packing:(hbox#pack ~expand:false) () in
+ ignore (but#connect#toggled
+ ~callback:(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
+ 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 = !value in
+ if new_value <> param.md_value then
+ let _ = param.md_f_apply new_value in
+ param.md_value <- new_value
+ else
+ ()
+ end ;;
+
+(** This class is used to build a box for a parameter whose values are a list.*)
+class ['a] list_param_box (param : 'a list_param) (tt:GData.tooltips) =
+ let _ = dbg "list_param_box" in
+ let listref = ref param.list_value in
+ let frame_selection = new list_selection_box
+ listref
+ param.list_titles
+ param.list_help
+ param.list_f_edit
+ param.list_strings
+ param.list_color
+ param.list_eq
+ param.list_f_add param.list_label param.list_editable
+ tt
+ in
+
+ object (self)
+ (** This method returns the main box ready to be packed. *)
+ method box = frame_selection#box#coerce
+ (** This method applies the new value of the parameter. *)
+ method apply =
+ param.list_f_apply !listref ;
+ param.list_value <- !listref
+ end ;;
+
+(** 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
+ | 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
+ | Modifiers_param p ->
+ let box = new modifiers_param_box p in
+ let _ = main_box#pack ~expand: false ~padding: 2 box#box in
+ box
+ in
+
+ let set_icon iter = function
+ | None -> ()
+ | Some icon -> tree#set ~row:iter ~column: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#pack ~expand:true) ~show:false () in
+ let new_iter = match iter with
+ | None -> tree#append ()
+ | Some parent -> tree#append ~parent ()
+ in
+ match conf_struct with
+ | 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 ~row:new_iter ~column:label_col label in
+ let () = set_icon new_iter icon in
+ let () = tree#set ~row:new_iter ~column: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 ~row:new_iter ~column:label_col label in
+ let () = set_icon new_iter icon in
+ let () = tree#set ~row:new_iter ~column: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
+
+ (* 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
+
+ method box = main_box
+
+ method apply =
+ let foreach _ iter =
+ let widget = tree#get ~row:iter ~column:box_col in
+ widget#apply(); false
+ in
+ tree#foreach foreach
+
+ end
+
+(** 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 ?height
+ conf_struct =
+ let dialog = GWindow.dialog
+ ~position:`CENTER
+ ~modal: true ~title: title
+ ?height ?width
+ ()
+ in
+ let tooltips = GData.tooltips () in
+
+ let config_box = new configuration_box tooltips conf_struct in
+
+ let _ = dialog#vbox#add config_box#box#coerce 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 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
+
+let edit_string l s =
+ match GToolbox.input_string ~title: l ~text: s Configwin_messages.mValue with
+ None -> s
+ | Some s2 -> s2
+
+(** Create a string param. *)
+let string ?(editable=true) ?(expand=true) ?help ?(f=(fun _ -> ())) label v =
+ String_param
+ {
+ string_label = label ;
+ string_help = help ;
+ string_value = v ;
+ string_editable = editable ;
+ string_f_apply = f ;
+ string_expand = expand ;
+ string_to_string = (fun x -> x) ;
+ string_of_string = (fun x -> x) ;
+ }
+
+(** Create a bool param. *)
+let bool ?(editable=true) ?help ?(f=(fun _ -> ())) label v =
+ Bool_param
+ {
+ bool_label = label ;
+ bool_help = help ;
+ bool_value = v ;
+ bool_editable = editable ;
+ bool_f_apply = f ;
+ }
+
+(** Create a list param. *)
+let list ?(editable=true) ?help
+ ?(f=(fun (_:'a list) -> ()))
+ ?(eq=Pervasives.(=))
+ ?(edit:('a -> 'a) option)
+ ?(add=(fun () -> ([] : 'a list)))
+ ?titles ?(color=(fun (_:'a) -> (None : string option)))
+ label (f_strings : 'a -> string list) v =
+ List_param
+ (fun 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. *)
+let strings ?(editable=true) ?help
+ ?(f=(fun _ -> ()))
+ ?(eq=Pervasives.(=))
+ ?(add=(fun () -> [])) label v =
+ list ~editable ?help ~f ~eq ~edit: (edit_string label) ~add label (fun s -> [s]) v
+
+(** Create a combo param. *)
+let combo ?(editable=true) ?(expand=true) ?help ?(f=(fun _ -> ()))
+ ?(new_allowed=false)
+ ?(blank_allowed=false) label choices v =
+ Combo_param
+ {
+ combo_label = label ;
+ combo_help = help ;
+ combo_value = v ;
+ combo_editable = editable ;
+ combo_choices = choices ;
+ combo_new_allowed = new_allowed ;
+ combo_blank_allowed = blank_allowed ;
+ combo_f_apply = f ;
+ combo_expand = expand ;
+ }
+
+let modifiers
+ ?(editable=true)
+ ?(expand=true)
+ ?help
+ ?(allow=[`CONTROL;`SHIFT;`LOCK;`MOD1;`MOD2;`MOD3;`MOD4;`MOD5])
+ ?(f=(fun _ -> ())) label v =
+ Modifiers_param
+ {
+ md_label = label ;
+ md_help = help ;
+ md_value = v ;
+ md_editable = editable ;
+ md_f_apply = f ;
+ md_expand = expand ;
+ md_allow = allow ;
+ }
+
+(** Create a custom param.*)
+let custom ?label box f expand =
+ Custom_param
+ {
+ custom_box = box ;
+ custom_f_apply = f ;
+ custom_expand = expand ;
+ custom_framed = label ;
+ }
generated by cgit v1.2.3 (git 2.39.1) at 2024-05-02 23:44:53 +0000