From: Richard W.M. Jones <rjones@redhat.com>
Date: Thu, 28 Jul 2011 22:32:12 +0000 (+0100)
Subject: Use signals to loosely couple modules.
X-Git-Tag: 0.2.0~4
X-Git-Url: http://git.annexia.org/?p=guestfs-browser.git;a=commitdiff_plain;h=2ed92137182d4d479dddddeccaf6ad8dae967895

Use signals to loosely couple modules.

Rearchitect the use of signals so that menu entries emit
signals.

Everything is "plugged together" in a single place in 'main.ml'.
---

diff --git a/.depend b/.depend
index af5fe13..f90ce09 100644
--- a/.depend
+++ b/.depend
@@ -13,8 +13,8 @@ filetree.cmx: utils.cmx slave_types.cmx slave.cmx filetree_markup.cmx deviceSet.
 filetree_markup.cmi: slave_types.cmi
 filetree_markup.cmo: utils.cmi slave_types.cmi filetree_markup.cmi
 filetree_markup.cmx: utils.cmx slave_types.cmx filetree_markup.cmi
-main.cmo: window.cmi utils.cmi slave.cmi config.cmi cmdline.cmi
-main.cmx: window.cmx utils.cmx slave.cmx config.cmx cmdline.cmx
+main.cmo: window.cmi utils.cmi slave.cmi op_view_file.cmi op_inspection_dialog.cmi op_file_information.cmi op_download_file.cmi op_download_dir_tarball.cmi op_download_dir_find0.cmi op_download_as_reg.cmi op_disk_usage.cmi op_copy_regvalue.cmi op_checksum_file.cmi config.cmi cmdline.cmi
+main.cmx: window.cmx utils.cmx slave.cmx op_view_file.cmx op_inspection_dialog.cmx op_file_information.cmx op_download_file.cmx op_download_dir_tarball.cmx op_download_dir_find0.cmx op_download_as_reg.cmx op_disk_usage.cmx op_copy_regvalue.cmx op_checksum_file.cmx config.cmx cmdline.cmx
 op_checksum_file.cmi: filetree.cmi
 op_checksum_file.cmo: utils.cmi slave.cmi op_checksum_file.cmi
 op_checksum_file.cmx: utils.cmx slave.cmx op_checksum_file.cmi
@@ -59,6 +59,6 @@ throbber.cmx:
 utils.cmi:
 utils.cmo: config.cmi utils.cmi
 utils.cmx: config.cmx utils.cmi
-window.cmi: cmdline.cmi
-window.cmo: utils.cmi throbber.cmo slave_types.cmi slave.cmi op_view_file.cmi op_inspection_dialog.cmi op_file_information.cmi op_download_file.cmi op_download_dir_tarball.cmi op_download_dir_find0.cmi op_download_as_reg.cmi op_disk_usage.cmi op_copy_regvalue.cmi op_checksum_file.cmi filetree.cmi cmdline.cmi window.cmi
-window.cmx: utils.cmx throbber.cmx slave_types.cmx slave.cmx op_view_file.cmx op_inspection_dialog.cmx op_file_information.cmx op_download_file.cmx op_download_dir_tarball.cmx op_download_dir_find0.cmx op_download_as_reg.cmx op_disk_usage.cmx op_copy_regvalue.cmx op_checksum_file.cmx filetree.cmx cmdline.cmx window.cmi
+window.cmi: filetree.cmi cmdline.cmi
+window.cmo: utils.cmi throbber.cmo slave_types.cmi slave.cmi filetree.cmi cmdline.cmi window.cmi
+window.cmx: utils.cmx throbber.cmx slave_types.cmx slave.cmx filetree.cmx cmdline.cmx window.cmi
diff --git a/filetree.mli b/filetree.mli
index 697bb5e..b6af8ce 100644
--- a/filetree.mli
+++ b/filetree.mli
@@ -104,7 +104,7 @@ object ('a)
         the code split into small modules, with the filetree widget
         just emitting signals when some action needs to take place.
 
-        All the components are wired together in the {!Window}
+        All the components are wired together in the {!Main}
         module. *)
 
   method after : 'a
diff --git a/main.ml b/main.ml
index 93e2a3a..c908bbc 100644
--- a/main.ml
+++ b/main.ml
@@ -33,13 +33,51 @@ let () =
     debug "libvirt %s" (libvirt_version_string ());
   );
 
