1 (* Copyright 2004 b8_bavard, INRIA *)
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. *)
27 module M
= GuiMessages
33 let (!!) = Options.(!!)
34 let (<:>) = GuiTools.(<:>)
36 (*************************************************************************)
40 (*************************************************************************)
43 List.iter
(fun w
-> w#destroy
()) w#children
45 (*************************************************************************)
47 (* display_networks *)
49 (*************************************************************************)
51 let display_networks gui
() =
53 let networks = GuiNetworks.networks_box gui
in
54 gui
.vbox#add
networks;
57 (*************************************************************************)
61 (*************************************************************************)
63 let display_servers gui
() =
65 let servers = GuiServers.servers_box gui
in
69 (*************************************************************************)
71 (* display_downloads *)
73 (*************************************************************************)
75 let display_downloads gui
() =
77 let downloads = GuiDownloads.downloads_box gui
in
78 gui
.vbox#add
downloads;
81 (*************************************************************************)
85 (*************************************************************************)
87 let display_friends gui
() =
89 let friends = GuiFriends.friends_box gui
in
93 (*************************************************************************)
97 (*************************************************************************)
99 let display_search gui
() =
101 let queries = GuiQueries.queries_box gui
in
102 gui
.vbox#add
queries;
103 gui
.current_page
<- 4
105 (*************************************************************************)
109 (*************************************************************************)
111 let display_rooms gui
() =
113 let rooms = GuiRooms.rooms_box gui
in
115 gui
.current_page
<- 5
117 (*************************************************************************)
119 (* display_uploads *)
121 (*************************************************************************)
123 let display_uploads gui
() =
125 let uploads = GuiUploads.uploads_box gui
in
126 gui
.vbox#add
uploads;
127 gui
.current_page
<- 6
129 (*************************************************************************)
131 (* display_console *)
133 (*************************************************************************)
135 let display_console gui
() =
137 let console = GuiConsole.console_box gui
in
138 gui
.vbox#add
console;
139 gui
.current_page
<- 7
141 (*************************************************************************)
145 (*************************************************************************)
147 let display_graph gui
() =
149 let graph = GuiGraph.graph_box gui
in
151 gui
.current_page
<- 8
153 (*************************************************************************)
155 (* display_settings *)
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
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
->
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 (*************************************************************************)
270 (*************************************************************************)
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 ()
281 GPack.vbox ~homogeneous
:false ~packing
:(win#add
) ()
284 GPack.hbox ~homogeneous
:false
285 ~packing
:(vbox#pack ~expand
:false ~fill
:true) () in
288 ~layout
:`START ~packing
:hbox#add
()
291 GPack.vbox ~homogeneous
:false
292 ~packing
:(vbox#pack ~expand
:true ~fill
:true) ()
312 GuiStatusBar.clear
();
313 GuiNetworks.clear
();
315 GuiDownloads.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 _
-> ());
334 let statusbar = GuiStatusBar.status_box
() in
335 vbox#pack ~expand
:false ~fill
:true statusbar;