7 class tibox ~(dir : Gtk.Tags.orientation) ~(widget : GPack.box)
8 ~name ~parent_tree ~pos ?(insert_evbox=true) parent_window =
10 match dir with `VERTICAL -> "GPack.vbox" | _ -> "GPack.hbox" in
13 inherit ticontainer ~name ~widget ~parent_tree ~pos ~insert_evbox
14 parent_window as container
16 method private class_name = class_name
18 method private name_of_add_method = "#pack"
20 (* removes the ::expand ::fill ::padding in the proplist of a box
21 assumes that these are the only properties with a :: in the name *)
22 method private save_clean_proplist =
23 List.filter container#save_clean_proplist
26 let i = String.index n ':' in
27 i = String.length n || n.[i+1] <> ':'
28 with Not_found -> true)
30 method private emit_clean_proplist =
31 List.filter container#emit_clean_proplist
34 let i = String.index n ':' in
35 i = String.length n || n.[i+1] <> ':'
36 with Not_found -> true)
38 method change_name_in_proplist oldn newn =
39 proplist <- List.fold_left ~init:proplist ~f:
41 change_property_name (oldn ^ propname) (newn ^ propname) pl)
42 [ "::expand"; "::fill"; "::padding" ];
43 Propwin.update self false
45 method child_up child =
46 let pos = list_pos ~item:child (List.map ~f:fst children) in
48 box#reorder_child child#base ~pos:(pos-1);
49 children <- list_reorder_up children ~pos;
53 method child_down child =
54 let pos = list_pos ~item:child (List.map ~f:fst children) in
55 if pos < (List.length children - 1) then begin
56 box#reorder_child child#base ~pos:(pos+1);
57 children <- list_reorder_down children ~pos;
58 stree#item_up ~pos:(pos+1)
61 method private add child ~pos =
64 children <- children @ [(child, `START)]
67 children <- list_insert ~item:(child, `START) children ~pos;
68 box#reorder_child child#base ~pos
72 new prop_bool ~name:"expand" ~init:"false" ~set:
74 box#set_child_packing (child#base) ~expand:v;
75 Propwin.update child false;
76 Propwin.update self false; true
79 new prop_bool ~name:"fill" ~init:"true" ~set:
81 box#set_child_packing (child#base) ~fill:v;
82 Propwin.update child false;
83 Propwin.update self false; true
86 new prop_int ~name:"padding" ~init:"0" ~set:
88 box#set_child_packing (child#base) ~padding:v;
89 Propwin.update child false;
90 Propwin.update self false; true
93 proplist <- proplist @
94 [ (n ^ "::expand"), expand;
96 (n ^ "::padding"), padding ];
98 [ "expand", expand; "fill", fill; "padding", padding ];
99 Propwin.update self true
102 method remove child =
103 box#remove (child#base);
104 children <- list_remove ~f:(fun (ch, _) -> ch = child) children;
105 let n = child#name in
106 proplist <- List.fold_left ~init:proplist
107 ~f:(fun acc n -> List.remove_assoc n acc)
108 [ (n ^ "::expand"); (n ^ "::fill"); (n ^ "::padding") ];
109 Propwin.update self true
112 classe <- (match dir with `VERTICAL -> "vbox" | _ -> "hbox");
113 proplist <- proplist @
115 new prop_bool ~name:"homogeneous" ~init:"false"
116 ~set:(ftrue box#set_homogeneous);
118 new prop_int ~name:"spacing" ~init:"0"
119 ~set:(ftrue box#set_spacing)
123 class tihbox = tibox ~dir:`HORIZONTAL
124 class tivbox = tibox ~dir:`VERTICAL
126 let new_tihbox ~name ?(listprop = []) = new tihbox ~widget:(GPack.hbox ()) ~name
127 let new_tivbox ~name ?(listprop = []) = new tivbox ~widget:(GPack.vbox ()) ~name
132 class tibbox ~(dir : Gtk.Tags.orientation) ~(widget : GPack.button_box)
133 ~name ~parent_tree ~pos ?(insert_evbox=true) parent_window =
135 match dir with `VERTICAL -> "GPack.button_box `VERTICAL"
136 | _ -> "GPack.button_box `HORIZONTAL" in
139 inherit tibox ~dir ~widget:(widget :> GPack.box)
140 ~name ~parent_tree ~pos ~insert_evbox parent_window
142 method private class_name = class_name
145 classe <- (match dir with `VERTICAL -> "vbutton_box" | _ -> "hbutton_box");
146 proplist <- proplist @
148 new prop_button_box_style ~name:"layout" ~init:"DEFAULT_STYLE"
149 ~set:(ftrue bbox#set_layout);
151 new prop_int ~name:"spacing"
152 ~init:(match dir with `VERTICAL -> "10" | _ -> "30")
154 (GtkPack.BBox.get_spacing bbox#as_button_box) *)
155 ~set:(fun v -> bbox#set_spacing v;
156 GtkBase.Widget.queue_resize bbox#as_widget; true);
158 new prop_int ~name:"child_width" ~init:"85"
160 bbox#set_child_size ~width:v
161 ~height:(int_of_string (self#get_property "child_height")) ();
162 GtkBase.Widget.queue_resize bbox#as_widget; true);
164 new prop_int ~name:"child_height" ~init:"27"
166 bbox#set_child_size ~height:v
167 ~width:(int_of_string (self#get_property "child_width")) ();
168 GtkBase.Widget.queue_resize bbox#as_widget; true);
170 new prop_int ~name:"child_ipad_x" ~init:"7"
172 bbox#set_child_ipadding ~x:v
173 ~y:(int_of_string (self#get_property "child_ipad_y")) ();
174 GtkBase.Widget.queue_resize bbox#as_widget; true);
176 new prop_int ~name:"child_ipad_y" ~init:"0"
178 bbox#set_child_ipadding ~y:v
179 ~x:(int_of_string (self#get_property "child_ipad_x")) ();
180 GtkBase.Widget.queue_resize bbox#as_widget; true);
185 (* TODO: pour proplist/spacing il faudrait implementer
186 les fonctions get_spacing ... (voir dans gtkPack) *)
188 class tihbutton_box = tibbox ~dir:`HORIZONTAL
189 class tivbutton_box = tibbox ~dir:`VERTICAL
191 let new_tihbutton_box ~name ?(listprop = []) =
192 new tihbutton_box ~widget:(GPack.button_box `HORIZONTAL ()) ~name
194 let new_tivbutton_box ~name ?(listprop = []) =
195 new tivbutton_box ~widget:(GPack.button_box `VERTICAL ()) ~name
200 let get_fixed_pos () =
201 let rx = ref 0 and ry = ref 0 in
202 let w = GWindow.window ~modal:true () in
203 let v = GPack.vbox ~packing:w#add () in
204 let l = GMisc.label ~text:"Enter position for child" ~packing:v#pack () in
205 let h1 = GPack.hbox ~packing:v#pack () in
206 let l1 = GMisc.label ~text:"x:" ~packing:h1#pack () in
207 let e1 = GEdit.entry ~text:"0" ~packing:h1#pack () in
208 let h2 = GPack.hbox ~packing:v#pack () in
209 let l2 = GMisc.label ~text:"y" ~packing:h2#pack () in
210 let e2 = GEdit.entry ~text:"0" ~packing:h2#pack () in
211 let h7 = GPack.hbox ~packing:v#pack () in
212 let b1 = GButton.button ~label:"OK" ~packing:h7#pack () in
213 let b2 = GButton.button ~label:"Cancel" ~packing:h7#pack () in
218 try rx := int_of_string e1#text with _ -> () end;
220 try ry := int_of_string e2#text with _ -> () end;
222 b2#connect#clicked ~callback:w#destroy;
223 w#connect#destroy ~callback:GMain.Main.quit;
228 class tifixed ~(widget : GPack.fixed)
229 ~name ~parent_tree ~pos ?(insert_evbox=true) parent_window =
232 inherit ticontainer ~widget
233 ~name ~parent_tree ~pos ~insert_evbox parent_window
235 method private class_name = "GPack.fixed"
237 method private add child ~pos =
238 let x, y = get_fixed_pos () in
239 fixed#put child#base ~x ~y;
240 children <- children @ [(child, `START)]
245 let new_tifixed ~name ?(listprop = []) =
246 new tifixed ~widget:(GPack.fixed ()) ~name
252 class tinotebook ~(widget : GPack.notebook) ~name ~parent_tree ~pos
253 ?(insert_evbox=true) parent_window =
255 val notebook = widget
256 inherit ticontainer ~name ~widget ~insert_evbox
257 ~parent_tree ~pos parent_window as widget
259 method private class_name = "GPack.notebook"
261 method private add child ~pos =
262 children <- children @ [child, `START];
263 notebook#insert_page child#base ~pos;
264 child#add_to_proplist
266 new prop_string ~name:"tab_label" ~init:""
267 ~set:(fun v -> notebook#set_page
268 ~tab_label:((GMisc.label ~text:v())#coerce) child#base; true)
273 classe <- "notebook";
274 proplist <- proplist @
276 new prop_position ~name:"tab_ pos" ~init:"TOP"
277 ~set:(ftrue notebook#set_tab_pos);
279 new prop_bool ~name:"show_tabs" ~init:"true"
280 ~set:(ftrue notebook#set_show_tabs);
282 new prop_bool ~name:"homogeneous_tabs" ~init:"true"
283 ~set:(ftrue notebook#set_homogeneous_tabs);
285 new prop_bool ~name:"show_border" ~init:"true"
286 ~set:(ftrue notebook#set_show_border);
288 new prop_bool ~name:"scrollable" ~init:"false"
289 ~set:(ftrue notebook#set_scrollable);
291 new prop_int ~name:"tab_border" ~init:"2"
292 ~set:(ftrue notebook#set_tab_border);
294 new prop_bool ~name:"popup_enable" ~init:"false"
295 ~set:(ftrue notebook#set_popup)
299 let new_tinotebook ~name ?(listprop = []) =
300 new tinotebook ~widget:(GPack.notebook ()) ~name