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.ml846
1 files changed, 444 insertions, 402 deletions
diff --git a/ide/utils/configwin_ihm.ml b/ide/utils/configwin_ihm.ml
index 03ca706c..e9ba9789 100644
--- a/ide/utils/configwin_ihm.ml
+++ b/ide/utils/configwin_ihm.ml
@@ -1,68 +1,73 @@
-(**************************************************************************)
-(* Cameleon *)
-(* *)
-(* Copyright (C) 2002 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 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 General Public License for more details. *)
-(* *)
-(* You should have received a copy of the GNU 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 Confgiwin.*)
+(*********************************************************************************)
+(* 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
-module O = Uoptions
+module O = Config_file
-
-(** The file where the html config is. *)
let file_html_config = Filename.concat Configwin_messages.home ".configwin_html"
-
-(** Return the ini file for the html config, and the option for bindings. *)
+
+let debug = false
+let dbg = if debug then prerr_endline else (fun _ -> ())
+
+(** Return the config group for the html config file,
+ and the option for bindings. *)
let html_config_file_and_option () =
- let ini = O.create_options_file file_html_config in
- let bindings = O.define_option ini ["bindings"]
- ""
- (O.list_option Configwin_types.Html_binding.t)
- [ { html_key = KeyOption.string_to_key "A-b" ;
+ let ini = new O.group in
+ let bindings = new O.list_cp
+ Configwin_types.htmlbinding_cp_wrapper
+ ~group: ini
+ ["bindings"]
+ ~short_name: "bd"
+ [ { html_key = Configwin_types.string_to_key "A-b" ;
html_begin = "<b>";
html_end = "</b>" ;
} ;
- { html_key = KeyOption.string_to_key "A-i" ;
+ { html_key = Configwin_types.string_to_key "A-i" ;
html_begin = "<i>";
html_end = "</i>" ;
- }
- ]
+ }
+ ]
+ ""
in
- O.load ini ;
+ ini#read file_html_config ;
(ini, bindings)
-
(** This variable contains the last directory where the user selected a file.*)
let last_dir = ref "";;
(** This function allows the user to select a file and returns the
- selected file name. An optional function allows to change the
+ selected file name. An optional function allows to change the
behaviour of the ok button.
A VOIR : mutli-selection ? *)
let select_files ?dir
?(fok : (string -> unit) option)
the_title =
- let files = ref ([] : string list) in
+ let files = ref ([] : string list) in
let fs = GWindow.file_selection ~modal:true
~title: the_title () in
(* we set the previous directory, if no directory is given *)
@@ -78,7 +83,7 @@ let select_files ?dir
let _ = fs#set_filename !last_dir in
()
);
-
+
let _ = fs # connect#destroy ~callback: GMain.Main.quit in
let _ = fs # ok_button # connect#clicked ~callback:
(match fok with
@@ -134,52 +139,55 @@ let select_date title (day,mon,year) =
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
+ 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)
+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 =
+ 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) ()
+ ~vpolicy: `AUTOMATIC
+ ~hpolicy: `AUTOMATIC
+ ~packing: (hbox#pack ~expand: true) ()
in
let wlist = match titles_opt with
- None ->
+ None ->
GList.clist ~selection_mode: `MULTIPLE
~titles_show: false
~packing: wscroll#add ()
- | Some l ->
- GList.clist ~selection_mode: `MULTIPLE
+ | Some l ->
+ GList.clist ~selection_mode: `MULTIPLE
~titles: l
~titles_show: true
~packing: wscroll#add ()
in
- let _ =
+ let _ =
match help_opt with
None -> ()
| Some help ->
- let tooltips = GData.tooltips () in
- ignore (wf#connect#destroy ~callback: tooltips#destroy);
- tooltips#set_tip wev#coerce ~text: help ~privat: help
+ tt#set_tip ~text: help ~privat: help wev#coerce
in (* the vbox for the buttons *)
let vbox_buttons = GPack.vbox () in
- let _ =
+ 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)
@@ -203,6 +211,7 @@ class ['a] list_selection_box (listref : 'a list ref)
~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 = []
@@ -216,17 +225,17 @@ class ['a] list_selection_box (listref : 'a list ref)
(* insert the elements in the clist *)
wlist#freeze ();
wlist#clear ();
- List.iter
- (fun ele ->
+ 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);
@@ -280,10 +289,10 @@ class ['a] list_selection_box (listref : 'a list ref)
initializer
(** create the functions called when the buttons are clicked *)
- let f_add () =
+ 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
+ (* 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 ->
@@ -293,7 +302,7 @@ class ['a] list_selection_box (listref : 'a list ref)
acc @ [ele])
!listref
l
- in
+ in
self#update l2
in
let f_remove () =
@@ -309,14 +318,19 @@ class ['a] list_selection_box (listref : 'a list ref)
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 f_add);
+ let _ = dbg "list_selection_box: connecting wb_remove" in
ignore (wb_remove#connect#clicked f_remove);
+ let _ = dbg "list_selection_box: connecting wb_up" in
ignore (wb_up#connect#clicked (fun () -> self#up_selected));
(
match f_edit_opt with
None -> ()
- | Some f -> ignore (wb_edit#connect#clicked (fun () -> self#edit_selected f))
+ | Some f ->
+ let _ = dbg "list_selection_box: connecting wb_edit" in
+ ignore (wb_edit#connect#clicked (fun () -> self#edit_selected f))
);
(* connect the selection and deselection of items in the clist *)
let f_select ~row ~column ~event =
@@ -335,7 +349,9 @@ class ['a] list_selection_box (listref : 'a list ref)
()
in
(* connect the select and deselect events *)
+ let _ = dbg "list_selection_box: connecting select_row" in
ignore(wlist#connect#select_row f_select);
+ let _ = dbg "list_selection_box: connecting unselect_row" in
ignore(wlist#connect#unselect_row f_unselect);
(* initialize the clist with the listref *)
@@ -344,7 +360,8 @@ class ['a] list_selection_box (listref : 'a list ref)
(** This class is used to build a box for a string parameter.*)
-class string_param_box param =
+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
@@ -353,22 +370,20 @@ class string_param_box param =
~packing: (hbox#pack ~expand: param.string_expand ~padding: 2)
()
in
- let _ =
+ let _ =
match param.string_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
+ tt#set_tip ~text: help ~privat: help wev#coerce
in
- let _ = we#set_text param.string_value 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 = we#text in
+ 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
@@ -377,24 +392,23 @@ class string_param_box param =
end ;;
(** This class is used to build a box for a combo parameter.*)
-class combo_param_box param =
+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)
-(* ~ok_if_empty: param.combo_blank_allowed*)
+ (* ~allow_empty: param.combo_blank_allowed *)
~packing: (hbox#pack ~expand: param.combo_expand ~padding: 2)
()
in
- let _ =
+ let _ =
match param.combo_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
+ 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
@@ -413,8 +427,9 @@ class combo_param_box param =
end ;;
(** Class used to pack a custom box. *)
-class custom_param_box param =
- let top =
+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 ->
@@ -428,40 +443,39 @@ class custom_param_box param =
end
(** This class is used to build a box for a color parameter.*)
-class color_param_box param =
+class color_param_box param (tt:GData.tooltips) =
+ let _ = dbg "color_param_box" in
let v = ref param.color_value in
let hbox = GPack.hbox () in
- let wb = GButton.button ~label: param.color_label
- ~packing: (hbox#pack ~expand: false ~padding: 2) ()
+ let wb = GButton.button ~label: param.color_label
+ ~packing: (hbox#pack ~expand: false ~padding: 2) ()
in
- let w_test = GMisc.arrow
+ let w_test = GMisc.arrow
~kind: `RIGHT
~shadow: `OUT
~width: 20
~height: 20
~packing: (hbox#pack ~expand: false ~padding: 2 )
- ()
+ ()
in
let we = GEdit.entry
~editable: param.color_editable
~packing: (hbox#pack ~expand: param.color_expand ~padding: 2)
()
in
- let _ =
+ let _ =
match param.color_help with
None -> ()
| Some help ->
- let tooltips = GData.tooltips () in
- ignore (hbox#connect#destroy ~callback: tooltips#destroy);
- tooltips#set_tip wb#coerce ~text: help ~privat: help
+ tt#set_tip ~text: help ~privat: help wb#coerce
in
let set_color s =
let style = w_test#misc#style#copy in
(
- try style#set_bg [ (`NORMAL, `NAME s) ; ]
+ try style#set_fg [ (`NORMAL, `NAME s) ; ]
with _ -> ()
);
- w_test#misc#set_style style
+ w_test#misc#set_style style;
in
let _ = set_color !v in
let _ = we#set_text !v in
@@ -476,26 +490,25 @@ class color_param_box param =
let wb_cancel = dialog#cancel_button in
let _ = dialog#connect#destroy GMain.Main.quit in
let _ = wb_ok#connect#clicked
- (fun () ->
- (* let color = dialog#colorsel#get_color in
- let r = int_of_float (ceil (color.Gtk.red *. 255.)) in
- let g = int_of_float (ceil (color.Gtk.green *. 255.)) in
- let b = int_of_float (ceil (color.Gtk.blue *. 255.)) in
- let s = Printf.sprintf "#%2X%2X%2X" r g b in
- let _ =
+ (fun () ->
+(* let color = dialog#colorsel#color in
+ let r = (Gdk.Color.red color) in
+ let g = (Gdk.Color.green color)in
+ let b = (Gdk.Color.blue color) in
+ let s = Printf.sprintf "#%4X%4X%4X" r g b in
+ let _ =
for i = 1 to (String.length s) - 1 do
if s.[i] = ' ' then s.[i] <- '0'
done
in
- we#set_text s ;
- set_color s;*)
+ we#set_text s ; *)
dialog#destroy ()
)
in
let _ = wb_cancel#connect#clicked dialog#destroy in
GMain.Main.main ()
in
- let _ =
+ let _ =
if param.color_editable then ignore (wb#connect#clicked f_sel)
in
@@ -510,27 +523,30 @@ class color_param_box param =
param.color_value <- new_value
else
()
+
+ initializer
+ ignore (we#connect#changed (fun () -> set_color we#text));
+
end ;;
(** This class is used to build a box for a font parameter.*)
-class font_param_box param =
+class font_param_box param (tt:GData.tooltips) =
+ let _ = dbg "font_param_box" in
let v = ref param.font_value in
let hbox = GPack.hbox () in
- let wb = GButton.button ~label: param.font_label
- ~packing: (hbox#pack ~expand: false ~padding: 2) ()
+ let wb = GButton.button ~label: param.font_label
+ ~packing: (hbox#pack ~expand: false ~padding: 2) ()
in
let we = GEdit.entry
~editable: false
~packing: (hbox#pack ~expand: param.font_expand ~padding: 2)
()
in
- let _ =
+ let _ =
match param.font_help with
None -> ()
| Some help ->
- let tooltips = GData.tooltips () in
- ignore (hbox#connect#destroy ~callback: tooltips#destroy);
- tooltips#set_tip wb#coerce ~text: help ~privat: help
+ tt#set_tip ~text: help ~privat: help wb#coerce
in
let set_entry_font font_opt =
match font_opt with
@@ -538,7 +554,7 @@ class font_param_box param =
| Some s ->
let style = we#misc#style#copy in
(
- try
+ try
let font = Gdk.Font.load_fontset s in
style#set_font font
with _ -> ()
@@ -559,10 +575,10 @@ class font_param_box param =
let wb_cancel = dialog#cancel_button in
let _ = dialog#connect#destroy GMain.Main.quit in
let _ = wb_ok#connect#clicked
- (fun () ->
- let font_opt = dialog#selection#font_name in
-(* we#set_text (match font_opt with None -> "" | Some s -> s) ;
- set_entry_font font_opt;*)
+ (fun () ->
+ let font = dialog#selection#font_name in
+ we#set_text font ;
+ set_entry_font (Some font);
dialog#destroy ()
)
in
@@ -585,79 +601,89 @@ class font_param_box param =
end ;;
(** This class is used to build a box for a text parameter.*)
-class text_param_box param =
- let hbox = GPack.hbox ~height: 100 () 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
+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: (hbox#pack ~expand: true ~padding: 2) ()
+ ~packing: wev#add ()
in
- let wt = GText.view ~packing:wscroll#add () in
-(* let _ = wt#coerce#misc#set_size_request ~height:100 in *)
- let _ = wt#set_editable param.string_editable in
- let _ =
+ let wview = GText.view
+ ~editable: param.string_editable
+ ~packing: wscroll#add
+ ()
+ in
+ let _ =
match param.string_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
+ tt#set_tip ~text: help ~privat: help wev#coerce
in
- let _ = wt#buffer#insert param.string_value 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 wt = wt
+ val wview = wview
(** This method returns the main box ready to be packed. *)
- method box = hbox#coerce
+ method box = wf#coerce
(** This method applies the new value of the parameter. *)
method apply =
- let new_value = wt#buffer#get_text () in
- if new_value <> param.string_value then
- let _ = param.string_f_apply new_value in
- param.string_value <- new_value
+ 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 a html parameter. *)
-class html_param_box param =
+class html_param_box param (tt:GData.tooltips) =
+ let _ = dbg "html_param_box" in
object (self)
- inherit text_param_box param
+ inherit text_param_box param tt
method private exec html_start html_end () =
- let s,e = wt#buffer#selection_bounds in
- if s#compare e = 0 then
- wt#buffer#insert (html_start^html_end)
- else begin
- ignore (wt#buffer#insert ~iter:e html_end);
- ignore (wt#buffer#insert ~iter:s html_start);
- wt#buffer#place_cursor
- (e#forward_chars (String.length (html_start^html_end)))
- end
+ let (i1,i2) = wview#buffer#selection_bounds in
+ let s = i1#get_text ~stop: i2 in
+ match s with
+ "" ->
+ wview#buffer#insert (html_start^html_end)
+ | _ ->
+ ignore (wview#buffer#insert ~iter: i2 html_end);
+ ignore (wview#buffer#insert ~iter: i1 html_start);
+ wview#buffer#place_cursor ~where: i2
+
initializer
+ dbg "html_param_box:initializer";
let (_,html_bindings) = html_config_file_and_option () in
+ dbg "html_param_box:connecting key press events";
let add_shortcut hb =
let (mods, k) = hb.html_key in
- Okey.add wt ~mods k (self#exec hb.html_begin hb.html_end)
+ Okey.add wview ~mods k (self#exec hb.html_begin hb.html_end)
in
- List.iter add_shortcut (O.(!!) html_bindings)
+ List.iter add_shortcut html_bindings#get;
+ dbg "html_param_box:end"
end
(** This class is used to build a box for a boolean parameter.*)
-class bool_param_box param =
+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 _ =
+ let _ =
match param.bool_help with
None -> ()
- | Some help ->
- let tooltips = GData.tooltips () in
- ignore (wchk#connect#destroy ~callback: tooltips#destroy);
- tooltips#set_tip wchk#coerce ~text: help ~privat: help
+ | 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
@@ -676,25 +702,24 @@ class bool_param_box param =
end ;;
(** This class is used to build a box for a file name parameter.*)
-class filename_param_box param =
+class filename_param_box param (tt:GData.tooltips) =
+ let _ = dbg "filename_param_box" in
let hbox = GPack.hbox () in
- let wb = GButton.button ~label: param.string_label
- ~packing: (hbox#pack ~expand: false ~padding: 2) ()
+ let wb = GButton.button ~label: param.string_label
+ ~packing: (hbox#pack ~expand: false ~padding: 2) ()
in
let we = GEdit.entry
~editable: param.string_editable
~packing: (hbox#pack ~expand: param.string_expand ~padding: 2)
()
in
- let _ =
+ let _ =
match param.string_help with
None -> ()
| Some help ->
- let tooltips = GData.tooltips () in
- ignore (hbox#connect#destroy ~callback: tooltips#destroy);
- tooltips#set_tip wb#coerce ~text: help ~privat: help
+ tt#set_tip ~text: help ~privat: help wb#coerce
in
- let _ = we#set_text param.string_value in
+ let _ = we#set_text (param.string_to_string param.string_value) in
let f_click () =
match select_files param.string_label with
@@ -703,7 +728,7 @@ class filename_param_box param =
| f :: _ ->
we#set_text f
in
- let _ =
+ let _ =
if param.string_editable then
let _ = wb#connect#clicked f_click in
()
@@ -716,7 +741,7 @@ class filename_param_box param =
method box = hbox#coerce
(** This method applies the new value of the parameter. *)
method apply =
- let new_value = we#text in
+ 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
@@ -725,11 +750,12 @@ class filename_param_box param =
end ;;
(** This class is used to build a box for a hot key parameter.*)
-class hotkey_param_box param =
+class hotkey_param_box param (tt:GData.tooltips) =
+ let _ = dbg "hotkey_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.hk_label
- ~packing: wev#add ()
+ let wl = GMisc.label ~text: param.hk_label
+ ~packing: wev#add ()
in
let we = GEdit.entry
~editable: false
@@ -737,15 +763,13 @@ class hotkey_param_box param =
()
in
let value = ref param.hk_value in
- let _ =
+ let _ =
match param.hk_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
+ tt#set_tip ~text: help ~privat: help wev#coerce
in
- let _ = we#set_text (KeyOption.key_to_string param.hk_value) in
+ let _ = we#set_text (Configwin_types.key_to_string param.hk_value) in
let mods_we_dont_care = [`MOD2 ; `MOD3 ; `MOD4 ; `MOD5 ; `LOCK] in
let capture ev =
let key = GdkEvent.Key.keyval ev in
@@ -755,10 +779,10 @@ class hotkey_param_box param =
modifiers
in
value := (mods, key);
- we#set_text (KeyOption.key_to_string !value);
+ we#set_text (Glib.Convert.locale_to_utf8 (Configwin_types.key_to_string !value));
false
in
- let _ =
+ let _ =
if param.hk_editable then
ignore (we#event#connect#key_press capture)
else
@@ -798,7 +822,7 @@ class modifiers_param_box param =
ignore (hbox#connect#destroy ~callback: tooltips#destroy);
tooltips#set_tip wev#coerce ~text: help ~privat: help
in
- let _ = we#set_text (KeyOption.modifiers_to_string param.md_value) 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
@@ -807,7 +831,7 @@ class modifiers_param_box param =
modifiers
in
value := mods;
- we#set_text (KeyOption.modifiers_to_string !value);
+ we#set_text (Configwin_types.modifiers_to_string !value);
false
in
let _ =
@@ -831,35 +855,35 @@ class modifiers_param_box param =
end ;;
(** This class is used to build a box for a date parameter.*)
-class date_param_box param =
+class date_param_box param (tt:GData.tooltips) =
+ let _ = dbg "date_param_box" in
let v = ref param.date_value in
let hbox = GPack.hbox () in
- let wb = GButton.button ~label: param.date_label
- ~packing: (hbox#pack ~expand: false ~padding: 2) ()
+ let wb = GButton.button ~label: param.date_label
+ ~packing: (hbox#pack ~expand: false ~padding: 2) ()
in
let we = GEdit.entry
~editable: false
~packing: (hbox#pack ~expand: param.date_expand ~padding: 2)
()
in
- let _ =
+
+ let _ =
match param.date_help with
None -> ()
| Some help ->
- let tooltips = GData.tooltips () in
- ignore (hbox#connect#destroy ~callback: tooltips#destroy);
- tooltips#set_tip wb#coerce ~text: help ~privat: help
+ tt#set_tip ~text: help ~privat: help wb#coerce
in
- let _ = we#set_text (param.date_f_string param.date_value) in
+ let _ = we#set_text (param.date_f_string param.date_value) in
let f_click () =
match select_date param.date_label !v with
None -> ()
- | Some (y,m,d) ->
+ | Some (y,m,d) ->
v := (d,m,y) ;
we#set_text (param.date_f_string (d,m,y))
in
- let _ =
+ let _ =
if param.date_editable then
let _ = wb#connect#clicked f_click in
()
@@ -880,7 +904,8 @@ class date_param_box param =
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) =
+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
@@ -891,8 +916,9 @@ class ['a] list_param_box (param : 'a list_param) =
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
@@ -902,75 +928,75 @@ class ['a] list_param_box (param : 'a list_param) =
param.list_value <- !listref
end ;;
-(** This class is used to build a box from a configuration structure
+(** This class is used to build a box from a configuration structure
and adds the page to the given notebook. *)
-class configuration_box conf_struct (notebook : GPack.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) =
+ let (label, child_boxes) =
match conf_struct with
Section (label, param_list) ->
let f parameter =
- match parameter with
- String_param p ->
- let box = new string_param_box p in
- let _ = main_box#pack ~expand: false ~padding: 2 box#box in
- box
- | Combo_param p ->
- let box = new combo_param_box p in
- let _ = main_box#pack ~expand: false ~padding: 2 box#box in
- box
- | Text_param p ->
- let box = new text_param_box p 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 in
- let _ = main_box#pack ~expand: false ~padding: 2 box#box in
- box
- | Filename_param p ->
- let box = new filename_param_box p in
- let _ = main_box#pack ~expand: false ~padding: 2 box#box in
- box
- | List_param f ->
- let box = f () in
- let _ = main_box#pack ~expand: true ~padding: 2 box#box in
- box
- | Custom_param p ->
- let box = new custom_param_box p 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 in
- let _ = main_box#pack ~expand: false ~padding: 2 box#box in
- box
- | Font_param p ->
- let box = new font_param_box p in
- let _ = main_box#pack ~expand: false ~padding: 2 box#box in
- box
- | Date_param p ->
- let box = new date_param_box p in
- let _ = main_box#pack ~expand: false ~padding: 2 box#box in
- box
- | Hotkey_param p ->
- let box = new hotkey_param_box p 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 in
- let _ = main_box#pack ~expand: p.string_expand ~padding: 2 box#box in
- box
+ 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
+ let wnote = GPack.notebook
(*homogeneous_tabs: true*)
~scrollable: true
~show_tabs: true
@@ -980,15 +1006,15 @@ class configuration_box conf_struct (notebook : GPack.notebook) =
in
(* we create all the children boxes *)
let f structure =
- let new_box = new configuration_box structure wnote in
+ 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)
-
+
in
let page_label = GMisc.label ~text: label () in
- let _ = notebook#append_page
+ let _ = notebook#append_page
~tab_label: page_label#coerce
main_box#coerce
in
@@ -1008,9 +1034,9 @@ class configuration_box conf_struct (notebook : GPack.notebook) =
Before calling the callback of a button, the [apply] function
of each parameter is called.
*)
-let tabbed_box conf_struct_list buttons =
+let tabbed_box conf_struct_list buttons tooltips =
let vbox = GPack.vbox () in
- let wnote = GPack.notebook
+ let wnote = GPack.notebook
(*homogeneous_tabs: true*)
~scrollable: true
~show_tabs: true
@@ -1018,18 +1044,19 @@ let tabbed_box conf_struct_list buttons =
~packing: (vbox#pack ~expand: true)
()
in
- let list_param_box =
- List.map (fun conf_struct -> new configuration_box conf_struct wnote)
+ let list_param_box =
+ List.map
+ (fun conf_struct -> new configuration_box tooltips conf_struct wnote)
conf_struct_list
in
- let f_apply () =
+ 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 rec iter_buttons ?(grab=false) = function
[] ->
()
- | (label, callb) :: q ->
+ | (label, callb) :: q ->
let b = GButton.button ~label: label
~packing:(hbox_buttons#pack ~expand:true ~fill: true ~padding:4) ()
in
@@ -1046,127 +1073,110 @@ let tabbed_box conf_struct_list buttons =
(** This function takes a configuration structure list and creates a window
to configure the various parameters. *)
-let edit ?(with_apply=true)
+let edit ?(with_apply=true)
?(apply=(fun () -> ()))
- title ?(width=400) ?(height=400)
+ title ?(width=400) ?(height=400)
conf_struct_list =
- let return = ref Return_cancel in
- let window = GWindow.window
- ~position:`CENTER
- ~modal: true ~title: title
- ~width: width ~height: height ()
- in
- let _ = window#connect#destroy ~callback: GMain.Main.quit in
- let vbox = GPack.vbox ~packing: window#add () in
- let wnote = GPack.notebook
- (*homogeneous_tabs: true*)
- ~scrollable: true
- ~show_tabs: true
- ~tab_border: 3
- ~packing: (vbox#pack ~expand: true)
- ()
- in
- let list_param_box =
- List.map (fun conf_struct -> new configuration_box conf_struct wnote)
+ let dialog = GWindow.dialog
+ ~position:`CENTER
+ ~modal: true ~title: title
+ ~height ~width
+ ()
+ 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;
+
+ 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 ()
+ in
+ let f_ok () =
+ List.iter (fun param_box -> param_box#apply) list_param_box ;
+ Return_ok
+ in
+ let destroy () =
+ tooltips#destroy () ;
+ dialog#destroy ();
+ in
+ let rec iter rep =
+ try
+ match dialog#run () with
+ | `APPLY -> f_apply (); iter Return_apply
+ | `OK -> destroy (); f_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
- let hbox_buttons = GPack.hbox ~packing: (vbox#pack ~expand: false ~padding: 4) () in
- let bApply = GButton.button
- ~stock:`APPLY
- ~label: Configwin_messages.mApply
- ()
- in
- if with_apply then hbox_buttons#pack ~expand: true ~padding: 3 bApply#coerce;
- let bOk = GButton.button
- ~stock:`OK
- ~label: Configwin_messages.mOk
- ~packing: (hbox_buttons#pack ~expand: true ~padding: 3)
- ()
- in
- let bCancel = GButton.button
- ~stock:`CANCEL
- ~label: Configwin_messages.mCancel
- ~packing: (hbox_buttons#pack ~expand: true ~padding: 3)
- ()
- in
- (* we connect the click on the apply button *)
- let f_apply () =
- List.iter (fun param_box -> param_box#apply) list_param_box ;
- apply ();
- return := Return_apply
- in
- let _ = bApply#connect#clicked f_apply in
- (* we connect the click on the ok button : the same than apply but we then close the window *)
- let f_ok () =
- List.iter (fun param_box -> param_box#apply) list_param_box ;
- return := Return_ok ;
- window#destroy ()
- in
- let _ = bOk#connect#clicked f_ok in
- (* we connect the click on the cancel button : close the window *)
- let f_cancel () = window#destroy () in
- let _ = bCancel#connect#clicked f_cancel in
-
- let _ = window#event#connect#key_press ~callback:
- (fun k -> if GdkEvent.Key.keyval k = GdkKeysyms._Escape then f_cancel ();false)
- in
- let _ = window#show () in
- GMain.Main.main () ;
- !return
-
-
-(** Create a vbox with the list of given parameters,
- and the given list of buttons (defined by their label and callback).
- Before calling the callback of a button, the [apply] function
- of each parameter is called.
-*)
-let box param_list buttons =
+(** Create a vbox with the list of given parameters. *)
+let box param_list tt =
let main_box = GPack.vbox () in
let f parameter =
match parameter with
String_param p ->
- let box = new string_param_box p in
+ 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 in
+ 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 in
+ 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 in
+ 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 in
+ 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 () in
+ 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 in
+ 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 in
+ 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 in
+ 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 in
+ 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 in
+ let box = new hotkey_param_box p tt in
let _ = main_box#pack ~expand: false ~padding: 2 box#box in
box
| Modifiers_param p ->
@@ -1174,70 +1184,61 @@ let box param_list buttons =
let _ = main_box#pack ~expand: false ~padding: 2 box#box in
box
| Html_param p ->
- let box = new html_param_box p in
+ 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_param_box = List.map f param_list in
- let f_apply () =
- List.iter (fun param_box -> param_box#apply) list_param_box
+ let f_apply () =
+ List.iter (fun param_box -> param_box#apply) list_param_box
in
- let hbox_buttons = GPack.hbox ~packing: (main_box#pack ~expand: false ~padding: 4) () in
- let rec iter_buttons ?(grab=false) = function
- [] ->
- ()
- | (label, callb) :: q ->
- let b = GButton.button ~label: label
- ~packing:(hbox_buttons#pack ~expand:true ~fill: true ~padding:4) ()
- in
- ignore (b#connect#clicked ~callback:
- (fun () -> f_apply (); callb ()));
- (* If it's the first button then give it the focus *)
- if grab then b#grab_default ();
+ (main_box, f_apply)
- iter_buttons q
+(** This function takes a list of parameter specifications and
+ creates a window to configure the various parameters.*)
+let simple_edit ?(with_apply=true)
+ ?(apply=(fun () -> ()))
+ title ?width ?height
+ param_list =
+ let dialog = GWindow.dialog
+ ~modal: true ~title: title
+ ?height ?width
+ ()
in
- iter_buttons ~grab: true buttons;
+ let tooltips = GData.tooltips () in
+ if with_apply then
+ dialog#add_button Configwin_messages.mApply `APPLY;
- main_box
+ dialog#add_button Configwin_messages.mOk `OK;
+ dialog#add_button Configwin_messages.mCancel `CANCEL;
+ let (box, f_apply) = box param_list tooltips in
+ dialog#vbox#pack ~expand: true ~fill: true box#coerce;
-(** This function takes a list of parameter specifications and
- creates a window to configure the various parameters.*)
-let simple_edit ?(with_apply=true)
- ?(apply=(fun () -> ()))
- title ?width ?height
- param_list =
- let return = ref Return_cancel in
- let window = GWindow.window ~modal: true ~title: title () in
- let _ = match width, height with
- None, None -> ()
- | Some w, None -> window#misc#set_size_request ~width: w ()
- | None, Some h -> window#misc#set_size_request ~height: h ()
- | Some w, Some h -> window#misc#set_size_request ~width: w ~height: h ()
- in
- let _ = window#connect#destroy ~callback: GMain.Main.quit in
- let buttons =
- (if with_apply then
- [Configwin_messages.mApply, fun () -> apply (); return := Return_apply]
- else
- []
- ) @ [
- (Configwin_messages.mOk, fun () -> return := Return_ok ; window#destroy ()) ;
- (Configwin_messages.mCancel, window#destroy) ;
- ]
+ let destroy () =
+ tooltips#destroy () ;
+ dialog#destroy ();
in
- let box = box param_list buttons in
- window#add box#coerce;
- let _ = window#show () in
- GMain.Main.main () ;
- !return
+ let rec iter rep =
+ try
+ match dialog#run () with
+ | `APPLY -> f_apply (); 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
+
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
@@ -1248,7 +1249,25 @@ let string ?(editable=true) ?(expand=true) ?help ?(f=(fun _ -> ())) label 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 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 =
@@ -1263,14 +1282,14 @@ let bool ?(editable=true) ?help ?(f=(fun _ -> ())) label v =
(** Create a list param. *)
let list ?(editable=true) ?help
- ?(f=(fun (_:'a list) -> ()))
+ ?(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 () ->
+ (fun tt ->
Obj.magic
(new list_param_box
{
@@ -1285,13 +1304,14 @@ let list ?(editable=true) ?help
list_f_edit = edit ;
list_f_add = add ;
list_f_apply = f ;
- }
+ }
+ tt
)
)
(** Create a strings param. *)
let strings ?(editable=true) ?help
- ?(f=(fun _ -> ()))
+ ?(f=(fun _ -> ()))
?(eq=Pervasives.(=))
?(add=(fun () -> [])) label v =
list ~editable ?help ~f ~eq ~edit: (edit_string label) ~add label (fun s -> [s]) v
@@ -1321,8 +1341,8 @@ let font ?(editable=true) ?(expand=true) ?help ?(f=(fun _ -> ())) label v =
}
(** Create a combo param. *)
-let combo ?(editable=true) ?(expand=true) ?help ?(f=(fun _ -> ()))
- ?(new_allowed=false)
+let combo ?(editable=true) ?(expand=true) ?help ?(f=(fun _ -> ()))
+ ?(new_allowed=false)
?(blank_allowed=false) label choices v =
Combo_param
{
@@ -1338,7 +1358,7 @@ let combo ?(editable=true) ?(expand=true) ?help ?(f=(fun _ -> ()))
}
(** Create a text param. *)
-let text ?(editable=true) ?(expand=true) ?help ?(f=(fun _ -> ())) label v =
+let text ?(editable=true) ?(expand=true) ?help ?(f=(fun _ -> ())) label v =
Text_param
{
string_label = label ;
@@ -1347,10 +1367,28 @@ let text ?(editable=true) ?(expand=true) ?help ?(f=(fun _ -> ())) label 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 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 =
+let html ?(editable=true) ?(expand=true) ?help ?(f=(fun _ -> ())) label v =
Html_param
{
string_label = label ;
@@ -1359,10 +1397,12 @@ let html ?(editable=true) ?(expand=true) ?help ?(f=(fun _ -> ())) label 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 filename param. *)
-let filename ?(editable=true) ?(expand=true)?help ?(f=(fun _ -> ())) label v =
+let filename ?(editable=true) ?(expand=true)?help ?(f=(fun _ -> ())) label v =
Filename_param
{
string_label = label ;
@@ -1371,17 +1411,19 @@ let filename ?(editable=true) ?(expand=true)?help ?(f=(fun _ -> ())) label 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 filenames param.*)
-let filenames ?(editable=true) ?help ?(f=(fun _ -> ()))
+let filenames ?(editable=true) ?help ?(f=(fun _ -> ()))
?(eq=Pervasives.(=))
label v =
let add () = select_files label in
- list ~editable ?help ~f ~eq ~add label (fun s -> [s]) v
+ list ~editable ?help ~f ~eq ~add label (fun s -> [Glib.Convert.locale_to_utf8 s]) v
(** Create a date param. *)
-let date ?(editable=true) ?(expand=true) ?help ?(f=(fun _ -> ()))
+let date ?(editable=true) ?(expand=true) ?help ?(f=(fun _ -> ()))
?(f_string=(fun(d,m,y)-> Printf.sprintf "%d/%d/%d" y (m+1) d))
label v =
Date_param
@@ -1393,7 +1435,7 @@ let date ?(editable=true) ?(expand=true) ?help ?(f=(fun _ -> ()))
date_f_string = f_string ;
date_f_apply = f ;
date_expand = expand ;
- }
+ }
(** Create a hot key param. *)
let hotkey ?(editable=true) ?(expand=true) ?help ?(f=(fun _ -> ())) label v =
@@ -1405,7 +1447,7 @@ let hotkey ?(editable=true) ?(expand=true) ?help ?(f=(fun _ -> ())) label v =
hk_editable = editable ;
hk_f_apply = f ;
hk_expand = expand ;
- }
+ }
let modifiers
?(editable=true)
@@ -1432,4 +1474,4 @@ let custom ?label box f expand =
custom_f_apply = f ;
custom_expand = expand ;
custom_framed = label ;
- }
+ }
generated by cgit v1.2.3 (git 2.39.1) at 2024-05-18 14:06:56 +0000