8 class type tiwidget_base = object
10 method proplist : (string * prop) list
13 let prop_widget (prop : prop) =
16 let w = GEdit.combo ~popdown_strings:l ~use_arrows:`ALWAYS () in
17 w#entry#connect#changed ~callback:(fun () -> prop#set w#entry#text);
18 w#entry#set_editable false;
19 w#entry#set_text prop#get;
22 let w = GEdit.entry ~text:prop#get () in
23 w#connect#activate ~callback:(fun () -> prop#set w#text);
26 let w = GPack.hbox () in
27 let e = GEdit.entry ~text:prop#get ~editable:false ~packing:w#pack () in
28 let b = GButton.button ~label:"..." ~packing:w#pack () in
30 ~callback:(fun () -> get_filename
31 ~callback:(fun name -> e#set_text name; prop#set name) (); ());
35 GData.adjustment ~value:(float_of_string prop#get)
36 ~lower:(-2.) ~upper:5000. ~step_incr:1. ~page_incr:10. ~page_size:0. ()
38 let w = GEdit.spin_button ~rate:0.5 ~digits:0 ~adjustment () in
40 ~callback:(fun () -> prop#set (string_of_int w#value_as_int));
42 | Float (lower, upper) ->
44 GData.adjustment ~value:(float_of_string prop#get)
45 ~lower ~upper ~step_incr:((upper-.lower)/.100.)
46 ~page_incr:((upper-.lower)/.10.) ~page_size:0. ()
48 let w = GEdit.spin_button ~rate:0.5 ~digits:2 ~adjustment () in
50 ~callback:(fun () -> prop#set (string_of_float w#value));
53 let w = entry_float ~init:(float_of_string prop#get) () in
55 ~callback:(fun () -> prop#set (string_of_float w#value));
58 let wpop = GWindow.window ~title:"Adjustment values" () in
59 let vb = GPack.vbox ~packing:wpop#add() in
60 let hb1 = GPack.hbox ~packing:vb#pack () in
61 let l1 = GMisc.label ~text:"lower" ~packing:hb1#pack () in
62 let e1 = entry_float ~packing:hb1#pack
63 ~init:(float_of_string prop#get) ~set:prop#set in
66 let wpop = GWindow.window ~title:"titles of the columns" () in
67 let vb = GPack.vbox ~packing:wpop#add () in
68 let titles = split_string prop#get ~sep:' ' in
69 let n = List.length titles in
70 let rtitles = ref titles in
71 let rget = ref [] and rset = ref [] in
75 let hb = GPack.hbox ~packing:vb#pack () in
76 let _ = GMisc.label ~text:("column" ^ (string_of_int i))
77 ~packing:hb#pack () in
78 let e = GEdit.entry ~text:hd ~packing:hb#pack () in
80 rget := (fun () -> e#text) :: !rget;
81 rset := e#set_text :: !rset;
82 | _ -> failwith "CList_titles: this cannot happen!!"
85 rget := List.rev !rget;
86 rset := List.rev !rset;
87 let hb = GPack.hbox ~packing:vb#pack () in
88 let ok = GButton.button ~label:"OK" ~packing:hb#pack () in
89 let cancel = GButton.button ~label:"Cancel" ~packing:hb#pack () in
92 let tit = List.map ~f:(fun f -> f ()) !rget in
93 prop#set (String.concat ~sep:" " tit);
96 cancel#connect#pressed
99 List.iter2 ~f:(fun f v -> f v) !rset !rtitles);
100 let e = GEdit.entry ~text:"double click here" ~editable:false () in
101 e#event#connect#button_press ~callback:
103 GdkEvent.get_type ev = `TWO_BUTTON_PRESS &&
104 GdkEvent.Button.button ev = 1 &&
107 GtkSignal.stop_emit ();
113 let vbox = GPack.vbox () in
115 begin fun (name, prop) ->
117 GPack.hbox ~homogeneous:true ~packing:(vbox#pack ~expand:false) () in
118 GMisc.label ~text:name ~packing:hbox#pack ();
119 hbox#pack ~fill:true (prop_widget prop);
120 GMisc.separator `HORIZONTAL ~packing:(vbox#pack ~expand:false) ();
125 class ['a] frozen lz = object
126 method get : 'a = Lazy.force lz
130 new frozen (lazy (GWindow.window ~show:true ~title:"Properties" ()))
132 let init () = vbox#get
134 let widget_pool = Hashtbl.create 7
136 let boxref = ref None
137 let shown_widget = ref ""
139 let show_prop_box vb =
140 Gaux.may !boxref ~f:vbox#get#remove;
141 vbox#get#add vb#coerce;
142 boxref := Some vb#coerce
144 let show (w : #tiwidget_base) =
148 Hashtbl.find widget_pool name
150 let vb = prop_box w#proplist in
151 Hashtbl.add widget_pool ~key:name ~data:vb;
157 let add (w : #tiwidget_base) =
158 let vb = prop_box w#proplist in
159 Hashtbl.add widget_pool ~key:w#name ~data:vb
163 Hashtbl.remove widget_pool name;
164 if !shown_widget = name then begin
166 show_prop_box (GMisc.label ~text:"No widget selected" ())
170 let change_name oldname newname =
171 let vb = Hashtbl.find widget_pool oldname in
172 Hashtbl.remove widget_pool oldname;
173 Hashtbl.add widget_pool ~key:newname ~data:vb
176 let update (w : #tiwidget_base) show_modif =
177 let vb = prop_box w#proplist in
178 Hashtbl.remove widget_pool w#name;
179 Hashtbl.add widget_pool ~key:w#name ~data:vb;
180 if show_modif && !shown_widget = w#name then show_prop_box vb