Random changes.

[virt-ctrl.git] / virt-ctrl / vc_mainwindow.ml

diff --git a/virt-ctrl/vc_mainwindow.ml b/virt-ctrl/vc_mainwindow.ml
index c34a803..71083fa 100644 (file)
--- a/virt-ctrl/vc_mainwindow.ml
+++ b/virt-ctrl/vc_mainwindow.ml
@@ -45,7 +45,9 @@ Libvirt version: %s
 
 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
@@ -64,7 +66,7 @@ let () =
       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. *)
@@ -72,7 +74,7 @@ let make
   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
@@ -86,11 +88,13 @@ let make
     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
@@ -98,7 +102,7 @@ let make
 
     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
@@ -108,6 +112,18 @@ let make
     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).
    *)
@@ -200,3 +216,34 @@ let make
 
   (* 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