Gtk toolkit version: %s") utf8_copyright virt_version gtk_version)
-(* Catch any exception and throw up a dialog. *)
+(* Set up a global exception handler to catch any exception and throw
+ * up a dialog.
+ *)
let () =
(* A nicer exception printing function. *)
let string_of_exn = function
icon#set_icon_size `DIALOG;
GToolbox.message_box ~title ~icon label
-let make
+let rec make
~start_domain ~pause_domain ~resume_domain ~shutdown_domain
~open_domain_details =
(* Create the main window. *)
let vbox = GPack.vbox ~packing:window#add () in
(* Menu bar. *)
- let quit_item =
+ let quit_item, install_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 open_item = factory#add_item (s_ "Open connection ...")
~key:GdkKeysyms._O in
ignore (factory#add_separator ());
+ let install_item = factory#add_item (s_ "Install new guest ...")
+ ~key:GdkKeysyms._N in
+ ignore (factory#add_separator ());
let quit_item = factory#add_item (s_ "Quit") ~key:GdkKeysyms._Q in
ignore (open_item#connect#activate
~callback:(Vc_connection_dlg.open_connection window));
-
(* Help menu. *)
let factory = new GMenu.factory help_menu ~accel_group in
let help_item = factory#add_item (s_ "Help") in
ignore (help_about_item#connect#activate ~callback:help_about);
- quit_item in
+ quit_item, install_item in
(* The toolbar. *)
let toolbar = GButton.toolbar ~packing:vbox#pack () in
Vc_connections.make_treeview
~packing:(vbox#pack ~expand:true ~fill:true) () in
+ (* Wire up the install item (requires the treeview for selection). *)
+ ignore (install_item#connect#activate
+ ~callback:(
+ fun () ->
+ let conn_id = get_conn_id tree model columns in
+ match conn_id with
+ | None -> () (* nothing selected *)
+ | Some conn_id -> (* connection ID selected *)
+ Vc_install_dlg.install_guest window conn_id ()
+ )
+ );
+
(* Add buttons to the toolbar (requires the treeview to
* have been made above).
*)
(* Display the window. *)
window#show ()
+
+(* Get the selected connection ID if there is one or return None. *)
+and get_conn_id (tree : GTree.view) (model : GTree.tree_store)
+ (columns : Vc_connections.columns) =
+ let path, _ = tree#get_cursor () in
+ match path with
+ | None -> None (* No row at all selected. *)
+ | Some path ->
+ let row = model#get_iter path in
+ let (_, _, _, _, _, col_id) = columns in
+ (* Visit parent to get the connid.
+ * If this returns None, then this is already a top-level row
+ * (ie. a connection).
+ *)
+ match model#iter_parent row with
+ | None ->
+ let connid = model#get ~row ~column:col_id in
+ Some connid
+ | Some parent ->
+ try
+ let connid = model#get ~row:parent ~column:col_id in
+ Some connid
+ with
+ (* Domain or connection disappeared under us. *)
+ | Not_found -> None
+ | Failure msg ->
+ prerr_endline msg;
+ None
+ | Libvirt.Virterror err ->
+ prerr_endline (Libvirt.Virterror.to_string err);
+ None