--- /dev/null
+(* $Id$ *)
+
+open GObj
+
+open Common
+open Utils
+
+class type tiwidget_base = object
+ method name : string
+ method proplist : (string * prop) list
+end
+
+let prop_widget (prop : prop) =
+ match prop#range with
+ Enum l ->
+ let w = GEdit.combo ~popdown_strings:l ~use_arrows:`ALWAYS () in
+ w#entry#connect#changed ~callback:(fun () -> prop#set w#entry#text);
+ w#entry#set_editable false;
+ w#entry#set_text prop#get;
+ w#coerce
+ | String ->
+ let w = GEdit.entry ~text:prop#get () in
+ w#connect#activate ~callback:(fun () -> prop#set w#text);
+ w#coerce
+ | File ->
+ let w = GPack.hbox () in
+ let e = GEdit.entry ~text:prop#get ~editable:false ~packing:w#pack () in
+ let b = GButton.button ~label:"..." ~packing:w#pack () in
+ b#connect#clicked
+ ~callback:(fun () -> get_filename
+ ~callback:(fun name -> e#set_text name; prop#set name) (); ());
+ w#coerce
+ | Int ->
+ let adjustment =
+ GData.adjustment ~value:(float_of_string prop#get)
+ ~lower:(-2.) ~upper:5000. ~step_incr:1. ~page_incr:10. ~page_size:0. ()
+ in
+ let w = GEdit.spin_button ~rate:0.5 ~digits:0 ~adjustment () in
+ w#connect#activate
+ ~callback:(fun () -> prop#set (string_of_int w#value_as_int));
+ w#coerce
+ | Float (lower, upper) ->
+(* let adjustment =
+ GData.adjustment ~value:(float_of_string prop#get)
+ ~lower ~upper ~step_incr:((upper-.lower)/.100.)
+ ~page_incr:((upper-.lower)/.10.) ~page_size:0. ()
+ in
+ let w = GEdit.spin_button ~rate:0.5 ~digits:2 ~adjustment () in
+ w#connect#activate
+ ~callback:(fun () -> prop#set (string_of_float w#value));
+ w#coerce
+*)
+ let w = entry_float ~init:(float_of_string prop#get) () in
+ w#connect#activate
+ ~callback:(fun () -> prop#set (string_of_float w#value));
+ w#coerce
+(* | Adjust ->
+ let wpop = GWindow.window ~title:"Adjustment values" () in
+ let vb = GPack.vbox ~packing:wpop#add() in
+ let hb1 = GPack.hbox ~packing:vb#pack () in
+ let l1 = GMisc.label ~text:"lower" ~packing:hb1#pack () in
+ let e1 = entry_float ~packing:hb1#pack
+ ~init:(float_of_string prop#get) ~set:prop#set in
+*)
+ | CList_titles ->
+ let wpop = GWindow.window ~title:"titles of the columns" () in
+ let vb = GPack.vbox ~packing:wpop#add () in
+ let titles = split_string prop#get ~sep:' ' in
+ let n = List.length titles in
+ let rtitles = ref titles in
+ let rget = ref [] and rset = ref [] in
+ for i = 1 to n do
+ match !rtitles with
+ | hd::tl ->
+ let hb = GPack.hbox ~packing:vb#pack () in
+ let _ = GMisc.label ~text:("column" ^ (string_of_int i))
+ ~packing:hb#pack () in
+ let e = GEdit.entry ~text:hd ~packing:hb#pack () in
+ rtitles := tl;
+ rget := (fun () -> e#text) :: !rget;
+ rset := e#set_text :: !rset;
+ | _ -> failwith "CList_titles: this cannot happen!!"
+ done;
+ rtitles := titles;
+ rget := List.rev !rget;
+ rset := List.rev !rset;
+ let hb = GPack.hbox ~packing:vb#pack () in
+ let ok = GButton.button ~label:"OK" ~packing:hb#pack () in
+ let cancel = GButton.button ~label:"Cancel" ~packing:hb#pack () in
+ ok#connect#pressed
+ ~callback:(fun () ->
+ let tit = List.map ~f:(fun f -> f ()) !rget in
+ prop#set (String.concat ~sep:" " tit);
+ rtitles := tit;
+ wpop#misc#hide ());
+ cancel#connect#pressed
+ ~callback:(fun () ->
+ wpop#misc#hide ();
+ List.iter2 ~f:(fun f v -> f v) !rset !rtitles);
+ let e = GEdit.entry ~text:"double click here" ~editable:false () in
+ e#event#connect#button_press ~callback:
+ (fun ev ->
+ GdkEvent.get_type ev = `TWO_BUTTON_PRESS &&
+ GdkEvent.Button.button ev = 1 &&
+ begin
+ wpop#misc#show ();
+ GtkSignal.stop_emit ();
+ true
+ end);
+ e#coerce
+
+let prop_box list =
+ let vbox = GPack.vbox () in
+ List.iter list ~f:
+ begin fun (name, prop) ->
+ let hbox =
+ GPack.hbox ~homogeneous:true ~packing:(vbox#pack ~expand:false) () in
+ GMisc.label ~text:name ~packing:hbox#pack ();
+ hbox#pack ~fill:true (prop_widget prop);
+ GMisc.separator `HORIZONTAL ~packing:(vbox#pack ~expand:false) ();
+ ()
+ end;
+ vbox
+
+class ['a] frozen lz = object
+ method get : 'a = Lazy.force lz
+end
+
+let vbox =
+ new frozen (lazy (GWindow.window ~show:true ~title:"Properties" ()))
+
+let init () = vbox#get
+
+let widget_pool = Hashtbl.create 7
+
+let boxref = ref None
+let shown_widget = ref ""
+
+let show_prop_box vb =
+ Gaux.may !boxref ~f:vbox#get#remove;
+ vbox#get#add vb#coerce;
+ boxref := Some vb#coerce
+
+let show (w : #tiwidget_base) =
+ let name = w#name in
+ let vb =
+ try
+ Hashtbl.find widget_pool name
+ with Not_found ->
+ let vb = prop_box w#proplist in
+ Hashtbl.add widget_pool ~key:name ~data:vb;
+ vb
+ in
+ show_prop_box vb;
+ shown_widget := name
+
+let add (w : #tiwidget_base) =
+ let vb = prop_box w#proplist in
+ Hashtbl.add widget_pool ~key:w#name ~data:vb
+
+
+let remove name =
+ Hashtbl.remove widget_pool name;
+ if !shown_widget = name then begin
+ shown_widget := "";
+ show_prop_box (GMisc.label ~text:"No widget selected" ())
+ end
+
+(*
+let change_name oldname newname =
+ let vb = Hashtbl.find widget_pool oldname in
+ Hashtbl.remove widget_pool oldname;
+ Hashtbl.add widget_pool ~key:newname ~data:vb
+*)
+
+let update (w : #tiwidget_base) show_modif =
+ let vb = prop_box w#proplist in
+ Hashtbl.remove widget_pool w#name;
+ Hashtbl.add widget_pool ~key:w#name ~data:vb;
+ if show_modif && !shown_widget = w#name then show_prop_box vb
projects / helm.git / blobdiff