Daily check-in.

[guestfs-browser.git] / window.ml

diff --git a/window.ml b/window.ml
index c4e17b0..5f3852a 100644 (file)
--- a/window.ml
+++ b/window.ml
@@ -61,6 +61,9 @@ and when_connected ws uri doms =
    | None -> set_statusbar ws "Connected to default libvirt"
    | Some uri -> set_statusbar ws (sprintf "Connected to %s" uri)
   );
+  populate_vmcombo ws doms
+
+and populate_vmcombo ws doms =
   (* Populate the VM combo box. *)
   let combo, (model, column) = ws.vmcombo in
   model#clear ();
@@ -204,6 +207,9 @@ let rec open_main_window () =
       )
   );
 
+  Filetree.set_status_fn view (set_statusbar ws);
+
+  (* Return the window_state struct. *)
   ws
 
 and make_menubar window vbox ~packing () =
@@ -257,3 +263,29 @@ and make_filetree ~packing () =
   let sw =
     GBin.scrolled_window ~packing ~hpolicy:`AUTOMATIC ~vpolicy:`ALWAYS () in
   Filetree.create ~packing:sw#add ()
+
+(* Do what the user asked on the command line. *)
+let rec run_cli_request ws = function
+  | Cmdline.Empty_window -> ()
+  | Cmdline.Open_images images ->
+      open_disk_images ws images
+  | Cmdline.Open_guest guest ->
+      (* Open libvirt connection, and in the callback open the guest. *)
+      let uri = connect_uri () in
+      Slave.connect uri (when_connected_cli_request ws guest)
+and when_connected_cli_request ws guest doms =
+  populate_vmcombo ws doms;
+
+  (* "guest" should match a domain in "doms".  Check this and
+   * get the index of it.
+   *)
+  let rec loop i = function
+    | [] ->
+        failwith "guest %s not found (do you need to use --connect?)" guest
+    | d::ds when d = guest -> i
+    | _::ds -> loop (i+1) ds
+  in
+  let i = loop 0 (List.map (fun { Slave.dom_name = name } -> name) doms) in
+
+  let combo, _ = ws.vmcombo in
+  combo#set_active i