Add progress bar.
[guestfs-browser.git] / slave.ml
index a43cd69..1c56538 100644 (file)
--- a/slave.ml
+++ b/slave.ml
@@ -96,10 +96,12 @@ let no_callback _ = ()
 let failure_hook = ref (fun _ -> ())
 let busy_hook = ref (fun _ -> ())
 let idle_hook = ref (fun _ -> ())
+let progress_hook = ref (fun _ -> ())
 
 let set_failure_hook cb = failure_hook := cb
 let set_busy_hook cb = busy_hook := cb
 let set_idle_hook cb = idle_hook := cb
+let set_progress_hook cb = progress_hook := cb
 
 (* Execute a function, while holding a mutex.  If the function
  * fails, ensure we release the mutex before rethrowing the
@@ -366,6 +368,14 @@ and open_disk_images images cb =
    *)
   (* g#set_verbose (verbose ());*)
 
+  (* Attach progress bar callback. *)
+  g#set_progress_callback (
+    fun proc_nr serial position total ->
+      debug "progress callback proc_nr=%d serial=%d posn=%Ld total=%Ld"
+        proc_nr serial position total;
+      GtkThread.async !progress_hook (position, total)
+  );
+
   List.iter (
     function
     | filename, None ->