drop md4 i?86 specific asm implementations
[mldonkey.git] / src / gtk2 / gui / guiWindow.ml
blob16828cef2347ea96bbfbd3380a0b730974e144a2
1 (* Copyright 2004 b8_bavard, INRIA *)
2 (*
3 This file is part of mldonkey.
5 mldonkey is free software; you can redistribute it and/or modify
6 it under the terms of the GNU General Public License as published by
7 the Free Software Foundation; either version 2 of the License, or
8 (at your option) any later version.
10 mldonkey is distributed in the hope that it will be useful,
11 but WITHOUT ANY WARRANTY; without even the implied warranty of
12 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 GNU General Public License for more details.
15 You should have received a copy of the GNU General Public License
16 along with mldonkey; if not, write to the Free Software
17 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
20 (* Main window of the GUI. *)
23 open GuiTypes2
24 open GuiTools
27 module M = GuiMessages
28 module O = GuiOptions
29 module G = GuiGlobal
30 module A = GuiArt
31 module U = GuiUtf8
33 let (!!) = Options.(!!)
34 let (<:>) = GuiTools.(<:>)
36 (*************************************************************************)
37 (* *)
38 (* clean *)
39 (* *)
40 (*************************************************************************)
42 let clean w =
43 List.iter (fun w -> w#destroy ()) w#children
45 (*************************************************************************)
46 (* *)
47 (* display_networks *)
48 (* *)
49 (*************************************************************************)
51 let display_networks gui () =
52 clean gui.vbox;
53 let networks = GuiNetworks.networks_box gui in
54 gui.vbox#add networks;
55 gui.current_page <- 0
57 (*************************************************************************)
58 (* *)
59 (* display_servers *)
60 (* *)
61 (*************************************************************************)
63 let display_servers gui () =
64 clean gui.vbox;
65 let servers = GuiServers.servers_box gui in
66 gui.vbox#add servers;
67 gui.current_page <- 1
69 (*************************************************************************)
70 (* *)
71 (* display_downloads *)
72 (* *)
73 (*************************************************************************)
75 let display_downloads gui () =
76 clean gui.vbox;
77 let downloads = GuiDownloads.downloads_box gui in
78 gui.vbox#add downloads;
79 gui.current_page <- 2
81 (*************************************************************************)
82 (* *)
83 (* display_friends *)
84 (* *)
85 (*************************************************************************)
87 let display_friends gui () =
88 clean gui.vbox;
89 let friends = GuiFriends.friends_box gui in
90 gui.vbox#add friends;
91 gui.current_page <- 3
93 (*************************************************************************)
94 (* *)
95 (* display_search *)
96 (* *)
97 (*************************************************************************)
99 let display_search gui () =
100 clean gui.vbox;
101 let queries = GuiQueries.queries_box gui in
102 gui.vbox#add queries;
103 gui.current_page <- 4
105 (*************************************************************************)
106 (* *)
107 (* display_rooms *)
108 (* *)
109 (*************************************************************************)
111 let display_rooms gui () =
112 clean gui.vbox;
113 let rooms = GuiRooms.rooms_box gui in
114 gui.vbox#add rooms;
115 gui.current_page <- 5
117 (*************************************************************************)
118 (* *)
119 (* display_uploads *)
120 (* *)
121 (*************************************************************************)
123 let display_uploads gui () =
124 clean gui.vbox;
125 let uploads = GuiUploads.uploads_box gui in
126 gui.vbox#add uploads;
127 gui.current_page <- 6
129 (*************************************************************************)
130 (* *)
131 (* display_console *)
132 (* *)
133 (*************************************************************************)
135 let display_console gui () =
136 clean gui.vbox;
137 let console = GuiConsole.console_box gui in
138 gui.vbox#add console;
139 gui.current_page <- 7
141 (*************************************************************************)
142 (* *)
143 (* display_graph *)
144 (* *)
145 (*************************************************************************)
147 let display_graph gui () =
148 clean gui.vbox;
149 let graph = GuiGraph.graph_box gui in
150 gui.vbox#add graph;
151 gui.current_page <- 8
153 (*************************************************************************)
154 (* *)
155 (* display_settings *)
156 (* *)
157 (*************************************************************************)
159 let rec display_settings gui value_reader =
160 GuiConfig.config_window gui value_reader fill_tool_bar
162 and fill_tool_bar gui =
163 let bNetworks = gui.wtool#add_toggle_button
164 ~style:!!O.gtk_look_toolbars_style
165 ~markup:!M.mW_lb_networks
166 ~icon:(A.get_icon ~icon:M.icon_menu_networks ~size:A.LARGE ())
167 ~f:(display_networks gui) ()
169 let bServers = gui.wtool#add_toggle_button
170 ~style:!!O.gtk_look_toolbars_style
171 ~markup:!M.mW_lb_servers
172 ~icon:(A.get_icon ~icon:M.icon_menu_servers ~size:A.LARGE ())
173 ~f:(display_servers gui) ()
175 let bDownloads = gui.wtool#add_toggle_button
176 ~style:!!O.gtk_look_toolbars_style
177 ~markup:!M.mW_lb_downloads
178 ~icon:(A.get_icon ~icon:M.icon_menu_downloads ~size:A.LARGE ())
179 ~f:(display_downloads gui) ()
181 let bFriends = gui.wtool#add_toggle_button
182 ~style:!!O.gtk_look_toolbars_style
183 ~markup:!M.mW_lb_friends
184 ~icon:(A.get_icon ~icon:M.icon_menu_friends ~size:A.LARGE ())
185 ~f:(display_friends gui) ()
187 let bSearch = gui.wtool#add_toggle_button
188 ~style:!!O.gtk_look_toolbars_style
189 ~markup:!M.mW_lb_search
190 ~icon:(A.get_icon ~icon:M.icon_menu_searches ~size:A.LARGE ())
191 ~f:(display_search gui) ()
193 let bRooms = gui.wtool#add_toggle_button
194 ~style:!!O.gtk_look_toolbars_style
195 ~markup:!M.mW_lb_rooms
196 ~icon:(A.get_icon ~icon:M.icon_menu_rooms ~size:A.LARGE ())
197 ~f:(display_rooms gui) ()
199 let bUploads = gui.wtool#add_toggle_button
200 ~style:!!O.gtk_look_toolbars_style
201 ~markup:!M.mW_lb_uploads
202 ~icon:(A.get_icon ~icon:M.icon_menu_uploads ~size:A.LARGE ())
203 ~f:(display_uploads gui) ()
205 let bConsole = gui.wtool#add_toggle_button
206 ~style:!!O.gtk_look_toolbars_style
207 ~markup:!M.mW_lb_console
208 ~icon:(A.get_icon ~icon:M.icon_menu_console ~size:A.LARGE ())
209 ~f:(display_console gui) ()
211 let bGraph = gui.wtool#add_toggle_button
212 ~style:!!O.gtk_look_toolbars_style
213 ~markup:!M.mW_lb_graph
214 ~icon:(A.get_icon ~icon:M.icon_menu_graph ~size:A.LARGE ())
215 ~f:(display_graph gui) ()
218 * TODO : make a Graph tab + some stats
220 let bGraph = gui.wtool#add_toggle_button
221 ~style:!!O.gtk_look_toolbars_style
222 ~markup:!M.mW_lb_graph
223 ~icon:(A.get_icon ~icon:M.icon_menu_graph ~size:A.LARGE ())
224 ~f:(display_graph gui) ()
228 let bIm = gui.wtool#add_button
229 ~style:!!O.gtk_look_toolbars_style
230 ~markup:!M.mW_lb_im
231 ~icon:(A.get_icon ~icon:M.icon_menu_im ~size:A.LARGE ())
232 ~f:(display_im gui) ()
234 let bSettings = gui.wtool#add_button
235 ~style:!!O.gtk_look_toolbars_style
236 ~markup:!M.mW_lb_settings
237 ~icon:(A.get_icon ~icon:M.icon_menu_settings ~size:A.LARGE ())
238 ~f:(display_settings gui) ()
241 gui.switch_to_page <- (fun page ->
242 match page with
243 0 -> bNetworks#set_active true
244 | 1 -> bServers#set_active true
245 | 3 -> bFriends#set_active true
246 | 4 -> bSearch#set_active true
247 | 5 -> bRooms#set_active true
248 | 6 -> bUploads#set_active true
249 | 7 -> bConsole#set_active true
250 | 8 -> bGraph#set_active true
251 | _ -> bDownloads#set_active true
253 gui.update_current_page <- (fun _ ->
254 match gui.current_page with
255 0 -> display_networks gui ()
256 | 1 -> display_servers gui ()
257 | 3 -> display_friends gui ()
258 | 4 -> display_search gui ()
259 | 5 -> display_rooms gui ()
260 | 6 -> display_uploads gui ()
261 | 7 -> display_console gui ()
262 | 8 -> display_graph gui ()
263 | _ -> display_downloads gui ()
266 (*************************************************************************)
267 (* *)
268 (* window *)
269 (* *)
270 (*************************************************************************)
272 let window () =
273 let win =
274 GWindow.window
275 ~title:(!M.mW_wt_software)
276 ~icon:(A.get_icon ~icon:M.icon_type_source_normal ~size:A.SMALL ())
277 ~resizable:true ~modal:false ()
279 win#maximize ();
280 let vbox =
281 GPack.vbox ~homogeneous:false ~packing:(win#add) ()
283 let hbox =
284 GPack.hbox ~homogeneous:false
285 ~packing:(vbox#pack ~expand:false ~fill:true) () in
286 let wtool =
287 tool_bar `HORIZONTAL
288 ~layout:`START ~packing:hbox#add ()
290 let vbox_view =
291 GPack.vbox ~homogeneous:false
292 ~packing:(vbox#pack ~expand:true ~fill:true) ()
294 let gui =
296 window = win;
297 vbox = vbox_view;
298 wtool = wtool;
299 init =
301 networks = true;
302 servers = true;
303 downloads = true;
304 friends = true;
305 queries = true;
306 rooms = true;
307 uploads = true;
308 settings = true;
309 console = true;
311 clear = (fun _ ->
312 GuiStatusBar.clear ();
313 GuiNetworks.clear ();
314 GuiServers.clear ();
315 GuiDownloads.clear ();
316 GuiFriends.clear ();
317 GuiQueries.clear ();
318 GuiRooms.clear ();
319 GuiUploads.clear ();
320 GuiConsole.clear ();
321 GuiConfig.clear ();
324 set_corestatus = GuiStatusBar.update_corestatus;
325 current_page = !!O.last_tab;
326 switch_to_page = (fun _ -> ());
327 set_splash_screen = (fun _ _ -> ());
328 update_current_page = (fun _ -> ());
332 fill_tool_bar gui;
334 let statusbar = GuiStatusBar.status_box () in
335 vbox#pack ~expand:false ~fill:true statusbar;