+  (* Create the main window. *)
   let w = new Window.window in
+
+  (* Wire up hooks that carry messages from the slave thread
+   * to the main thread.
+   *)
   Slave.set_failure_hook w#failure;
   Slave.set_busy_hook w#throbber_busy;
   Slave.set_idle_hook w#throbber_idle;
   Slave.set_status_hook w#set_statusbar;
   Slave.set_progress_hook w#progress;
 
+  (* Wire up the loosely-coupled external components of the filetree.
+   * See the note about signals in {!Filetree.tree} documentation.
+   *)
+  let tree = w#tree in
+  ignore (tree#op_checksum_file
+            ~callback:(Op_checksum_file.checksum_file tree));
+  ignore (tree#op_copy_regvalue
+            ~callback:(Op_copy_regvalue.copy_regvalue tree));
+  ignore (tree#op_disk_usage
+            ~callback:(Op_disk_usage.disk_usage tree));
+  ignore (tree#op_download_as_reg
+            ~callback:(Op_download_as_reg.download_as_reg tree));
+  ignore (tree#op_download_dir_find0
+            ~callback:(Op_download_dir_find0.download_dir_find0 tree));
+  ignore (tree#op_download_dir_tarball
+            ~callback:(Op_download_dir_tarball.download_dir_tarball tree));
+  ignore (tree#op_download_file
+            ~callback:(Op_download_file.download_file tree));
+  ignore (tree#op_file_information
+            ~callback:(Op_file_information.file_information tree));
+  ignore (tree#op_inspection_dialog
+            ~callback:(Op_inspection_dialog.inspection_dialog tree));
+  ignore (tree#op_view_file
+            ~callback:(Op_view_file.view_file tree));
+
+  (* Connect menu entry signals to the functions that implement them. *)
+  ignore (w#connect_kvm_signal
+            ~callback:(w#connect_to (Some "qemu:///system")));
+  ignore (w#connect_xen_signal
+            ~callback:(w#connect_to (Some "xen:///")));
+  ignore (w#connect_none_signal
+            ~callback:(w#connect_to None));
+
   (* What did the user request on the command line? *)
   w#run_cli_request cli_request;
 
diff --git a/window.ml b/window.ml
index aa33b79..a43bf9c 100644
--- a/window.ml
+++ b/window.ml
@@ -23,7 +23,13 @@ open Slave_types
 
 module G = Guestfs
 
-let make_menubar window (vbox : GPack.box) ~packing () =
+class window =
+  (* Window. *)
+  let title = "Guest Filesystem Browser" in
+  let window = GWindow.window ~width:700 ~height:700 ~title () in
+  let vbox = GPack.vbox ~packing:window#add () in
+
+  (* Menus. *)
   let menubar = GMenu.menu_bar ~packing:vbox#pack () in
   let factory = new GMenu.factory menubar in
   let accel_group = factory#accel_group in
@@ -34,32 +40,26 @@ let make_menubar window (vbox : GPack.box) ~packing () =
   let connect_xen_item = factory#add_item "Connect to local _Xen hypervisor" in
   let connect_none_item = factory#add_item "_Connect to default hypervisor" in
   let connect_uri_item = factory#add_item "Connect to a _libvirt URI ..." in
-  ignore (factory#add_separator ());
-  let open_image_item =
-    factory#add_item "_Open disk image ..." ~key:GdkKeysyms._O in
-  ignore (factory#add_separator ());
+  let () = ignore (factory#add_separator ()) in
+  let _ = factory#add_item "_Open disk image ..." ~key:GdkKeysyms._O in
+  let () = ignore (factory#add_separator ()) in
   let quit_item = factory#add_item "E_xit" ~key:GdkKeysyms._Q in
 
   (* Quit. *)
   let quit _ = GMain.quit (); false in
-  ignore (window#connect#destroy ~callback:GMain.quit);
-  ignore (window#event#connect#delete ~callback:quit);
-  ignore (quit_item#connect#activate
-            ~callback:(fun () -> ignore (quit ()); ()));
+  let () =
+    ignore (window#connect#destroy ~callback:GMain.quit);
+    ignore (window#event#connect#delete ~callback:quit);
+    ignore (quit_item#connect#activate
+              ~callback:(fun () -> ignore (quit ()); ()));
 
-  window#add_accel_group accel_group;
+    window#add_accel_group accel_group in
 
-  connect_kvm_item, connect_xen_item, connect_none_item,
-  connect_uri_item, open_image_item
-
-(* Top toolbar.  In fact, not a toolbar because you don't seem to be
- * able to put a combo box into a toolbar, so it's just an hbox for now.
- *)
-and make_toolbar ~packing () =
-  let hbox = GPack.hbox ~border_width:4 ~packing () in
+  (* Top toolbar. *)
+  let hbox = GPack.hbox ~border_width:4 ~packing:vbox#pack () in
+  let () = hbox#pack (mklabel "Guest: ") in
 
   (* Combo box for displaying virtual machine names. *)
-  hbox#pack (mklabel "Guest: ");
   let vmcombo = GEdit.combo_box_text ~packing:hbox#pack () in
 
   (* Refresh button.
@@ -72,88 +72,56 @@ and make_toolbar ~packing () =
     b in
 
   (* Throbber. *)
-  let static = Throbber.static () in
-  let animation = Throbber.animation () in
+  let throbber_static = Throbber.static () in
+  let throbber_animation = Throbber.animation () in
   let throbber =
     (* 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, refresh_button, throbber, static, animation
+    GMisc.image ~pixbuf:throbber_static ~packing:(hbox#pack ~from) () in
 
-and make_filetree ~packing () =
+  (* Main part of display is the file tree. *)
   (* Create the filetree inside a scrolled window. *)
-  let sw =
-    GBin.scrolled_window ~packing ~hpolicy:`AUTOMATIC ~vpolicy:`ALWAYS () in
+  let sw = GBin.scrolled_window
+    ~hpolicy:`AUTOMATIC ~vpolicy:`ALWAYS
+    ~packing:(vbox#pack ~expand:true ~fill:true) () in
   let tree = new Filetree.tree ~packing:sw#add () in
 
-  (* Wire up the loosely-coupled external components of the filetree.
-   * See the note about signals in {!Filetree.tree} documentation.
-   *)
-  ignore (tree#op_checksum_file
-            ~callback:(Op_checksum_file.checksum_file tree));
-  ignore (tree#op_copy_regvalue
-            ~callback:(Op_copy_regvalue.copy_regvalue tree));
-  ignore (tree#op_disk_usage
-            ~callback:(Op_disk_usage.disk_usage tree));
-  ignore (tree#op_download_as_reg
-            ~callback:(Op_download_as_reg.download_as_reg tree));
-  ignore (tree#op_download_dir_find0
-            ~callback:(Op_download_dir_find0.download_dir_find0 tree));
-  ignore (tree#op_download_dir_tarball
-            ~callback:(Op_download_dir_tarball.download_dir_tarball tree));
-  ignore (tree#op_download_file
-            ~callback:(Op_download_file.download_file tree));
-  ignore (tree#op_file_information
-            ~callback:(Op_file_information.file_information tree));
-  ignore (tree#op_inspection_dialog
-            ~callback:(Op_inspection_dialog.inspection_dialog tree));
-  ignore (tree#op_view_file
-            ~callback:(Op_view_file.view_file tree));
-
-  tree
-
-class window =
-  (* I prototyped the basic window layout using Glade, but have
-   * implemented it by hand to give us more flexibility.
-   *)
-  let title = "Guest Filesystem Browser" in
-  let window = GWindow.window ~width:700 ~height:700 ~title () in
-  let vbox = GPack.vbox ~packing:window#add () in
-
-  (* Menus. *)
-  let connect_kvm_item, connect_xen_item, connect_none_item, _, _ =
-    make_menubar window vbox ~packing:vbox#pack () in
-
-  (* Top toolbar. *)
-  let vmcombo, refresh_button, throbber, throbber_static, throbber_animation =
-    make_toolbar ~packing:vbox#pack () in
-
-  (* Main part of display is the file tree. *)
-  let view = make_filetree ~packing:(vbox#pack ~expand:true ~fill:true) () in
-
   (* Status bar and progress bar. *)
   let hbox = GPack.hbox ~spacing:4 ~packing:vbox#pack () in
   let progress_bar = GRange.progress_bar ~packing:hbox#pack () in
   let statusbar = GMisc.statusbar ~packing:(hbox#pack ~expand:true) () in
   let statusbar_context = statusbar#new_context ~name:"Standard" in
 
+  (* Signals. *)
+  let connect_kvm_signal = new GUtil.signal () in
+  let connect_xen_signal = new GUtil.signal () in
+  let connect_none_signal = new GUtil.signal () in
+  let connect_uri_signal = new GUtil.signal () in
+
 object (self)
+  inherit GUtil.ml_signals [connect_kvm_signal#disconnect;
+                            connect_xen_signal#disconnect;
+                            connect_none_signal#disconnect;
+                            connect_uri_signal#disconnect]
+
+  method connect_kvm_signal = connect_kvm_signal#connect ~after
+  method connect_xen_signal = connect_xen_signal#connect ~after
+  method connect_none_signal = connect_none_signal#connect ~after
+  method connect_uri_signal = connect_uri_signal#connect ~after
+
   initializer
     ignore (statusbar_context#push title);
     window#show ();
 
-    (* Connect up the callback for menu entries etc.  These require the
-     * window_state struct in callbacks.
-     *)
-
-    (* Connect to different hypervisors. *)
+    (* Menu entries emit signals. *)
     ignore (connect_kvm_item#connect#activate
-              ~callback:(fun () -> self#connect_to (Some "qemu:///system")));
+              ~callback:connect_kvm_signal#call);
     ignore (connect_xen_item#connect#activate
-              ~callback:(fun () -> self#connect_to (Some "xen:///")));
+              ~callback:connect_xen_signal#call);
     ignore (connect_none_item#connect#activate
-              ~callback:(fun () -> self#connect_to None));
+              ~callback:connect_none_signal#call);
+    ignore (connect_uri_item#connect#activate
+              ~callback:connect_uri_signal#call);
 
     (* VM combo box when changed by the user.
      * The refresh button acts like changing the VM combo too.
@@ -183,13 +151,12 @@ object (self)
     statusbar_context#pop ();
     ignore (statusbar_context#push msg)
 
-  (* Clear the filetree. *)
-  method private clear_view () =
-    view#clear ()
+  (* Return the filetree. *)
+  method tree = tree
 
-  (* Callback from Connect -> ... menu items. *)
-  method private connect_to uri =
-    self#clear_view ();
+  (* Connect to the given URI. *)
+  method connect_to uri () =
+    tree#clear ();
     Slave.discard_command_queue ();
     Slave.connect uri (self#when_connected uri)
 
@@ -209,7 +176,7 @@ object (self)
 
   (* When a new domain is selected by the user, eg through vmcombo. *)
   method private open_domain name =
-    self#clear_view ();
+    tree#clear ();
     Slave.discard_command_queue ();
     Slave.open_domain name (self#when_opened_domain name)
 
@@ -223,7 +190,7 @@ object (self)
     match images with
     | [] -> ()
     | images ->
-        self#clear_view ();
+        tree#clear ();
         Slave.discard_command_queue ();
         Slave.open_images images (self#when_opened_disk_images images)
 
@@ -246,7 +213,7 @@ object (self)
         debug "root device %s contains %s %s %d.%d" root typ distro major minor;
     ) data.insp_oses;
 
-    view#add_os name data
+    tree#add_os name data
 
   (* Public callbacks. *)
   method throbber_busy () =
diff --git a/window.mli b/window.mli
index 0b2acb5..ba44e5e 100644
--- a/window.mli
+++ b/window.mli
@@ -20,7 +20,16 @@
     dialogs and so on. *)
 
 class window :
-object
+object ('a)
+  method after : 'a
+  method disconnect : GtkSignal.id -> unit
+
+  (** Signals that can be emitted by window. *)
+  method connect_kvm_signal : callback:(unit -> unit) -> GtkSignal.id
+  method connect_xen_signal : callback:(unit -> unit) -> GtkSignal.id
+  method connect_none_signal : callback:(unit -> unit) -> GtkSignal.id
+  method connect_uri_signal : callback:(unit -> unit) -> GtkSignal.id
+
   method failure : exn -> unit
     (** This is the global error handling function.  It is invoked in
         the main thread for failures in the slave thread (see
@@ -40,6 +49,12 @@ object
   method progress : int64 * int64 -> unit
     (** This called whenever the progress bar should move. *)
 
+  method tree : Filetree.tree
+    (** Return the filetree contained in the window. *)
+
+  method connect_to : string option -> unit -> unit
+    (** Connect to the given libvirt URI. *)
+
   method run_cli_request : Cmdline.cli_request -> unit
     (** This function performs the {!Cmdline.cli_request} operation.
         The actual operation happens asynchronously after this function