helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/applications/radtest/tiEdit.ml

   1 open Utils
   2 open Property
   3
   4 open TiBase
   5
   6
   7
   8 class tientry ~(widget : GEdit.entry) ~name ~parent_tree ~pos
   9     ?(insert_evbox=true) parent_window =
  10 object
  11   val entry = widget
  12   inherit tiwidget ~name ~widget ~parent_tree ~pos
  13       ~insert_evbox parent_window
  14
  15   method private class_name = "GEdit.entry"
  16   initializer
  17     classe <- "entry";
  18       proplist <- proplist @
  19       [ "visibility",
  20         new prop_bool ~name:"visibility" ~init:"true"
  21                      ~set:(ftrue entry#set_visibility);
  22         "editable",
  23         new prop_bool ~name:"editable" ~init:"true"
  24                      ~set:(ftrue entry#set_editable)
  25       ]
  26 end
  27
  28 let new_tientry ~name ?(listprop = []) =
  29   new tientry ~name ~widget:(GEdit.entry ())
  30
  31
  32 class tispin_button ~(widget : GEdit.spin_button) ~name ~parent_tree ~pos
  33     ?(insert_evbox=true) parent_window =
  34 object
  35     val spin_button = widget
  36   inherit tientry ~widget:(widget :> GEdit.entry) ~name ~parent_tree ~pos
  37       ~insert_evbox parent_window
  38
  39   method private class_name = "GEdit.spin_button"
  40   initializer
  41     classe <- "spin_button";
  42       proplist <- proplist @
  43       [ "digits",
  44         new prop_int ~name:"digits" ~init:"0"
  45                      ~set:(ftrue spin_button#set_digits);
  46         "update_policy",
  47         new prop_spin_button_update_policy ~name:"update_policy"
  48           ~init:"ALWAYS"
  49           ~set:(ftrue spin_button#set_update_policy);
  50         "numeric",
  51         new prop_bool ~name:"numeric" ~init:"false"
  52           ~set:(ftrue spin_button#set_numeric);
  53         "wrap",
  54         new prop_bool ~name:"wrap" ~init:"false"
  55           ~set:(ftrue spin_button#set_wrap);
  56         "shadow_type",
  57         new prop_shadow ~name:"shadow_type" ~init:"NONE"
  58           ~set:(ftrue spin_button#set_shadow_type);
  59         "snap_to_ticks",
  60         new prop_bool ~name:"snap_to_ticks" ~init:"false"
  61           ~set:(ftrue spin_button#set_snap_to_ticks)
  62       ]
  63
  64 end
  65
  66
  67 let get_adjustment () =
  68   let rv = ref 0. and rl = ref 0. and ru = ref 100. and rsi = ref 1.
  69       and rpi = ref 10. and rps = ref 10. in
  70   let w  = GWindow.window ~modal:true () in
  71   let v  = GPack.vbox  ~packing:w#add () in
  72   let l  = GMisc.label ~text:"adjustment properties" ~packing:v#pack () in
  73   let h1 = GPack.hbox ~packing:v#pack () in
  74   let l1 = GMisc.label ~text:"value" ~packing:h1#pack () in
  75   let e1 = GEdit.entry ~text:"0." ~packing:h1#pack () in
  76   let h2 = GPack.hbox ~packing:v#pack () in
  77   let l2 = GMisc.label ~text:"lower" ~packing:h2#pack () in
  78   let e2 = GEdit.entry ~text:"0." ~packing:h2#pack () in
  79   let h3 = GPack.hbox ~packing:v#pack () in
  80   let l3 = GMisc.label ~text:"upper" ~packing:h3#pack () in
  81   let e3 = GEdit.entry ~text:"100." ~packing:h3#pack () in
  82   let h4 = GPack.hbox ~packing:v#pack () in
  83   let l4 = GMisc.label ~text:"step_incr" ~packing:h4#pack () in
  84   let e4 = GEdit.entry ~text:"1." ~packing:h4#pack () in
  85   let h5 = GPack.hbox ~packing:v#pack () in
  86   let l5 = GMisc.label ~text:"page_incr" ~packing:h5#pack () in
  87   let e5 = GEdit.entry ~text:"10." ~packing:h5#pack () in
  88   let h6 = GPack.hbox ~packing:v#pack () in
  89   let l6 = GMisc.label ~text:"page_size" ~packing:h6#pack () in
  90   let e6 = GEdit.entry ~text:"10." ~packing:h6#pack () in
  91   let h7 = GPack.hbox ~packing:v#pack () in
  92   let b1 = GButton.button ~label:"OK" ~packing:h7#pack () in
  93   let b2 = GButton.button ~label:"Cancel" ~packing:h7#pack () in
  94   w#show ();
  95   b1#connect#clicked
  96     ~callback:(fun () ->
  97       begin
  98         try rv  := float_of_string e1#text with _ ->
  99         try rv  := float_of_int (int_of_string e1#text) with _ -> () end;
 100       begin
 101         try rl  := float_of_string e2#text with _ ->
 102         try rl  := float_of_int (int_of_string e2#text) with _ -> () end;
 103       begin
 104         try ru  := float_of_string e3#text with _ ->
 105         try ru  := float_of_int (int_of_string e3#text) with _ -> () end;
 106       begin
 107         try rsi := float_of_string e4#text with _ ->
 108         try rsi := float_of_int (int_of_string e4#text) with _ -> () end;
 109       begin
 110         try rpi := float_of_string e5#text with _ ->
 111         try rpi := float_of_int (int_of_string e5#text) with _ -> () end;
 112       begin
 113         try rps := float_of_string e6#text with _ ->
 114         try rps := float_of_int (int_of_string e6#text) with _ -> () end;
 115       w#destroy ());
 116   b2#connect#clicked ~callback:w#destroy;
 117   w#connect#destroy ~callback:GMain.Main.quit;
 118   GMain.Main.main ();
 119   !rv, !rl, !ru, !rsi, !rpi, !rps
 120
 121 let new_tispin_button ~name ?(listprop = []) =
 122   let v, l, u, si, pi, ps = get_adjustment () in
 123   new tispin_button ~name
 124     ~widget:(GEdit.spin_button ~adjustment:
 125                (GData.adjustment ~value:v ~lower:l ~upper:u
 126                   ~step_incr:si ~page_incr:pi ~page_size:ps ()) ())
 127
 128
 129
 130 class ticombo ~(widget : GEdit.combo) ~name ~parent_tree ~pos
 131     ?(insert_evbox=true) parent_window =
 132 object
 133   val combo = widget
 134   inherit tiwidget ~name ~widget ~parent_tree ~pos
 135       ~insert_evbox parent_window
 136
 137   method private class_name = "GEdit.combo"
 138   initializer
 139     classe <- "combo";
 140       proplist <- proplist @
 141       [ "use_arrows",
 142         new prop_combo_use_arrows ~name:"use_arrows" ~init:"true"
 143                      ~set:(ftrue combo#set_use_arrows);
 144         "case_sensitive",
 145         new prop_bool ~name:"case_sensitive" ~init:"false"
 146                      ~set:(ftrue combo#set_case_sensitive)
 147       ]
 148 end
 149
 150 let new_ticombo ~name ?(listprop = []) =
 151   new ticombo ~name ~widget:(GEdit.combo ())
 152
 153