X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=virt-ctrl%2Fvc_mainwindow.ml;h=7aa8145c43a7dded9263faf6553d703c22777fef;hb=6d1e1917a4c8ae136276c3c308d563d4940c982a;hp=4fd82c947212f16f718ab958ee64d7a5ce737391;hpb=5881ddaa61385403718e1e5b415057a2d3ef4c45;p=virt-top.git diff --git a/virt-ctrl/vc_mainwindow.ml b/virt-ctrl/vc_mainwindow.ml index 4fd82c9..7aa8145 100644 --- a/virt-ctrl/vc_mainwindow.ml +++ b/virt-ctrl/vc_mainwindow.ml @@ -60,67 +60,107 @@ let () = icon#set_icon_size `DIALOG; GToolbox.message_box ~title ~icon label -let make ~open_connection - ~start_domain ~pause_domain ~resume_domain ~shutdown_domain = +let make + ~start_domain ~pause_domain ~resume_domain ~shutdown_domain + ~open_domain_details = (* Create the main window. *) let window = GWindow.window ~width:800 ~height:600 ~title () in let vbox = GPack.vbox ~packing:window#add () in (* Menu bar. *) - let menubar = GMenu.menu_bar ~packing:vbox#pack () in - let factory = new GMenu.factory menubar in - let accel_group = factory#accel_group in - let file_menu = factory#add_submenu "File" in - let help_menu = factory#add_submenu "Help" in + let quit_item = + let menubar = GMenu.menu_bar ~packing:vbox#pack () in + let factory = new GMenu.factory menubar in + let accel_group = factory#accel_group in + let file_menu = factory#add_submenu "File" in + let help_menu = factory#add_submenu "Help" in - (* File menu. *) - let factory = new GMenu.factory file_menu ~accel_group in - let open_item = factory#add_item "Open connection ..." - ~key:GdkKeysyms._O in - ignore (factory#add_separator ()); - let quit_item = factory#add_item "Quit" ~key:GdkKeysyms._Q in + window#add_accel_group accel_group; - ignore (open_item#connect#activate ~callback:open_connection); + (* File menu. *) + let factory = new GMenu.factory file_menu ~accel_group in + let open_item = factory#add_item "Open connection ..." + ~key:GdkKeysyms._O in + ignore (factory#add_separator ()); + let quit_item = factory#add_item "Quit" ~key:GdkKeysyms._Q in - (* Help menu. *) - let factory = new GMenu.factory help_menu ~accel_group in - let help_item = factory#add_item "Help" in - let help_about_item = factory#add_item "About ..." in + ignore (open_item#connect#activate + ~callback:(Vc_connection_dlg.open_connection window)); - ignore (help_about_item#connect#activate ~callback:help_about); + (* Help menu. *) + let factory = new GMenu.factory help_menu ~accel_group in + let help_item = factory#add_item "Help" in + let help_about_item = factory#add_item "About ..." in + + ignore (help_about_item#connect#activate ~callback:help_about); + + quit_item in (* The toolbar. *) let toolbar = GButton.toolbar ~packing:vbox#pack () in - let connect_button = - GButton.tool_button ~label:"Connect ..." ~stock:`CONNECT - ~packing:toolbar#insert () in - let start_button = - GButton.tool_button ~label:"Start" ~stock:`ADD - ~packing:toolbar#insert () in - let pause_button = - GButton.tool_button ~label:"Pause" ~stock:`MEDIA_PAUSE - ~packing:toolbar#insert () in - let resume_button = - GButton.tool_button ~label:"Resume" ~stock:`MEDIA_PLAY - ~packing:toolbar#insert () in - let shutdown_button = - GButton.tool_button ~label:"Shutdown" ~stock:`STOP - ~packing:toolbar#insert () in - ignore (connect_button#connect#clicked ~callback:open_connection); (* The treeview. *) let (tree, model, columns, initial_state) = Vc_connections.make_treeview ~packing:(vbox#pack ~expand:true ~fill:true) () in - ignore (start_button#connect#clicked - ~callback:(start_domain tree model columns)); - ignore (pause_button#connect#clicked - ~callback:(pause_domain tree model columns)); - ignore (resume_button#connect#clicked - ~callback:(resume_domain tree model columns)); - ignore (shutdown_button#connect#clicked - ~callback:(shutdown_domain tree model columns)); + (* Add buttons to the toolbar (requires the treeview to + * have been made above). + *) + let () = + let connect_button_menu = GMenu.menu () in + let connect_button = + GButton.menu_tool_button + ~label:"Connect ..." ~stock:`CONNECT + ~menu:connect_button_menu + ~packing:toolbar#insert () in + ignore (GButton.separator_tool_item ~packing:toolbar#insert ()); + let open_button = + GButton.tool_button ~label:"Details" ~stock:`OPEN + ~packing:toolbar#insert () in + ignore (GButton.separator_tool_item ~packing:toolbar#insert ()); + let start_button = + GButton.tool_button ~label:"Start" ~stock:`ADD + ~packing:toolbar#insert () in + let pause_button = + GButton.tool_button ~label:"Pause" ~stock:`MEDIA_PAUSE + ~packing:toolbar#insert () in + let resume_button = + GButton.tool_button ~label:"Resume" ~stock:`MEDIA_PLAY + ~packing:toolbar#insert () in + ignore (GButton.separator_tool_item ~packing:toolbar#insert ()); + let shutdown_button = + GButton.tool_button ~label:"Shutdown" ~stock:`STOP + ~packing:toolbar#insert () in + + (* Set callbacks for the toolbar buttons. *) + ignore (connect_button#connect#clicked + ~callback:(Vc_connection_dlg.open_connection window)); + ignore (open_button#connect#clicked + ~callback:(open_domain_details tree model columns)); + ignore (start_button#connect#clicked + ~callback:(start_domain tree model columns)); + ignore (pause_button#connect#clicked + ~callback:(pause_domain tree model columns)); + ignore (resume_button#connect#clicked + ~callback:(resume_domain tree model columns)); + ignore (shutdown_button#connect#clicked + ~callback:(shutdown_domain tree model columns)); + + (* Set a menu on the connect menu-button. *) + let () = + let factory = new GMenu.factory connect_button_menu (*~accel_group*) in + let local_xen = factory#add_item "Local Xen" in + let local_qemu = factory#add_item "Local QEMU/KVM" in + ignore (factory#add_separator ()); + let open_dialog = factory#add_item "Connect to ..." in + ignore (local_xen#connect#activate + ~callback:Vc_connection_dlg.open_local_xen); + ignore (local_qemu#connect#activate + ~callback:Vc_connection_dlg.open_local_qemu); + ignore (open_dialog#connect#activate + ~callback:(Vc_connection_dlg.open_connection window)) in + () in (* Make a timeout function which is called once per second. *) let state = ref initial_state in @@ -145,7 +185,7 @@ let make ~open_connection (* Quit. *) let quit _ = GMain.Timeout.remove timeout_id; - GMain.Main.quit (); + GMain.quit (); false in @@ -154,7 +194,5 @@ let make ~open_connection ignore (quit_item#connect#activate ~callback:(fun () -> ignore (quit ()); ())); - window#add_accel_group accel_group; - (* Display the window. *) window#show ()