14 (* external id : 'a -> 'a = "%identity" *)
16 class virtual vprop ~name ~init ~set =
18 val mutable s : string = init
19 val name : string = name
20 method private virtual parse : string -> 'a
24 let v = self#parse s' in
26 add_undo (Property ((self :> prop), s));
30 method modified = s <> init
33 method virtual range : range
34 method save_code = self#code
37 let invalid_prop kind name s =
38 invalid_arg (Printf.sprintf "Property.%s(%s) <- %s" kind name s)
40 class prop_enum ~values ~name ~init ~set =
42 inherit vprop ~name ~init ~set
43 method private parse s =
44 try List.assoc s values
45 with Not_found -> invalid_prop "enum" name s
46 method range = Enum (List.map ~f:fst values)
49 (* used for radio_button groups; there is nothing to do
50 in radtest when setting a radio_button group, only when writing
52 class prop_enum_dyn ~values ~name ~init ~set =
54 inherit vprop ~name ~init ~set
55 method private parse s = ()
56 method range = Enum (values ())
60 [ "true", true; "false", false ]
62 let shadow_type_values : (string * Tags.shadow_type) list =
63 [ "NONE", `NONE; "IN", `IN; "OUT", `OUT;
64 "ETCHED_IN", `ETCHED_IN; "ETCHED_OUT", `ETCHED_OUT ]
66 let policy_type_values : (string * Tags.policy_type) list =
67 [ "ALWAYS", `ALWAYS; "AUTOMATIC", `AUTOMATIC ]
69 let orientation_values : (string * Tags.orientation) list =
70 [ "HORIZONTAL", `HORIZONTAL; "VERTICAL", `VERTICAL ]
72 let toolbar_style_values : (string * Tags.toolbar_style) list =
73 [ "ICONS", `ICONS; "TEXT", `TEXT; "BOTH", `BOTH ]
75 let toolbar_space_style_values : (string * [`EMPTY | `LINE]) list =
76 [ "EMPTY", `EMPTY; "LINE", `LINE ]
78 let relief_style_values : (string * Tags.relief_style) list =
79 [ "NORMAL", `NORMAL; "HALF", `HALF; "NONE", `NONE ]
81 let position_values : (string * Tags.position) list =
82 [ "LEFT", `LEFT; "RIGHT", `RIGHT; "TOP", `TOP; "BOTTOM", `BOTTOM ]
84 let combo_use_arrows_values : (string * [ `NEVER | `DEFAULT | `ALWAYS ]) list =
85 [ "NEVER", `NEVER; "DEFAULT", `DEFAULT; "ALWAYS", `ALWAYS ]
87 let spin_button_update_policy_values :
88 (string * Tags. spin_button_update_policy) list =
89 [ "ALWAYS", `ALWAYS; "IF_VALID", `IF_VALID ]
91 let button_box_style_values : (string * Tags.button_box_style) list =
92 [ "DEFAULT_STYLE", `DEFAULT_STYLE; "SPREAD", `SPREAD; "EDGE", `EDGE;
93 "START", `START; "END", `END ]
95 let update_type_values : (string * Tags.update_type) list =
96 [ "CONTINUOUS", `CONTINUOUS; "DISCONTINUOUS", `DISCONTINUOUS;
100 class prop_bool = prop_enum ~values:bool_values
103 class prop_variant ~values ~name ~init ~set : prop =
105 inherit prop_enum ~values ~name ~init ~set
106 method code = "`" ^ s
110 class prop_shadow = prop_enum ~values:shadow_type_values
111 class prop_policy = prop_enum ~values:policy_type_values
112 class prop_orientation = prop_enum ~values:orientation_values
113 class prop_toolbar_style = prop_enum ~values:toolbar_style_values
114 class prop_toolbar_space_style = prop_enum ~values:toolbar_space_style_values
115 class prop_relief_style = prop_enum ~values:relief_style_values
116 class prop_position = prop_enum ~values:position_values
117 class prop_combo_use_arrows = prop_enum ~values:combo_use_arrows_values
118 class prop_spin_button_update_policy = prop_enum
119 ~values:spin_button_update_policy_values
120 class prop_button_box_style = prop_enum ~values:button_box_style_values
121 class prop_update_type = prop_enum ~values:update_type_values
123 class prop_int ~name ~init ~set : prop =
125 inherit vprop ~name ~init ~set
126 method private parse s =
127 try int_of_string s with _ -> invalid_prop "int" name s
131 (* NB: float_of_string doesn't raise an exception in case of error *)
132 class prop_float ~name ~init ~min ~max ~set : prop =
134 inherit vprop ~name ~init ~set
135 method private parse s =
136 try float_of_string s with _ -> invalid_prop "float" name s
138 if String.contains s '.' || String.contains s 'e' then s
140 method range = Float(min,max)
143 class prop_string ~name ~init ~set : prop =
145 inherit vprop ~name ~init ~set
146 method private parse s = s
147 method range = String
148 method code = "\"" ^ String.escaped s ^ "\""
151 class prop_adjustment ~name ~init ~set : prop =
153 inherit vprop ~name ~init ~set
154 method private parse = get5floats_from_string
155 method range = Adjust
158 class prop_clist_titles ~name ~init ~set : prop =
160 inherit vprop ~name ~init ~set
161 method private parse = split_string ~sep:' '
162 method range = CList_titles
163 method code = "[ \"" ^
164 String.concat ~sep:"\"; \"" (split_string ~sep:' ' s) ^ "\" ]"
165 method save_code = "\"" ^ s ^ "\""
168 class prop_file ~name ~init ~set : prop =
170 inherit vprop ~name ~init ~set
171 method private parse s = s
173 method code = "\"" ^ String.escaped s ^ "\""