X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=window.ml;h=aac7380bd0c8fa7df3b6072fc58cdeff8adc23ab;hb=8260bc1fce6ab92b77dbe87b8eccd2b415a95ec3;hp=5f3852a35ace6f54d0c4ce2cd2a6a3ff1850ab1d;hpb=73f1dc10b4279528818fe0fda33daf4c34488d21;p=guestfs-browser.git

diff --git a/window.ml b/window.ml
index 5f3852a..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,18 @@ 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 =
@@ -75,7 +66,6 @@ and populate_vmcombo ws 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)
@@ -83,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. *)
@@ -91,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)
@@ -102,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. *)
@@ -158,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. *)
@@ -178,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
@@ -195,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
@@ -206,8 +196,15 @@ let rec open_main_window () =
           | Some row -> open_domain ws (model#get ~row ~column)
       )
   );
-
-  Filetree.set_status_fn view (set_statusbar ws);
+  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
@@ -251,13 +248,24 @@ 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 =