X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=window.ml;h=6e720b7b4b4e4ffcf98d73c317bec4c4f3a78794;hb=refs%2Ftags%2F0.1.7;hp=ab520785f4d224b0674d561070de7b8910128d1a;hpb=c79fc07ff71926b3bf956ff296336f6f71bb3b1e;p=guestfs-browser.git

diff --git a/window.ml b/window.ml
index ab52078..6e720b7 100644
--- a/window.ml
+++ b/window.ml
@@ -19,6 +19,7 @@
 open Printf
 
 open Utils
+open Slave_types
 
 module G = Guestfs
 
@@ -27,6 +28,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;
@@ -58,7 +60,7 @@ and populate_vmcombo ws doms =
   let combo, (model, column) = ws.vmcombo in
   model#clear ();
   List.iter (
-    fun { Slave.dom_name = name } ->
+    fun { dom_name = name } ->
       let row = model#append () in
       model#set ~row ~column name
   ) doms
@@ -95,12 +97,12 @@ and when_opened_disk_images ws images data =
 and when_opened_common ws name data =
   (* Dump some of the inspection data in debug messages. *)
   List.iter (fun (dev, t) -> debug "filesystem: %s: %s" dev t)
-    data.Slave.insp_all_filesystems;
+    data.insp_all_filesystems;
   List.iter (
-    fun { Slave.insp_root = root; insp_type = typ; insp_distro = distro;
+    fun { insp_root = root; insp_type = typ; insp_distro = distro;
           insp_major_version = major; insp_minor_version = minor } ->
       debug "root device %s contains %s %s %d.%d" root typ distro major minor;
-  ) data.Slave.insp_oses;
+  ) data.insp_oses;
 
   Filetree.add ws.view name data
 
@@ -114,8 +116,16 @@ let throbber_idle ws () =
   ws.throbber#set_pixbuf ws.throbber_static
 
 let progress ws (position, total) =
-  ws.progress_bar#set_fraction
-    (Int64.to_float position /. Int64.to_float total)
+  if position = 0L && total = 1L then
+    ws.progress_bar#pulse ()
+  else (
+    let frac = Int64.to_float position /. Int64.to_float total in
+    if frac < 0. || frac > 1. then
+      eprintf "warning: progress bar out of range: %Ld / %Ld (%g)\n"
+        position total frac;
+    let frac = if frac < 0. then 0. else if frac > 1. then 1. else frac in
+    ws.progress_bar#set_fraction frac
+  )
 
 (* This is called in the main thread whenever a command fails in the
  * slave thread.  The command queue has been cleared before this is
@@ -144,7 +154,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. *)
@@ -164,6 +174,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
@@ -181,7 +192,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
@@ -192,6 +205,15 @@ 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
@@ -235,13 +257,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 =
@@ -269,7 +302,7 @@ and when_connected_cli_request ws guest doms =
     | 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 i = loop 0 (List.map (fun { dom_name = name } -> name) doms) in
 
   let combo, _ = ws.vmcombo in
   combo#set_active i