X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=window.ml;h=aac7380bd0c8fa7df3b6072fc58cdeff8adc23ab;hb=refs%2Ftags%2F0.1.3;hp=c4e17b0c2f00d86fe413cba0bdea59b72470420e;hpb=63477ec4c94146bae30af05022b5a064667949a8;p=guestfs-browser.git

diff --git a/window.ml b/window.ml
index c4e17b0..aac7380 100644
--- a/window.ml
+++ b/window.ml
@@ -27,6 +27,7 @@ type window_state = {
   window : GWindow.window;
   view : Filetree.t;
   vmcombo : GEdit.combo_box GEdit.text_combo;
+  refresh_button : GButton.button;
   throbber : GMisc.image;
   throbber_static : GdkPixbuf.pixbuf;
   statusbar : GMisc.statusbar;
@@ -39,28 +40,21 @@ let set_statusbar ws msg =
   ws.statusbar_context#pop ();
   ignore (ws.statusbar_context#push msg)
 
-let clear_statusbar ws = set_statusbar ws ""
-
 (* Clear the filetree. *)
 let clear_view ws =
   Filetree.clear ws.view
 
 (* Callback from Connect -> ... menu items. *)
 let rec connect_to ws uri =
-  (match uri with
-   | None -> set_statusbar ws "Connecting to default libvirt ..."
-   | Some uri -> set_statusbar ws (sprintf "Connecting to %s ..." uri)
-  );
   clear_view ws;
   Slave.discard_command_queue ();
   Slave.connect uri (when_connected ws uri)
 
 (* Called back when connected to a new hypervisor. *)
 and when_connected ws uri doms =
-  (match uri with
-   | 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 ();
@@ -72,7 +66,6 @@ and when_connected ws uri doms =
 
 (* When a new domain is selected by the user, eg through vmcombo. *)
 let rec open_domain ws name =
-  set_statusbar ws (sprintf "Opening %s ..." name);
   clear_view ws;
   Slave.discard_command_queue ();
   Slave.open_domain name (when_opened_domain ws name)
@@ -80,7 +73,6 @@ let rec open_domain ws name =
 (* Called back when domain was opened successfully. *)
 and when_opened_domain ws name data =
   debug "when_opened_domain callback";
-  set_statusbar ws (sprintf "Opened %s" name);
   when_opened_common ws name data
 
 (* When a set of disk images is selected by the user. *)
@@ -88,7 +80,6 @@ and open_disk_images ws images =
   match images with
   | [] -> ()
   | images ->
-      set_statusbar ws "Opening disks ...";
       clear_view ws;
       Slave.discard_command_queue ();
       Slave.open_images images (when_opened_disk_images ws images)
@@ -99,7 +90,6 @@ and when_opened_disk_images ws images data =
   | [] -> ()
   | (image, _) :: _ ->
       debug "when_opened_disk_images callback";
-      set_statusbar ws "Opened disk";
       when_opened_common ws image data
 
 (* Common code for when_opened_domain/when_opened_disk_images. *)
@@ -155,7 +145,7 @@ let rec open_main_window () =
     make_menubar window vbox ~packing:vbox#pack () in
 
   (* Top toolbar. *)
-  let vmcombo, throbber, throbber_static =
+  let vmcombo, refresh_button, throbber, throbber_static =
     make_toolbar ~packing:vbox#pack () in
 
   (* Main part of display is the file tree. *)
@@ -175,6 +165,7 @@ let rec open_main_window () =
     window = window;
     view = view;
     vmcombo = vmcombo;
+    refresh_button = refresh_button;
     throbber = throbber; throbber_static = throbber_static;
     statusbar = statusbar; statusbar_context = statusbar_context;
     progress_bar = progress_bar
@@ -192,7 +183,9 @@ let rec open_main_window () =
   ignore (connect_none_item#connect#activate
             ~callback:(fun () -> connect_to ws None));
 
-  (* VM combo box when changed by the user. *)
+  (* VM combo box when changed by the user.
+   * The refresh button acts like changing the VM combo too.
+   *)
   let combo, (model, column) = ws.vmcombo in
   ignore (
     combo#connect#changed
@@ -203,7 +196,17 @@ let rec open_main_window () =
           | Some row -> open_domain ws (model#get ~row ~column)
       )
   );
+  ignore (
+    refresh_button#connect#clicked
+      ~callback:(
+        fun () ->
+          match combo#active_iter with
+          | None -> () (* nothing selected *)
+          | Some row -> open_domain ws (model#get ~row ~column)
+      )
+  );
 
+  (* Return the window_state struct. *)
   ws
 
 and make_menubar window vbox ~packing () =
@@ -245,15 +248,52 @@ and make_toolbar ~packing () =
   hbox#pack (mklabel "Guest: ");
   let vmcombo = GEdit.combo_box_text ~packing:hbox#pack () in
 
+  (* Refresh button.
+   * http://stackoverflow.com/questions/2188659/stock-icons-not-shown-on-buttons
+   *)
+  let refresh_button =
+    let image = GMisc.image ~stock:`REFRESH () in
+    let b = GButton.button ~packing:hbox#pack () in
+    b#set_image (image :> GObj.widget);
+    b in
+
   (* Throbber. *)
   let static = Throbber.static () in
   (*let animation = Throbber.animation () in*)
   let throbber =
-    GMisc.image ~pixbuf:static ~packing:(hbox#pack ~from:`END) () in
+    (* Workaround for http://caml.inria.fr/mantis/view.php?id=4732 *)
+    let from = Obj.magic 3448763 (* `END *) in
+    GMisc.image ~pixbuf:static ~packing:(hbox#pack ~from) () in
 
-  vmcombo, throbber, static
+  vmcombo, refresh_button, throbber, static
 
 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