summaryrefslogtreecommitdiff
path: root/ide/utils/configwin_types.ml
diff options
context:
space:
mode:
Diffstat (limited to 'ide/utils/configwin_types.ml')
-rw-r--r--ide/utils/configwin_types.ml309
1 files changed, 158 insertions, 151 deletions
diff --git a/ide/utils/configwin_types.ml b/ide/utils/configwin_types.ml
index ee8ec70c..0def0b25 100644
--- a/ide/utils/configwin_types.ml
+++ b/ide/utils/configwin_types.ml
@@ -1,140 +1,148 @@
-(**************************************************************************)
-(* 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 *)
-(**************************************************************************)
+(*********************************************************************************)
+(* 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 types used in Configwin. *)
-open Uoptions
+open Config_file
-(** A module to define key options, with the {!Uoptions} module. *)
-module KeyOption = struct
- let name_to_keysym =
- ("Button1", Configwin_keys.xk_Pointer_Button1) ::
- ("Button2", Configwin_keys.xk_Pointer_Button2) ::
- ("Button3", Configwin_keys.xk_Pointer_Button3) ::
- ("Button4", Configwin_keys.xk_Pointer_Button4) ::
- ("Button5", Configwin_keys.xk_Pointer_Button5) ::
- Configwin_keys.name_to_keysym
-
- let string_to_key s =
- let mask = ref [] in
- let key = try
- let pos = String.rindex s '-' in
- for i = 0 to pos - 1 do
- let m = match s.[i] with
- 'C' -> `CONTROL
- | 'S' -> `SHIFT
- | 'L' -> `LOCK
- | 'M' -> `MOD1
- | 'A' -> `MOD1
- | '1' -> `MOD1
- | '2' -> `MOD2
- | '3' -> `MOD3
- | '4' -> `MOD4
- | '5' -> `MOD5
- | _ ->
- prerr_endline s;
- raise Not_found
- in
- mask := m :: !mask
- done;
- String.sub s (pos+1) (String.length s - pos - 1)
- with _ ->
- s
- in
- try
- !mask, List.assoc key name_to_keysym
- with
- e ->
- prerr_endline s;
- raise e
-
- let key_to_string (m, k) =
- let s = List.assoc k Configwin_keys.keysym_to_name in
- match m with
- [] -> s
- | _ ->
- let rec iter m s =
- match m with
- [] -> s
- | c :: m ->
- iter m ((
- match c with
- `CONTROL -> "C"
- | `SHIFT -> "S"
- | `LOCK -> "L"
- | `MOD1 -> "A"
- | `MOD2 -> "2"
- | `MOD3 -> "3"
- | `MOD4 -> "4"
- | `MOD5 -> "5"
- | _ -> raise Not_found
- ) ^ s)
- in
- iter m ("-" ^ s)
+let name_to_keysym =
+ ("Button1", Configwin_keys.xk_Pointer_Button1) ::
+ ("Button2", Configwin_keys.xk_Pointer_Button2) ::
+ ("Button3", Configwin_keys.xk_Pointer_Button3) ::
+ ("Button4", Configwin_keys.xk_Pointer_Button4) ::
+ ("Button5", Configwin_keys.xk_Pointer_Button5) ::
+ Configwin_keys.name_to_keysym
+
+let string_to_key s =
+ let mask = ref [] in
+ let key = try
+ let pos = String.rindex s '-' in
+ for i = 0 to pos - 1 do
+ let m = match s.[i] with
+ 'C' -> `CONTROL
+ | 'S' -> `SHIFT
+ | 'L' -> `LOCK
+ | 'M' -> `MOD1
+ | 'A' -> `MOD1
+ | '1' -> `MOD1
+ | '2' -> `MOD2
+ | '3' -> `MOD3
+ | '4' -> `MOD4
+ | '5' -> `MOD5
+ | _ ->
+ prerr_endline s;
+ raise Not_found
+ in
+ mask := m :: !mask
+ done;
+ String.sub s (pos+1) (String.length s - pos - 1)
+ with _ ->
+ s
+ in
+ try
+ !mask, List.assoc key name_to_keysym
+ with
+ e ->
+ prerr_endline s;
+ raise e
- let modifiers_to_string m =
- let rec iter m s =
- match m with
+let key_to_string (m, k) =
+ let s = List.assoc k Configwin_keys.keysym_to_name in
+ match m with
+ [] -> s
+ | _ ->
+ 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
+ match c with
+ `CONTROL -> "C"
+ | `SHIFT -> "S"
+ | `LOCK -> "L"
+ | `MOD1 -> "A"
+ | `MOD2 -> "2"
+ | `MOD3 -> "3"
+ | `MOD4 -> "4"
+ | `MOD5 -> "5"
+ | _ -> raise Not_found
+ ) ^ s)
+ in
+ iter m ("-" ^ s)
+
+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 ""
-
- let value_to_key v =
- match v with
- StringValue s -> string_to_key s
- | _ ->
- prerr_endline "value_to_key";
- raise Not_found
-
- let key_to_value k =
- StringValue (key_to_string k)
- let (t : (Gdk.Tags.modifier list * int) option_class) =
- define_option_class "Key" value_to_key key_to_value
-end
+let value_to_key v =
+ match v with
+ Raw.String s -> string_to_key s
+ | _ ->
+ prerr_endline "value_to_key";
+ raise Not_found
+
+let key_to_value k =
+ Raw.String (key_to_string k)
+
+let key_cp_wrapper =
+ {
+ to_raw = key_to_value ;
+ of_raw = value_to_key ;
+ }
-(** This type represents a string or filename parameter. *)
-type string_param = {
+(** A class to define key options, with the {!Config_file} module. *)
+class key_cp =
+ [(Gdk.Tags.modifier list * int)] Config_file.cp_custom_type key_cp_wrapper
+
+(** This type represents a string or filename parameter, or
+ any other type, depending on the given conversion functions. *)
+type 'a string_param = {
string_label : string; (** the label of the parameter *)
- mutable string_value : string; (** the current value of the parameter *)
+ mutable string_value : 'a; (** the current value of the parameter *)
string_editable : bool ; (** indicates if the value can be changed *)
- string_f_apply : (string -> unit) ; (** the function to call to apply the new value of the parameter *)
+ string_f_apply : ('a -> unit) ; (** the function to call to apply the new value of the parameter *)
string_help : string option ; (** optional help string *)
string_expand : bool ; (** expand or not *)
+ string_to_string : 'a -> string ;
+ string_of_string : string -> 'a ;
} ;;
(** This type represents a boolean parameter. *)
@@ -214,14 +222,14 @@ type font_param = {
type hotkey_param = {
hk_label : string ; (** the label of the parameter *)
- mutable hk_value : (Gdk.Tags.modifier list * int) ;
+ mutable hk_value : (Gdk.Tags.modifier list * int) ;
(** The value, as a list of modifiers and a key code *)
hk_editable : bool ; (** indicates if the value can be changed *)
hk_f_apply : ((Gdk.Tags.modifier list * int) -> unit) ;
(** the function to call to apply the new value of the paramter *)
hk_help : string option ; (** optional help string *)
hk_expand : bool ; (** expand or not *)
- }
+ }
type modifiers_param = {
md_label : string ; (** the label of the parameter *)
@@ -235,13 +243,18 @@ type modifiers_param = {
md_allow : Gdk.Tags.modifier list
}
+
+let mk_custom_text_string_param (a : 'a string_param) : string string_param =
+ Obj.magic a
+
+
(** This type represents the different kinds of parameters. *)
type parameter_kind =
- String_param of string_param
- | List_param of (unit -> <box: GObj.widget ; apply : unit>)
- | Filename_param of string_param
+ String_param of string string_param
+ | List_param of (GData.tooltips -> <box: GObj.widget ; apply : unit>)
+ | Filename_param of string string_param
| Bool_param of bool_param
- | Text_param of string_param
+ | Text_param of string string_param
| Combo_param of combo_param
| Custom_param of custom_param
| Color_param of color_param
@@ -249,7 +262,7 @@ type parameter_kind =
| Font_param of font_param
| Hotkey_param of hotkey_param
| Modifiers_param of modifiers_param
- | Html_param of string_param
+ | Html_param of string string_param
;;
(** This type represents the structure of the configuration window. *)
@@ -273,27 +286,21 @@ type html_binding = {
mutable html_key : (Gdk.Tags.modifier list * int) ;
mutable html_begin : string ;
mutable html_end : string ;
- }
-
-module Html_binding = struct
- let value_to_hb v =
- match v with
- List [StringValue hk ; StringValue debut; StringValue fin ]
- | SmallList [StringValue hk ; StringValue debut; StringValue fin ] ->
- { html_key = KeyOption.string_to_key hk ;
- html_begin = debut ;
- html_end = fin ;
- }
- | _ ->
- prerr_endline "Html_binding.value_to_hb";
- raise Not_found
+ }
- let hb_to_value hb =
- SmallList [ StringValue (KeyOption.key_to_string hb.html_key) ;
- StringValue hb.html_begin ;
- StringValue hb.html_end ;
- ]
+let htmlbinding_cp_wrapper =
+ let w = Config_file.tuple3_wrappers
+ key_cp_wrapper
+ Config_file.string_wrappers
+ Config_file.string_wrappers
+ in
+ {
+ to_raw = (fun v -> w.to_raw (v.html_key, v.html_begin, v.html_end)) ;
+ of_raw =
+ (fun r -> let (k,b,e) = w.of_raw r in
+ { html_key = k ; html_begin = b ; html_end = e }
+ ) ;
+ }
- let (t : html_binding option_class) =
- define_option_class "html_binding" value_to_hb hb_to_value
-end
+class htmlbinding_cp =
+ [html_binding] Config_file.option_cp htmlbinding_cp_wrapper
generated by cgit v1.2.3 (git 2.39.1) at 2024-05-18 16:01:24 +0000