X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=virt-ctrl%2Fvc_mainwindow.ml;h=c34a8031941be1ab0bd78a9de90f47cae303416f;hb=5c18720b51f3938cea534f97fbcfcaabff10d7e1;hp=3ae9d7cd74d922484c0c4b026dbf469504201fb7;hpb=d7a277ed8a3312d927d712cb01807ea07d7b96ae;p=virt-top.git diff --git a/virt-ctrl/vc_mainwindow.ml b/virt-ctrl/vc_mainwindow.ml index 3ae9d7c..c34a803 100644 --- a/virt-ctrl/vc_mainwindow.ml +++ b/virt-ctrl/vc_mainwindow.ml @@ -18,8 +18,9 @@ *) open Printf +open Virt_ctrl_gettext.Gettext -let title = "Virtual Control" +let title = s_ "Virtual Control" let utf8_copyright = "\194\169" @@ -35,18 +36,21 @@ let help_about () = GToolbox.message_box ~title ~icon - ("Virtualization control tool (virt-ctrl) by\n" ^ - "Richard W.M. Jones (rjones@redhat.com).\n\n" ^ - "Copyright " ^ utf8_copyright ^ " 2007-2008 Red Hat Inc.\n\n" ^ - "Libvirt version: " ^ virt_version ^ "\n" ^ - "Gtk toolkit version: " ^ gtk_version) + (sprintf (f_ "Virtualization control tool (virt-ctrl) by +Richard W.M. Jones (rjones@redhat.com). + +Copyright %s 2007-2008 Red Hat Inc. + +Libvirt version: %s + +Gtk toolkit version: %s") utf8_copyright virt_version gtk_version) (* Catch any exception and throw up a dialog. *) let () = (* A nicer exception printing function. *) let string_of_exn = function | Libvirt.Virterror err -> - "Virtualisation error: " ^ (Libvirt.Virterror.to_string err) + s_ "Virtualisation error" ^ ": " ^ (Libvirt.Virterror.to_string err) | Failure msg -> msg | exn -> Printexc.to_string exn in @@ -54,23 +58,12 @@ let () = fun exn -> let label = string_of_exn exn in prerr_endline label; - let title = "Error" in + let title = s_ "Error" in let icon = GMisc.image () in icon#set_stock `DIALOG_ERROR; icon#set_icon_size `DIALOG; GToolbox.message_box ~title ~icon label -(* Open connection dialog. - * This should be a lot more sophisticated. XXX - *) -let open_connection () = - let title = "Open connection to hypervisor" in - let uri = - GToolbox.input_string ~title ~text:"xen:///" ~ok:"Open" "Connection:" in - match uri with - | None -> () - | Some uri -> Vc_connections.open_connection uri - let make ~start_domain ~pause_domain ~resume_domain ~shutdown_domain ~open_domain_details = @@ -79,68 +72,99 @@ let make 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 (s_ "File") in + let help_menu = factory#add_submenu (s_ "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 (s_ "Open connection ...") + ~key:GdkKeysyms._O in + ignore (factory#add_separator ()); + let quit_item = factory#add_item (s_ "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 (s_ "Help") in + let help_about_item = factory#add_item (s_ "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 - 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 - let shutdown_button = - GButton.tool_button ~label:"Shutdown" ~stock:`STOP - ~packing:toolbar#insert () in (* The treeview. *) let (tree, model, columns, initial_state) = Vc_connections.make_treeview ~packing:(vbox#pack ~expand:true ~fill:true) () in - (* Set callbacks for the buttons. *) - ignore (connect_button#connect#clicked ~callback:open_connection); - 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)); + (* 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:(s_ "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:(s_ "Details") ~stock:`OPEN + ~packing:toolbar#insert () in + ignore (GButton.separator_tool_item ~packing:toolbar#insert ()); + let start_button = + GButton.tool_button ~label:(s_ "Start") ~stock:`ADD + ~packing:toolbar#insert () in + let pause_button = + GButton.tool_button ~label:(s_ "Pause") ~stock:`MEDIA_PAUSE + ~packing:toolbar#insert () in + let resume_button = + GButton.tool_button ~label:(s_ "Resume") ~stock:`MEDIA_PLAY + ~packing:toolbar#insert () in + ignore (GButton.separator_tool_item ~packing:toolbar#insert ()); + let shutdown_button = + GButton.tool_button ~label:(s_ "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 (s_ "Local Xen") in + let local_qemu = factory#add_item (s_ "Local QEMU/KVM") in + ignore (factory#add_separator ()); + let open_dialog = factory#add_item (s_ "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 @@ -165,7 +189,7 @@ let make (* Quit. *) let quit _ = GMain.Timeout.remove timeout_id; - GMain.Main.quit (); + GMain.quit (); false in @@ -174,7 +198,5 @@ let make ignore (quit_item#connect#activate ~callback:(fun () -> ignore (quit ()); ())); - window#add_accel_group accel_group; - (* Display the window. *) window#show ()