helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/applications/radtest/property.ml

   1 (* $Id$ *)
   2
   3 open Gtk
   4 open GObj
   5 open GEdit
   6 open GData
   7 open GPack
   8 open GMisc
   9 open GWindow
  10
  11 open Common
  12 open Utils
  13
  14 (* external id : 'a -> 'a = "%identity" *)
  15
  16 class virtual vprop ~name ~init ~set =
  17   object (self)
  18     val mutable s : string = init
  19     val name : string = name
  20     method private virtual parse : string -> 'a
  21     method get = s
  22     method set s' =
  23       if s' <> s then begin
  24         let v = self#parse s' in
  25         if (set v) then begin
  26           add_undo (Property ((self :> prop), s));
  27           s <- s'
  28         end
  29       end
  30     method modified = s <> init
  31     method name = name
  32     method code = s
  33     method virtual range : range
  34     method save_code = self#code
  35   end
  36
  37 let invalid_prop kind name s =
  38   invalid_arg (Printf.sprintf "Property.%s(%s) <- %s" kind name s)
  39
  40 class prop_enum ~values ~name ~init ~set =
  41   object (self)
  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)
  47   end
  48
  49 (* used for radio_button groups; there is nothing to do
  50   in radtest when setting a radio_button group, only when writing
  51   code or saving *)
  52 class prop_enum_dyn ~values ~name ~init ~set =
  53   object (self)
  54     inherit vprop ~name ~init ~set
  55     method private parse s = ()
  56     method range = Enum (values ())
  57   end
  58
  59 let bool_values =
  60   [ "true", true; "false", false ]
  61
  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 ]
  65
  66 let policy_type_values : (string * Tags.policy_type) list =
  67   [ "ALWAYS", `ALWAYS; "AUTOMATIC", `AUTOMATIC ]
  68
  69 let orientation_values : (string * Tags.orientation) list =
  70   [ "HORIZONTAL", `HORIZONTAL; "VERTICAL", `VERTICAL ]
  71
  72 let toolbar_style_values : (string * Tags.toolbar_style) list =
  73   [ "ICONS", `ICONS; "TEXT", `TEXT; "BOTH", `BOTH ]
  74
  75 let toolbar_space_style_values : (string * [`EMPTY | `LINE]) list =
  76   [ "EMPTY", `EMPTY; "LINE", `LINE ]
  77
  78 let relief_style_values : (string * Tags.relief_style) list =
  79   [ "NORMAL", `NORMAL; "HALF", `HALF; "NONE", `NONE ]
  80
  81 let position_values : (string * Tags.position) list =
  82   [ "LEFT", `LEFT; "RIGHT", `RIGHT; "TOP", `TOP; "BOTTOM", `BOTTOM ]
  83
  84 let combo_use_arrows_values : (string * [ `NEVER | `DEFAULT | `ALWAYS ]) list =
  85 [ "NEVER", `NEVER; "DEFAULT", `DEFAULT; "ALWAYS", `ALWAYS ]
  86
  87 let spin_button_update_policy_values :
  88     (string * Tags. spin_button_update_policy) list =
  89   [ "ALWAYS", `ALWAYS; "IF_VALID", `IF_VALID ]
  90
  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 ]
  94
  95 let update_type_values : (string * Tags.update_type) list =
  96   [ "CONTINUOUS", `CONTINUOUS; "DISCONTINUOUS", `DISCONTINUOUS;
  97     "DELAYED", `DELAYED ]
  98
  99
 100 class prop_bool = prop_enum ~values:bool_values
 101
 102 (*
 103 class prop_variant ~values ~name ~init ~set : prop =
 104   object
 105     inherit prop_enum ~values ~name ~init ~set
 106     method code = "`" ^ s
 107   end
 108 *)
 109
 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
 122
 123 class prop_int ~name ~init ~set : prop =
 124   object
 125     inherit vprop ~name ~init ~set
 126     method private parse s =
 127       try int_of_string s with _ -> invalid_prop "int" name s
 128     method range = Int
 129   end
 130
 131 (* NB: float_of_string doesn't raise an exception in case of error *)
 132 class prop_float ~name ~init ~min ~max ~set : prop =
 133   object
 134     inherit vprop ~name ~init ~set
 135     method private parse s =
 136       try float_of_string s with _ -> invalid_prop "float" name s
 137     method code =
 138       if String.contains s '.' || String.contains s 'e' then s
 139       else s ^ ".0"
 140     method range = Float(min,max)
 141   end
 142
 143 class prop_string ~name ~init ~set : prop =
 144   object
 145     inherit vprop ~name ~init ~set
 146     method private parse s = s
 147     method range = String
 148     method code = "\"" ^ String.escaped s ^ "\""
 149   end
 150
 151 class prop_adjustment ~name ~init ~set : prop =
 152   object
 153     inherit vprop ~name ~init ~set
 154     method private parse = get5floats_from_string
 155     method range = Adjust
 156   end
 157
 158 class prop_clist_titles ~name ~init ~set : prop =
 159   object
 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 ^ "\""
 166   end
 167
 168 class prop_file ~name ~init ~set : prop =
 169   object
 170     inherit vprop ~name ~init ~set
 171     method private parse s = s
 172     method range = File
 173     method code = "\"" ^ String.escaped s ^ "\""
 174   end
 175