+++ /dev/null
-(* $Id$ *)
-
-open Gtk
-open GObj
-open GEdit
-open GData
-open GPack
-open GMisc
-open GWindow
-
-open Common
-open Utils
-
-(* external id : 'a -> 'a = "%identity" *)
-
-class virtual vprop ~name ~init ~set =
- object (self)
- val mutable s : string = init
- val name : string = name
- method private virtual parse : string -> 'a
- method get = s
- method set s' =
- if s' <> s then begin
- let v = self#parse s' in
- if (set v) then begin
- add_undo (Property ((self :> prop), s));
- s <- s'
- end
- end
- method modified = s <> init
- method name = name
- method code = s
- method virtual range : range
- method save_code = self#code
- end
-
-let invalid_prop kind name s =
- invalid_arg (Printf.sprintf "Property.%s(%s) <- %s" kind name s)
-
-class prop_enum ~values ~name ~init ~set =
- object (self)
- inherit vprop ~name ~init ~set
- method private parse s =
- try List.assoc s values
- with Not_found -> invalid_prop "enum" name s
- method range = Enum (List.map ~f:fst values)
- end
-
-(* used for radio_button groups; there is nothing to do
- in radtest when setting a radio_button group, only when writing
- code or saving *)
-class prop_enum_dyn ~values ~name ~init ~set =
- object (self)
- inherit vprop ~name ~init ~set
- method private parse s = ()
- method range = Enum (values ())
- end
-
-let bool_values =
- [ "true", true; "false", false ]
-
-let shadow_type_values : (string * Tags.shadow_type) list =
- [ "NONE", `NONE; "IN", `IN; "OUT", `OUT;
- "ETCHED_IN", `ETCHED_IN; "ETCHED_OUT", `ETCHED_OUT ]
-
-let policy_type_values : (string * Tags.policy_type) list =
- [ "ALWAYS", `ALWAYS; "AUTOMATIC", `AUTOMATIC ]
-
-let orientation_values : (string * Tags.orientation) list =
- [ "HORIZONTAL", `HORIZONTAL; "VERTICAL", `VERTICAL ]
-
-let toolbar_style_values : (string * Tags.toolbar_style) list =
- [ "ICONS", `ICONS; "TEXT", `TEXT; "BOTH", `BOTH ]
-
-let toolbar_space_style_values : (string * [`EMPTY | `LINE]) list =
- [ "EMPTY", `EMPTY; "LINE", `LINE ]
-
-let relief_style_values : (string * Tags.relief_style) list =
- [ "NORMAL", `NORMAL; "HALF", `HALF; "NONE", `NONE ]
-
-let position_values : (string * Tags.position) list =
- [ "LEFT", `LEFT; "RIGHT", `RIGHT; "TOP", `TOP; "BOTTOM", `BOTTOM ]
-
-let combo_use_arrows_values : (string * [ `NEVER | `DEFAULT | `ALWAYS ]) list =
-[ "NEVER", `NEVER; "DEFAULT", `DEFAULT; "ALWAYS", `ALWAYS ]
-
-let spin_button_update_policy_values :
- (string * Tags. spin_button_update_policy) list =
- [ "ALWAYS", `ALWAYS; "IF_VALID", `IF_VALID ]
-
-let button_box_style_values : (string * Tags.button_box_style) list =
- [ "DEFAULT_STYLE", `DEFAULT_STYLE; "SPREAD", `SPREAD; "EDGE", `EDGE;
- "START", `START; "END", `END ]
-
-let update_type_values : (string * Tags.update_type) list =
- [ "CONTINUOUS", `CONTINUOUS; "DISCONTINUOUS", `DISCONTINUOUS;
- "DELAYED", `DELAYED ]
-
-
-class prop_bool = prop_enum ~values:bool_values
-
-(*
-class prop_variant ~values ~name ~init ~set : prop =
- object
- inherit prop_enum ~values ~name ~init ~set
- method code = "`" ^ s
- end
-*)
-
-class prop_shadow = prop_enum ~values:shadow_type_values
-class prop_policy = prop_enum ~values:policy_type_values
-class prop_orientation = prop_enum ~values:orientation_values
-class prop_toolbar_style = prop_enum ~values:toolbar_style_values
-class prop_toolbar_space_style = prop_enum ~values:toolbar_space_style_values
-class prop_relief_style = prop_enum ~values:relief_style_values
-class prop_position = prop_enum ~values:position_values
-class prop_combo_use_arrows = prop_enum ~values:combo_use_arrows_values
-class prop_spin_button_update_policy = prop_enum
- ~values:spin_button_update_policy_values
-class prop_button_box_style = prop_enum ~values:button_box_style_values
-class prop_update_type = prop_enum ~values:update_type_values
-
-class prop_int ~name ~init ~set : prop =
- object
- inherit vprop ~name ~init ~set
- method private parse s =
- try int_of_string s with _ -> invalid_prop "int" name s
- method range = Int
- end
-
-(* NB: float_of_string doesn't raise an exception in case of error *)
-class prop_float ~name ~init ~min ~max ~set : prop =
- object
- inherit vprop ~name ~init ~set
- method private parse s =
- try float_of_string s with _ -> invalid_prop "float" name s
- method code =
- if String.contains s '.' || String.contains s 'e' then s
- else s ^ ".0"
- method range = Float(min,max)
- end
-
-class prop_string ~name ~init ~set : prop =
- object
- inherit vprop ~name ~init ~set
- method private parse s = s
- method range = String
- method code = "\"" ^ String.escaped s ^ "\""
- end
-
-class prop_adjustment ~name ~init ~set : prop =
- object
- inherit vprop ~name ~init ~set
- method private parse = get5floats_from_string
- method range = Adjust
- end
-
-class prop_clist_titles ~name ~init ~set : prop =
- object
- inherit vprop ~name ~init ~set
- method private parse = split_string ~sep:' '
- method range = CList_titles
- method code = "[ \"" ^
- String.concat ~sep:"\"; \"" (split_string ~sep:' ' s) ^ "\" ]"
- method save_code = "\"" ^ s ^ "\""
- end
-
-class prop_file ~name ~init ~set : prop =
- object
- inherit vprop ~name ~init ~set
- method private parse s = s
- method range = File
- method code = "\"" ^ String.escaped s ^ "\""
- end
-
projects / helm.git / blobdiff